source: FOIAVistA/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNPRT13.m@ 1535

Last change on this file since 1535 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.3 KB
Line 
1SPNPRT13 ;SD/CM- PRINT ADMISSIONS REPORT BY DATE RANGE ;8/29/2000
2 ;;2.0;Spinal Cord Dysfunction;**13,21**;01/02/1997
3EN1 ; Main Entry Point
4 N SPNLEXIT,SPNIO,SPNPAGE,SPNDATE,SPNEDAT S SPNPAGE=1
5 S SPNLEXIT=0,U="^"
6 S SPNA=" Enter START Date: "
7 S SPNQ=" Enter the earliest date of Admission for the print to START at."
8 D QUEST^SPNPRT04("DA^:NOW:EP",SPNA,SPNQ) Q:SPNLEXIT
9 S SPNDATE=Y
10 S ZTSAVE("SPN*")=""
11 S SPNA=" Enter END Date: "
12 S SPNQ=" Enter the latest date of Admission for the print to END with."
13 D QUEST^SPNPRT04("DA^"_SPNDATE_":NOW:EP",SPNA,SPNQ) Q:SPNLEXIT
14 S SPNEDAT=Y
15 D DEVICE^SPNPRTMT("PRINT^SPNPRT13","SCD Admissions",.ZTSAVE) Q:SPNLEXIT
16 I SPNIO="Q" D EXIT Q ; Print was Queued
17 I IO'="" D PRINT D EXIT Q ; Print was not Queued
18 Q
19EXIT ; Exit routine
20 K ^TMP($J,"SPN")
21 K SPNA,SPNIEN,SPNLPRT,SPNQ,SPNQDAT,SPNDATE,VADM,VAIP,ZTSAVE
22 Q
23PRINT ; Print main Body
24 U IO
25 K ^TMP($J,"SPN")
26 S SPNLEXIT=$G(SPNLEXIT,0) ; Ensure that the exit is set
27 N SPNDFN,SPNX
28 S (SPNDFN,SPNLPRT)=0
29 S SPNQDAT=SPNDATE-.000001
30 Q:SPNLEXIT
31 S SPNQDAT=SPNDATE-000001 F S SPNQDAT=$O(^DGPM("B",SPNQDAT)) Q:'+SPNQDAT Q:(SPNQDAT>SPNEDAT) D Q:SPNLEXIT
32 . S SPNIEN=0 F S SPNIEN=$O(^DGPM("B",SPNQDAT,SPNIEN)) Q:'+SPNIEN D:$P($G(^DGPM(SPNIEN,0)),U,2)=1 Q:SPNLEXIT
33 .. S SPNDFN=$P(^DGPM(SPNIEN,0),U,3)
34 .. N DFN,SPNLINE
35 .. I '$D(^SPNL(154,SPNDFN,0)),'(+$$GET1^DIQ(2,SPNDFN,57.4,"I")) Q
36 .. S DFN=SPNDFN,VAIP("E")=SPNIEN D IN5^VADPT
37 .. ; SPNLINE=Admission date(E)^Ward location(E)^Room-Bed(E)^Adm date^Pointer to PTF
38 .. S SPNLINE=$P(VAIP(3),U,1)_U_$P(VAIP(5),U,2)_U_$P(VAIP(6),U,2)_U_SPNQDAT_U_VAIP(12)
39 .. S ^TMP($J,"SPN",$$GET1^DIQ(2,SPNDFN,.01,"E"),SPNDFN,SPNIEN)=SPNLINE
40 .. D KVAR^VADPT
41 .. Q
42 . Q
43 I $D(^TMP($J,"SPN")) D Q:SPNLEXIT ; Indicates the report had data
44 . N SPNDFN,SPNNAME,SPNCOU
45 . S SPNCOU=0
46 . S SPNNAME="" F S SPNNAME=$O(^TMP($J,"SPN",SPNNAME)) Q:SPNNAME="" D Q:SPNLEXIT
47 .. S SPNDFN=0 F S SPNDFN=$O(^TMP($J,"SPN",SPNNAME,SPNDFN)) Q:SPNDFN<1 D NEWPAT(SPNDFN) Q:SPNLEXIT D Q:SPNLEXIT W !
48 ... S SPNIEN=0 F S SPNIEN=$O(^TMP($J,"SPN",SPNNAME,SPNDFN,SPNIEN)) Q:SPNIEN<1 D Q:SPNLEXIT
49 .... S SPNLINE=^TMP($J,"SPN",SPNNAME,SPNDFN,SPNIEN)
50 ... D HEAD Q:SPNLEXIT
51 ... D PATIENT(SPNDFN,SPNLINE) Q:SPNLEXIT
52 ... Q
53 .. Q
54 .I SPNCOU D
55 .. W !,?15,SPNCOU," Patients have been processed."
56 .. Q
57 . Q
58 E W !," ******* No Data for this report. *******"
59 I $E(IOST,1)="C" N DIR S DIR(0)="E" D ^DIR K Y
60 D CLOSE^SPNPRTMT
61 K ^TMP($J,"SPN")
62 Q
63NEWPAT(SPNDFN) ; New patient to print
64 D HEAD Q:SPNLEXIT
65 N DFN
66 S DFN=SPNDFN D DEM^VADPT
67 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)
68 D KVAR^VADPT
69 S SPNCOU=SPNCOU+1
70 I '$D(^SPNL(154,SPNDFN,0)) Q
71 I $O(^SPNL(154,SPNDFN,"E",0))<1 Q
72 N SPNETI,SPNDFLG
73 S (SPNETI,SPNDFLG)=0 W !," Etiology: "
74 F S SPNETI=$O(^SPNL(154,SPNDFN,"E",SPNETI)) Q:SPNETI<1 D Q:SPNLEXIT
75 .N SPNETO
76 .S SPNETO=$P($G(^SPNL(154,SPNDFN,"E",SPNETI,0)),U) Q:SPNETO=""
77 .I $X>13 D HEAD Q:SPNLEXIT W !
78 .W ?12,$E($$GET^DDSVAL(154.03,SPNETO,.01,"","E"),1,30)
79 .I 'SPNDFLG W ?49,"Registration Date: ",$$FMTE^XLFDT($P($G(^SPNL(154,SPNDFN,0)),U,2),"5DZ") S SPNDFLG=1
80 .Q
81 Q
82PATIENT(SPNDFN,SPNLINE) ; Print Patient data
83 ; SPNLINE=Movement date(I)^Ward location(E)^Room-Bed(E)^Adm Date^Pointer to PTF
84 ; SPNLINE=$P(VAIP(3),U,1)_U_VAIP(5),U,2)_U_$P(VAIP(6),U,2)_U_SPNQDAT_U_VAIP(12)
85 Q:SPNLEXIT
86 W !,$$FMTE^XLFDT($P(SPNLINE,U,1),"5Z"),?22,$E($P(SPNLINE,U,2),1,14),?37,$E($P(SPNLINE,U,3),1,15)
87 Q:$P(SPNLINE,U,2)=""
88 N SPNODE,SPNNODE
89 S SPNNODE=$G(^DGPT($P(SPNLINE,U,5),70)) Q:SPNNODE=""
90 N SPNY
91 F SPNODE=10,16:1:24 D Q:SPNLEXIT
92 .S SPNY=$P(SPNNODE,U,SPNODE)
93 .I SPNY'>0 Q
94 .I $G(^ICD9(SPNY,0))="" Q
95 .I $X>50 D HEAD Q:SPNLEXIT W !
96 .W ?50,$E($$GET1^DIQ(80,SPNY,3,"E"),1,29)
97 .Q
98 I '$D(^SPNL(154,SPNDFN,0)) W !?2,"*** NOT IN THE REGISTRY ! ***"
99 Q
100HEAD ; Header Print
101 I SPNPAGE'=1 Q:$Y<(IOSL-4)
102 I $E(IOST,1)="C" D Q:SPNLEXIT
103 .I SPNPAGE=1 W @IOF Q
104 .I SPNPAGE'=1 D Q:SPNLEXIT
105 ..N DIR S DIR(0)="E" D ^DIR I 'Y S SPNLEXIT=1
106 ..K Y
107 ..Q
108 .Q
109 Q:SPNLEXIT
110 I SPNPAGE'=1 W @IOF
111 W !,$$FMTE^XLFDT($$NOW^XLFDT,1),?70,"Page: ",SPNPAGE
112 W !!,?27,"SCD Admissions"
113 W !,?27,"From ",$$FMTE^XLFDT(SPNDATE,"5DZ")," to ",$$FMTE^XLFDT(SPNEDAT,"5DZ")
114 W !!,"Date Admitted",?22,"Ward",?37,"Room-Bed",?50,"Diagnosis Codes"
115 W !,$$REPEAT^XLFSTR("-",79)
116 S SPNPAGE=SPNPAGE+1
117 I $D(ZTQUEUED) S:$$STPCK^SPNPRTMT SPNLEXIT=1
118 Q
Note: See TracBrowser for help on using the repository browser.