source: FOIAVistA/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNPRT04.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 3.3 KB
Line 
1SPNPRT04 ;HIRMFO/WAA- PRINT New SCD/SCI Registrant ;8/29/96 15:41
2 ;;2.0;Spinal Cord Dysfunction;**12**;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 Original Registration START Date: "
9 S SPNQ=" Enter the earliest date of original registration for the print to START with."
10 D QUEST("DA^:NOW:EP",SPNA,SPNQ) Q:SPNLEXIT
11 S SPNDATE=Y
12 S ZTSAVE("SPN*")=""
13 S SPNA=" Enter Original Registration END Date: "
14 S SPNQ=" Enter the Last date of original registration for the print to END with."
15 D QUEST("DA^"_SPNDATE_":NOW:EP",SPNA,SPNQ) Q:SPNLEXIT
16 S SPNEDAT=Y
17 D DEVICE^SPNPRTMT("PRINT^SPNPRT04","SCD New Patient Registrants",.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
21QUEST(SPNX,SPNA,SPNQ) ; Report Question
22 N DIR
23 S DIR(0)=SPNX
24 S DIR("A")=SPNA
25 S DIR("?")=SPNQ
26 D ^DIR
27 I $D(DIRUT) S SPNLEXIT=1 W !,"Print Aborted!" Q
28 Q
29EXIT ; Exit routine
30 K SPNLEXIT,SPNIO,SPNPAGE,SPNDATE
31 K ^TMP($J,"SPN"),^TMP($J,"SPNPRT","AUTO"),^TMP($J,"SPNPRT","POST")
32 K SPNDATE
33 Q
34PRINT ; Print main Body
35 U IO
36 K ^TMP($J,"SPN")
37 S SPNLEXIT=$G(SPNLEXIT,0) ; Ensure that the exit is set
38 N SPNDFN,SPNX
39 S (SPNDFN,SPNLPRT)=0
40 Q:SPNLEXIT
41 F S SPNDFN=$O(^SPNL(154,SPNDFN)) Q:SPNDFN<1 D
42 . Q:$G(^SPNL(154,SPNDFN,0))="" ; No Zero node
43 . I '$$EN2^SPNPRTMT(SPNDFN) Q ; Patient fail the filters
44 . S DFN=SPNDFN D DEM^VADPT
45 . I $$GET^DDSVAL(154,SPNDFN,.02,"","I")<SPNDATE Q
46 . I $$GET^DDSVAL(154,SPNDFN,.02,"","I")>SPNEDAT Q
47 . S ^TMP($J,"SPN",VADM(1),SPNDFN)="" ; Sort the data
48 . D KVAR^VADPT
49 . Q
50 I $D(^TMP($J,"SPN")) D Q:SPNLEXIT ; Indicates the report had data
51 . N SPNSTATE,SPNDFN,SPNNAME,SPNCOU
52 . S SPNCOU=0
53 . S SPNNAME="" F S SPNNAME=$O(^TMP($J,"SPN",SPNNAME)) Q:SPNNAME="" D Q:SPNLEXIT
54 .. S SPNDFN=0 F S SPNDFN=$O(^TMP($J,"SPN",SPNNAME,SPNDFN)) Q:SPNDFN<1 D Q:SPNLEXIT
55 ... D HEAD Q:SPNLEXIT
56 ... D PATIENT(SPNDFN) Q:SPNLEXIT
57 ... Q
58 .. Q
59 . W !,?15,SPNCOU," Patients have been processed."
60 . Q
61 E W !," ******* No Data for this report. *******"
62 I $E(IOST,1)="C" N DIR S DIR(0)="E" D ^DIR K Y
63 D CLOSE^SPNPRTMT
64 K ^TMP($J,"SPN")
65 Q
66PATIENT(SPNDFN) ; Print Patient data
67 Q:SPNLEXIT
68 N SPNETI,SPNZZ
69 S DFN=SPNDFN,SPNETI=0
70 D DEM^VADPT
71 W !,$E(VADM(1),1,18),?20,VA("PID"),?33,$$FMTE^XLFDT($P(^SPNL(154,SPNDFN,0),"^",2),"5DZP")
72 S SPNETI=$O(^SPNL(154,SPNDFN,"E",SPNETI))
73 I SPNETI'<1 D ETI
74 W ?65,$E($$GET^DDSVAL(154,SPNDFN,2.6,"","E"),1,15)
75 ;S SPNZZ=1
76 ;I SPNETI'<1 F S SPNETI=$O(^SPNL(154,SPNDFN,"E",SPNETI)) Q:SPNETI<1 D Q:SPNLEXIT
77 ;.Q:SPNLEXIT
78 ;.D ETI S SPNZZ=0
79 ;.Q
80 S SPNCOU=SPNCOU+1
81 Q
82ETI ;Print A patinet Etiology
83 N SPNETO
84 S SPNETO=$P($G(^SPNL(154,SPNDFN,"E",SPNETI,0)),U) Q:SPNETO=""
85 W ?45,$E($$GET^DDSVAL(154.03,SPNETO,.01,"","E"),1,18)
86 Q
87HEAD ; Header Print
88 I SPNPAGE>1 Q:$Y<(IOSL-4)
89 I $E(IOST,1)="C" D Q:SPNLEXIT
90 .I SPNPAGE=1 W @IOF Q
91 .I SPNPAGE'=1 D Q:SPNLEXIT
92 ..N DIR S DIR(0)="E" D ^DIR I 'Y S SPNLEXIT=1
93 ..K Y
94 ..Q
95 .Q
96 Q:SPNLEXIT
97 I SPNPAGE'=1 W @IOF
98 W !,$$FMTE^XLFDT($$NOW^XLFDT,1),?70,"Page: ",SPNPAGE
99 W !,?18,"Listing of NEW SCD/SCI Patients Since ",$$FMTE^XLFDT(SPNDATE,1)
100 W !,"Patient",?20,"SSN",?33,"Original",?45,"Etiology",?65,"VA SCI Status"
101 W !,?33,"Regis Date"
102 W !,$$REPEAT^XLFSTR("-",79)
103 S SPNPAGE=SPNPAGE+1
104 I $D(ZTQUEUED) S:$$STPCK^SPNPRTMT SPNLEXIT=1
105 Q
Note: See TracBrowser for help on using the repository browser.