119 lines
4.3 KiB
Mathematica
119 lines
4.3 KiB
Mathematica
SPNPRT13 ;SD/CM- PRINT ADMISSIONS REPORT BY DATE RANGE ;8/29/2000
|
|
;;2.0;Spinal Cord Dysfunction;**13,21**;01/02/1997
|
|
EN1 ; Main Entry Point
|
|
N SPNLEXIT,SPNIO,SPNPAGE,SPNDATE,SPNEDAT S SPNPAGE=1
|
|
S SPNLEXIT=0,U="^"
|
|
S SPNA=" Enter START Date: "
|
|
S SPNQ=" Enter the earliest date of Admission for the print to START at."
|
|
D QUEST^SPNPRT04("DA^:NOW:EP",SPNA,SPNQ) Q:SPNLEXIT
|
|
S SPNDATE=Y
|
|
S ZTSAVE("SPN*")=""
|
|
S SPNA=" Enter END Date: "
|
|
S SPNQ=" Enter the latest date of Admission for the print to END with."
|
|
D QUEST^SPNPRT04("DA^"_SPNDATE_":NOW:EP",SPNA,SPNQ) Q:SPNLEXIT
|
|
S SPNEDAT=Y
|
|
D DEVICE^SPNPRTMT("PRINT^SPNPRT13","SCD Admissions",.ZTSAVE) Q:SPNLEXIT
|
|
I SPNIO="Q" D EXIT Q ; Print was Queued
|
|
I IO'="" D PRINT D EXIT Q ; Print was not Queued
|
|
Q
|
|
EXIT ; Exit routine
|
|
K ^TMP($J,"SPN")
|
|
K SPNA,SPNIEN,SPNLPRT,SPNQ,SPNQDAT,SPNDATE,VADM,VAIP,ZTSAVE
|
|
Q
|
|
PRINT ; Print main Body
|
|
U IO
|
|
K ^TMP($J,"SPN")
|
|
S SPNLEXIT=$G(SPNLEXIT,0) ; Ensure that the exit is set
|
|
N SPNDFN,SPNX
|
|
S (SPNDFN,SPNLPRT)=0
|
|
S SPNQDAT=SPNDATE-.000001
|
|
Q:SPNLEXIT
|
|
S SPNQDAT=SPNDATE-000001 F S SPNQDAT=$O(^DGPM("B",SPNQDAT)) Q:'+SPNQDAT Q:(SPNQDAT>SPNEDAT) D Q:SPNLEXIT
|
|
. S SPNIEN=0 F S SPNIEN=$O(^DGPM("B",SPNQDAT,SPNIEN)) Q:'+SPNIEN D:$P($G(^DGPM(SPNIEN,0)),U,2)=1 Q:SPNLEXIT
|
|
.. S SPNDFN=$P(^DGPM(SPNIEN,0),U,3)
|
|
.. N DFN,SPNLINE
|
|
.. I '$D(^SPNL(154,SPNDFN,0)),'(+$$GET1^DIQ(2,SPNDFN,57.4,"I")) Q
|
|
.. S DFN=SPNDFN,VAIP("E")=SPNIEN D IN5^VADPT
|
|
.. ; SPNLINE=Admission date(E)^Ward location(E)^Room-Bed(E)^Adm date^Pointer to PTF
|
|
.. S SPNLINE=$P(VAIP(3),U,1)_U_$P(VAIP(5),U,2)_U_$P(VAIP(6),U,2)_U_SPNQDAT_U_VAIP(12)
|
|
.. S ^TMP($J,"SPN",$$GET1^DIQ(2,SPNDFN,.01,"E"),SPNDFN,SPNIEN)=SPNLINE
|
|
.. D KVAR^VADPT
|
|
.. Q
|
|
. Q
|
|
I $D(^TMP($J,"SPN")) D Q:SPNLEXIT ; Indicates the report had data
|
|
. N SPNDFN,SPNNAME,SPNCOU
|
|
. S SPNCOU=0
|
|
. S SPNNAME="" F S SPNNAME=$O(^TMP($J,"SPN",SPNNAME)) Q:SPNNAME="" D Q:SPNLEXIT
|
|
.. S SPNDFN=0 F S SPNDFN=$O(^TMP($J,"SPN",SPNNAME,SPNDFN)) Q:SPNDFN<1 D NEWPAT(SPNDFN) Q:SPNLEXIT D Q:SPNLEXIT W !
|
|
... S SPNIEN=0 F S SPNIEN=$O(^TMP($J,"SPN",SPNNAME,SPNDFN,SPNIEN)) Q:SPNIEN<1 D Q:SPNLEXIT
|
|
.... S SPNLINE=^TMP($J,"SPN",SPNNAME,SPNDFN,SPNIEN)
|
|
... D HEAD Q:SPNLEXIT
|
|
... D PATIENT(SPNDFN,SPNLINE) Q:SPNLEXIT
|
|
... Q
|
|
.. Q
|
|
.I SPNCOU D
|
|
.. W !,?15,SPNCOU," Patients have been processed."
|
|
.. Q
|
|
. Q
|
|
E W !," ******* No Data for this report. *******"
|
|
I $E(IOST,1)="C" N DIR S DIR(0)="E" D ^DIR K Y
|
|
D CLOSE^SPNPRTMT
|
|
K ^TMP($J,"SPN")
|
|
Q
|
|
NEWPAT(SPNDFN) ; New patient to print
|
|
D HEAD Q:SPNLEXIT
|
|
N DFN
|
|
S DFN=SPNDFN D DEM^VADPT
|
|
W !!," Patient: ",$E(VADM(1),1,18),?32,"SSN: ",$P(VADM(2),U),?49,"SCI: ",$E($$GET1^DIQ(2,SPNDFN,57.4,"E"),1,30)
|
|
D KVAR^VADPT
|
|
S SPNCOU=SPNCOU+1
|
|
I '$D(^SPNL(154,SPNDFN,0)) Q
|
|
I $O(^SPNL(154,SPNDFN,"E",0))<1 Q
|
|
N SPNETI,SPNDFLG
|
|
S (SPNETI,SPNDFLG)=0 W !," Etiology: "
|
|
F S SPNETI=$O(^SPNL(154,SPNDFN,"E",SPNETI)) Q:SPNETI<1 D Q:SPNLEXIT
|
|
.N SPNETO
|
|
.S SPNETO=$P($G(^SPNL(154,SPNDFN,"E",SPNETI,0)),U) Q:SPNETO=""
|
|
.I $X>13 D HEAD Q:SPNLEXIT W !
|
|
.W ?12,$E($$GET^DDSVAL(154.03,SPNETO,.01,"","E"),1,30)
|
|
.I 'SPNDFLG W ?49,"Registration Date: ",$$FMTE^XLFDT($P($G(^SPNL(154,SPNDFN,0)),U,2),"5DZ") S SPNDFLG=1
|
|
.Q
|
|
Q
|
|
PATIENT(SPNDFN,SPNLINE) ; Print Patient data
|
|
; SPNLINE=Movement date(I)^Ward location(E)^Room-Bed(E)^Adm Date^Pointer to PTF
|
|
; SPNLINE=$P(VAIP(3),U,1)_U_VAIP(5),U,2)_U_$P(VAIP(6),U,2)_U_SPNQDAT_U_VAIP(12)
|
|
Q:SPNLEXIT
|
|
W !,$$FMTE^XLFDT($P(SPNLINE,U,1),"5Z"),?22,$E($P(SPNLINE,U,2),1,14),?37,$E($P(SPNLINE,U,3),1,15)
|
|
Q:$P(SPNLINE,U,2)=""
|
|
N SPNODE,SPNNODE
|
|
S SPNNODE=$G(^DGPT($P(SPNLINE,U,5),70)) Q:SPNNODE=""
|
|
N SPNY
|
|
F SPNODE=10,16:1:24 D Q:SPNLEXIT
|
|
.S SPNY=$P(SPNNODE,U,SPNODE)
|
|
.I SPNY'>0 Q
|
|
.I $G(^ICD9(SPNY,0))="" Q
|
|
.I $X>50 D HEAD Q:SPNLEXIT W !
|
|
.W ?50,$E($$GET1^DIQ(80,SPNY,3,"E"),1,29)
|
|
.Q
|
|
I '$D(^SPNL(154,SPNDFN,0)) W !?2,"*** NOT IN THE REGISTRY ! ***"
|
|
Q
|
|
HEAD ; Header Print
|
|
I SPNPAGE'=1 Q:$Y<(IOSL-4)
|
|
I $E(IOST,1)="C" D Q:SPNLEXIT
|
|
.I SPNPAGE=1 W @IOF Q
|
|
.I SPNPAGE'=1 D Q:SPNLEXIT
|
|
..N DIR S DIR(0)="E" D ^DIR I 'Y S SPNLEXIT=1
|
|
..K Y
|
|
..Q
|
|
.Q
|
|
Q:SPNLEXIT
|
|
I SPNPAGE'=1 W @IOF
|
|
W !,$$FMTE^XLFDT($$NOW^XLFDT,1),?70,"Page: ",SPNPAGE
|
|
W !!,?27,"SCD Admissions"
|
|
W !,?27,"From ",$$FMTE^XLFDT(SPNDATE,"5DZ")," to ",$$FMTE^XLFDT(SPNEDAT,"5DZ")
|
|
W !!,"Date Admitted",?22,"Ward",?37,"Room-Bed",?50,"Diagnosis Codes"
|
|
W !,$$REPEAT^XLFSTR("-",79)
|
|
S SPNPAGE=SPNPAGE+1
|
|
I $D(ZTQUEUED) S:$$STPCK^SPNPRTMT SPNLEXIT=1
|
|
Q
|