source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPSEUDO.m@ 1259

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

initial load of WorldVistAEHR

File size: 6.6 KB
Line 
1DGPSEUDO ;ALB/ERC - REPORTS FOR PSEUDO SSN ; 1/17/06 9:58am
2 ;;5.3;Registration;**653**;Aug 13, 1993;Build 2
3 ;
4 ;creates a report of all patients with pseudo SSNs
5 ;can call for veteran, non-veterans or both
6 ;can call for one Pseudo SSN Reason or can call for all reasons
7 ;sorted by reason
8TSK1 ;
9 N DGQUIT,DGREAS,DGREASON,DGTXT,DGQ,DGVET,DGXREAS,DGXVET
10 N ZTRTN,ZTDESC,ZTSK,ZTIO,ZTDTH,POP,IO,IOBS,IOF,IOHG,IOM,ION,IOPAR
11 N IOS,IOSL,IOST,IOT,IOUPAR,IOXY,%ZIS,ZTSAVE
12 K ^TMP("DGEVC",$J)
13 S DGQUIT=0
14 D QUESVET Q:DGQUIT
15 D QUESREAS Q:DGQUIT
16 S %ZIS="Q" D ^%ZIS I $G(POP) D ^%ZISC,HOME^%ZIS W !,"Job Terminated!" Q
17 I $D(IO("Q")) D Q
18 . S ZTRTN="RPT1^DGPSEUDO"
19 . S ZTDESC="PATIENTS WITH PSEUDO SOCIAL SECURITY NUMBERS"
20 . S (ZTSAVE("DGXREAS"),ZTSAVE("DGXVET"))=""
21 . D ^%ZTLOAD
22 . S DGTXT=$S($G(ZTSK):"Task: "_ZTSK_" Queued.",1:"Error: Process not queued!")
23 . W !,DGTXT
24RPT1 ;
25 N DGC,DGPAGE,DGXXVET
26 S DGPAGE=0
27 S DGC=0
28 S DGXXVET=DGXVET
29 D LOOP1
30 D HDR1
31 I $G(DGC)'>0 W !!?25,"****NO RECORDS TO REPORT****" W ! D PAUSE Q
32 D REP1(DGXVET,DGXREAS)
33 D ^%ZISC,HOME^%ZIS
34 K ^TMP("DGEVC",$J)
35 Q
36QUESVET ;ask user if report should be veterans, non-veterans, or both
37 N DGBOTH,DIR,DIRUT,DIROUT,X
38 W !!!,?10,"REPORT OF PATIENTS WITH PSEUDO SOCIAL SECURITY NUMBERS"
39 W !?5,"This report excludes deceased patients, non-user enrollees and"
40 W !?5,"with no Integration Control Numbers (ICN).",!
41 S DIR("A",1)="Do you want this report for Veterans, Non-Veterans or both?"
42 S DIR("A",2)="1. Veterans only"
43 S DIR("A",3)="2. Non-Veterans only"
44 S DIR("A",4)="3. Veterans and Non-Veterans"
45 S DIR("A")="Select"
46 S DIR("B")=1
47 S DIR("?")="Choose a report with Veterans only, Non-Veterans only or both."
48 S DIR(0)="N^1:3"
49 D ^DIR
50 I $D(DIRUT)!($D(DIROUT)) S DGQUIT=1
51 S DGXVET=$S(X=1:"VET",X=2:"NON",1:"BOTH")
52 Q
53 ;
54QUESREAS ;ask user which Pseudo SSN Reason, or all
55 N DIR,DIRUT,DIROUT,X
56 W !
57 S DIR("A",1)="Select which Pseudo SSN Reason(s) to be included in the report."
58 S DIR("A",2)="1. Refused to Provide"
59 S DIR("A",3)="2. SSN Unknown/Follow-up Required"
60 S DIR("A",4)="3. No SSN Assigned"
61 S DIR("A",5)="4. No reason on file"
62 S DIR("A",6)="5. All of the above"
63 S DIR("A")="Select"
64 S DIR("?")="Select one of the Reasons for having a Pseudo SSN."
65 S DIR(0)="N^1:5"
66 D ^DIR
67 I $D(DIRUT)!($D(DIROUT)) S DGQUIT=1
68 S DGXREAS=$S(X=1:"REFUSED TO PROVIDE",X=2:"SSN UNKNOWN/FOLLOW-UP REQUIRED",X=3:"NO SSN ASSIGNED",X=4:"NULL",1:"ALL")
69 Q
70LOOP1 ;
71 I $E(IOST,1,2)["C-" U IO(0) W !!,"Scanning file...."
72 U IO
73 N DGDFN,DGX
74 K ^TMP("DGEVC",$J)
75 S ^TMP("DGEVC",$J,"COUNT","VET","REFUSED TO PROVIDE")=0
76 S ^TMP("DGEVC",$J,"COUNT","VET","SSN UNKNOWN/FOLLOW-UP REQUIRED")=0
77 S ^TMP("DGEVC",$J,"COUNT","VET","NO SSN ASSIGNED")=0
78 S ^TMP("DGEVC",$J,"COUNT","VET","NULL")=0
79 S ^TMP("DGEVC",$J,"COUNT","NON","REFUSED TO PROVIDE")=0
80 S ^TMP("DGEVC",$J,"COUNT","NON","SSN UNKNOWN/FOLLOW-UP REQUIRED")=0
81 S ^TMP("DGEVC",$J,"COUNT","NON","NO SSN ASSIGNED")=0
82 S ^TMP("DGEVC",$J,"COUNT","NON","NULL")=0
83 S DGX=999999999
84 F S DGX=$O(^DPT("SSN",DGX)) Q:DGX="" D
85 . I DGX'["P" Q
86 . S DGDFN=""
87 . F S DGDFN=$O(^DPT("SSN",DGX,DGDFN)) Q:'DGDFN D
88 . . I '$D(^DPT(DGDFN,0)) Q
89 . . D PSEU1
90 Q
91PSEU1 ;
92 N DGARR,DGDOB,DGEC,DGERR,DGNAM,DGREASON,DGSSN,DGUSER,DGVET
93 I $D(^TMP("DGEVC",$J,DGDFN)) Q
94 D GETS^DIQ(2,DGDFN_",",".01;.03;.09;.0906;.351;.361;.3617;991.01;1901","EI","DGARR","DGERR")
95 I $D(DGERR) K DGERR Q
96 I $G(DGARR(2,DGDFN_",",.351,"I"))]"" K DGARR Q
97 I $G(DGARR(2,DGDFN_",",991.01,"I"))']"" K DGARR Q
98 S DGVET=$S($G(DGARR(2,DGDFN_",",1901,"I"))="Y":"VET",$G(DGARR(2,DGDFN_",",1901,"I"))="N":"NON",1:"NON")
99 I $G(DGVET)]"",DGXVET'="BOTH",DGVET'=DGXVET K DGARR Q
100 S DGREASON=$G(DGARR(2,DGDFN_",",.0906,"E"))
101 I $G(DGREASON)']"" S DGREASON="NULL"
102 I DGXREAS'="ALL",DGXREAS'=DGREASON K DGARR Q
103 S DGUSER=$G(DGARR(2,DGDFN_",",.3617,"I"))
104 I DGVET="YES",($G(DGUSER)']"") K DGARR Q
105 S DGUSER=$$FY($E(DGUSER,1,3)+1700)
106 I DGVET="VET",$G(DGUSER)'=1 K DGARR Q
107 S DGNAM=$G(DGARR(2,DGDFN_",",.01,"I"))
108 I $G(DGNAM)']"" K DGARR Q
109 S DGDOB=$G(DGARR(2,DGDFN_",",.03,"E"))
110 S DGEC=$G(DGARR(2,DGDFN_",",.361,"E"))
111 S DGSSN=DGARR(2,DGDFN_",",.09,"I")
112 I DGX'=DGSSN K DGARR Q
113 S DGC=DGC+1
114 S ^TMP("DGEVC",$J,DGVET,DGREASON,DGNAM,DGDFN)=$G(DGSSN)_"^"_$G(DGDOB)_"^"_$G(DGEC)
115 S ^TMP("DGEVC",$J,"COUNT")=DGC
116 S ^TMP("DGEVC",$J,"COUNT",DGVET,DGREASON)=$G(^TMP("DGEVC",$J,"COUNT",DGVET,DGREASON))+1
117 Q
118FY(DGFY) ;determine if user enrollee date is current FY or later
119 N DGYEAR
120 S DGYEAR=$E(DT,1,3)+1700
121 I $E(DT,4,5)>9 S DGYEAR=DGYEAR+1
122 Q $S(DGFY>DGYEAR:1,DGFY=DGYEAR:1,1:0)
123HDR1 ;
124 N DGDATE,DGL,DGLINE,DGT,Y ;display veteran, non-vet or both
125 I $E(IOST,1,2)["C-" W @IOF
126 S DGPAGE=DGPAGE+1
127 W !?((IOM-44)\2),"Patients with Pseudo Social Security Numbers",?70,"Page:"_DGPAGE
128 S DGT=$S(DGXXVET="VET":"Veterans only",DGXXVET="NON":"Non-Veterans only",1:"Veterans and Non-Veterans")
129 S DGT="Report shows "_DGT
130 S DGL=$L(DGT)
131 W !?((IOM-DGL)\2),DGT
132 S Y=DT X ^DD("DD") S DGDATE=Y
133 W !?62,"Date: "_$G(DGDATE)
134 W !!,"PATIENT",?32,"PSEUDO SSN",?44,"BIRTHDATE",?56,"PRIMARY ELIGIBILITY CODE"
135 N DGZ
136 W !
137 F DGZ=1:1:IOM W "-" ;S $P(DGLINE,"-",DGZ)=""
138 Q
139REP1(DGXVET,DGXREAS) ;
140 N DGCT,DGV
141 S DGCT=0
142 I DGXVET="BOTH" D
143 . F DGV="VET","NON" D
144 . . Q:'$D(^TMP("DGEVC",$J,DGV))
145 . . Q:$G(DGQ)
146 . . I $E(IOST,1,2)["C-",($Y>(IOSL-4)) D PAUSE Q:$G(DGQ)
147 . . I $Y>(IOSL-4) D
148 . . . W @IOF
149 . . . D HDR1
150 . . W !!?5,"Report for "_$S(DGV="VET":"Veterans",1:"Non-Veterans")
151 . . D VET(DGV)
152 I DGXVET'="BOTH" D VET(DGXVET)
153 I $G(DGC)=DGCT W !!?29,"Patients with Pseudo SSNs: "_DGCT
154 I $E(IOST,1,2)["C-",('$G(DGQ)) W ! D PAUSE
155 Q
156VET(DGXVET) ;
157 N DGR
158 I DGXREAS="ALL" D
159 . F DGR="REFUSED TO PROVIDE","SSN UNKNOWN/FOLLOW-UP REQUIRED","NO SSN ASSIGNED","NULL" D
160 . . Q:$G(DGQ)
161 . . D REAS(DGXVET,DGR)
162 I DGXREAS'="ALL" D
163 . D REAS(DGXVET,DGXREAS)
164 Q
165REAS(DGXVET,DGXRR) ;
166 N DGN,DGNAM,DGDFN
167 S DGDFN=0
168 I $E(IOST,1,2)["C-",($Y>(IOSL-4)) D PAUSE Q:$G(DGQ)
169 I $Y>(IOSL-4) D
170 . W @IOF
171 . D HDR1
172 I $O(^TMP("DGEVC",$J,DGXVET,DGXRR,""))]"" W !!?10,"Pseudo SSN Reason: "_$S(DGXRR="NULL":"<NONE ENTERED>",1:DGXRR)
173 S DGNAM=""
174 F S DGNAM=$O(^TMP("DGEVC",$J,DGXVET,DGXRR,DGNAM)) Q:DGNAM']""!($G(DGQ)) D
175 . F S DGDFN=$O(^TMP("DGEVC",$J,DGXVET,DGXRR,DGNAM,DGDFN)) Q:DGDFN']""!($G(DGQ)) D
176 . . I $E(IOST,1,2)["C-",($Y>(IOSL-4)) D PAUSE Q:$G(DGQ)
177 . . I $Y>(IOSL-4) D
178 . . . W @IOF
179 . . . D HDR1
180 . . S DGN=^TMP("DGEVC",$J,DGXVET,DGXRR,DGNAM,DGDFN)
181 . . W !,DGNAM,?32,$P(DGN,U),?44,$P(DGN,U,2)
182 . . I $P(DGN,U,3)["SERVICE CONNECTED" S $P(DGN,U,3)="SC 50% TO 100%"
183 . . W ?56,$E($P(DGN,U,3),1,23)
184 . . S DGCT=$G(DGCT)+1
185 I ^TMP("DGEVC",$J,"COUNT",DGXVET,DGXRR)>0,(DGXREAS="ALL") W !?46,"Subtotal: "_^TMP("DGEVC",$J,"COUNT",DGXVET,DGXRR)
186 Q
187 ;
188PAUSE ;
189 N DIR,X,Y
190 S DGQ=0
191 S DIR(0)="E"
192 D ^DIR
193 I '+Y!($D(DIRUT)) S DGQ=1
194 Q
195 ;
Note: See TracBrowser for help on using the repository browser.