source: FOIAVistA/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNPRT06.m@ 1423

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

initial load of FOIAVistA 6/30/08 version

File size: 4.0 KB
Line 
1SPNPRT06 ;HIRMFO/WAA- PRINT Follow-Up Rehab Not viewed ;8/29/96 15:41
2 ;;2.0;Spinal Cord Dysfunction;;01/02/1997
3 ;;
4EN1 ; Main Entry Point
5 N SPNLEXIT,SPNIO,SPNPAGE,SPNDATE S SPNPAGE=1
6 S SPNLEXIT=0 D EN1^SPNPRTMT Q:SPNLEXIT ;Filters
7 W !!,"Report Filter: "
8 S SPNA=" Enter Rehab Offered START Date: "
9 S SPNQ=" Enter the earliest date the Rehab eval was offered for the print to START with."
10 D QUEST^SPNPRT04("DA^:NOW:EP",SPNA,SPNQ) Q:SPNLEXIT
11 S SPNDATE=Y
12 S ZTSAVE("SPN*")=""
13 S SPNA=" Enter Rehab Offered END Date: "
14 S SPNQ=" Enter the Last date the Rehab eval for the print to END with."
15 D QUEST^SPNPRT04("DA^"_SPNDATE_":NOW:EP",SPNA,SPNQ) Q:SPNLEXIT
16 S SPNEDAT=Y
17 D DEVICE^SPNPRTMT("PRINT^SPNPRT06","SCD Follow-up Rehab report",.ZTSAVE) Q:SPNLEXIT
18 I SPNIO="Q" D EXIT Q ; Print was Queued
19 I IO'="" D PRINT D EXIT Q ; Print was not Queued
20 Q
21EXIT ; Exit routine
22 K ^TMP($J,"SPN"),^TMP($J,"SPNPRT","AUTO"),^TMP($J,"SPNPRT","POST")
23 K SPNDATE
24 Q
25PRINT ; Print main Body
26 U IO
27 K ^TMP($J,"SPN")
28 S SPNLEXIT=$G(SPNLEXIT,0) ; Ensure that the exit is set
29 N SPNDFN,SPNX
30 S (SPNDFN,SPNLPRT)=0
31 Q:SPNLEXIT
32 F S SPNDFN=$O(^SPNL(154,SPNDFN)) Q:SPNDFN<1 D
33 . Q:$G(^SPNL(154,SPNDFN,0))="" ; No Zero node
34 . I '$$EN2^SPNPRTMT(SPNDFN) Q ; Patient fail the filters
35 . I $G(^SPNL(154,SPNDFN,"REHAB",0))="" Q ; No rehab for patient
36 . N SPNDT
37 . S SPNDT=SPNDATE-.000001
38 . F S SPNDT=$O(^SPNL(154,SPNDFN,"REHAB","B",SPNDT)) Q:SPNDT<1 D
39 .. Q:SPNDT>SPNEDAT
40 .. N SPNIEN
41 .. S SPNIEN=0
42 .. F S SPNIEN=$O(^SPNL(154,SPNDFN,"REHAB","B",SPNDT,SPNIEN)) Q:SPNIEN<1 D
43 ... Q:'$D(^SPNL(154,SPNDFN,"REHAB",SPNIEN,0))
44 ... S ^TMP($J,"SPN",$$GET^DDSVAL(2,SPNDFN,.01,"","E"),SPNDFN)="" ; Sort the data
45 ... Q
46 ..Q
47 .Q
48 I $D(^TMP($J,"SPN")) D Q:SPNLEXIT ; Indicates the report had data
49 . N SPNSTATE,SPNDFN,SPNNAME,SPNCOU,SPNDT,SPNIEN
50 . S SPNCOU=0
51 . S SPNNAME="" F S SPNNAME=$O(^TMP($J,"SPN",SPNNAME)) Q:SPNNAME="" D Q:SPNLEXIT
52 .. S SPNDFN=0 F S SPNDFN=$O(^TMP($J,"SPN",SPNNAME,SPNDFN)) Q:SPNDFN<1 D Q:SPNLEXIT
53 ... D HEAD Q:SPNLEXIT
54 ... D PATIENT(SPNDFN) Q:SPNLEXIT
55 ... Q
56 .. Q
57 .. Q
58 . W !,?15,SPNCOU," Patients have been processed."
59 . Q
60 E W !," ******* No Data for this report. *******"
61 I $E(IOST,1)="C" N DIR S DIR(0)="E" D ^DIR K Y
62 D CLOSE^SPNPRTMT
63 K ^TMP($J,"SPN")
64 Q
65PATIENT(SPNDFN) ; Print Patient data
66 Q:SPNLEXIT
67 N SPNETI,SPNZZ,SPNIEN
68 S DFN=SPNDFN,(SPNETI,SPNIEN)=0
69 D DEM^VADPT
70 W !,$E(VADM(1),1,24)
71 S SPNIEN=$O(^SPNL(154,SPNDFN,"REHAB",SPNIEN)) ; Rehab Data
72 I SPNIEN'<1 D REHAB
73 ;W $$GET^DDSVAL(154,SPNDFN,.02,"","E")
74 S SPNETI=$O(^SPNL(154,SPNDFN,"E",SPNETI)) ; Etiology data
75 I SPNETI'<1 D ETI
76 ;W ?65,$E($$GET^DDSVAL(2,.SPNDFN,57.4,"","E"),1,15)
77 D NXTLN
78 S SPNCOU=SPNCOU+1 W !
79 Q
80NXTLN ; This is to create the following lines
81 N SPNZZ
82 W !,VA("PID") S SPNZZ=0
83NXTLP ; The main loop
84 I SPNZZ'=0 W !
85 I SPNIEN'<1 S SPNIEN=$O(^SPNL(154,SPNDFN,"REHAB",SPNIEN))
86 I SPNIEN'<1 D REHAB
87 I SPNETI'<1 S SPNETI=$O(^SPNL(154,SPNDFN,"E",SPNETI))
88 I SPNETI'<1 D ETI
89 I SPNETI<1,SPNIEN<1 Q
90 S SPNZZ=1 G NXTLP
91 Q
92ETI ;Print A patinet Etiology
93 N SPNETO
94 S SPNETO=$P($G(^SPNL(154,SPNDFN,"E",SPNETI,0)),U) Q:SPNETO=""
95 W ?58,$E($$GET^DDSVAL(154.03,SPNETO,.01,"","E"),1,20)
96 Q
97REHAB ;Print a patient's rehab information
98 N SPNDATE
99 Q:$G(^SPNL(154,SPNDFN,"REHAB",SPNIEN,0))=""
100 S SPNDATE=$P(^SPNL(154,SPNDFN,"REHAB",SPNIEN,0),U) Q:SPNDATE="" ;
101 S SPNDAT2=$P(^SPNL(154,SPNDFN,"REHAB",SPNIEN,0),U,2)
102 W ?26,$$FMTE^XLFDT(SPNDATE,"1D")
103 I SPNDAT2'="" W ?43,$$FMTE^XLFDT(SPNDAT2,"1D")
104 Q
105HEAD ; Header Print
106 Q:$Y<(IOSL-4)
107 I $E(IOST,1)="C" D Q:SPNLEXIT
108 .I SPNPAGE=1 W @IOF Q
109 .I SPNPAGE'=1 D Q:SPNLEXIT
110 ..N DIR S DIR(0)="E" D ^DIR I 'Y S SPNLEXIT=1
111 ..K Y
112 ..Q
113 .Q
114 Q:SPNLEXIT
115 I SPNPAGE'=1 W @IOF
116 W !,$$FMTE^XLFDT($$NOW^XLFDT,1),?70,"Page: ",SPNPAGE
117 W !,?6,"Listing of Patient with Offered Rehab FROM: ",$$FMTE^XLFDT(SPNDATE,"2D")," TO: ",$$FMTE^XLFDT(SPNEDAT,"2D")
118 W !!,?26,"Rehab",?43,"Rehab"
119 W !,"Patient",?26,"Offered",?43,"Received",?58,"SCD Cause"
120 W !,$$REPEAT^XLFSTR("-",79)
121 S SPNPAGE=SPNPAGE+1
122 I $D(ZTQUEUED) S:$$STPCK^SPNPRTMT SPNLEXIT=1
123 Q
Note: See TracBrowser for help on using the repository browser.