| 1 | DGRSTBAD ;JDH,EG,PHH-STATE FILE REPORT ; 03/16/2007 4:15 PM
|
|---|
| 2 | ;;5.3;Registration;**694,738**;Aug 13, 1993;Build 6
|
|---|
| 3 | Q
|
|---|
| 4 | EN N %ZIS,DGNS,DIR,X,Y,DGRPTYP,DIRUT,MSG,POP,ZTSK
|
|---|
| 5 | S DIR("A")="Report on States Not Recognized by AAC or Inactive Counties for"
|
|---|
| 6 | S DGRPTYP(1)="US and US Possessions Only"
|
|---|
| 7 | S DGRPTYP(2)="Foreign Addresses Only"
|
|---|
| 8 | S DIR("B")=1
|
|---|
| 9 | S DIR(0)="S^1:"_DGRPTYP(1)_";2:"_DGRPTYP(2)_";3:Both"
|
|---|
| 10 | D ^DIR G:$D(DIRUT) EXIT
|
|---|
| 11 | S DGRPTYP=Y
|
|---|
| 12 | S MSG(1)=""
|
|---|
| 13 | S MSG(2)="This report may take a long time to generate. It is recommended that the report"
|
|---|
| 14 | S MSG(3)="be queued to print."
|
|---|
| 15 | S MSG(4)=""
|
|---|
| 16 | D BMES^XPDUTL(.MSG)
|
|---|
| 17 | S %ZIS="Q" D ^%ZIS G:POP EXIT
|
|---|
| 18 | S DGNS="DGRSTBAD"
|
|---|
| 19 | I $D(IO("Q")) D ZTSK G EXIT
|
|---|
| 20 | D PROC(DGNS,.DGRPTYP),^%ZISC
|
|---|
| 21 | Q
|
|---|
| 22 | EXIT D HOME^%ZIS
|
|---|
| 23 | Q
|
|---|
| 24 | ;
|
|---|
| 25 | ZTSK ;
|
|---|
| 26 | N ZTSAVE,ZTDTH,ZTRTN,ZTDESC,Y
|
|---|
| 27 | S (ZTSAVE("DGRPTYP"),ZTSAVE("DGRPTYP("),ZTSAVE("DGNS"))=""
|
|---|
| 28 | S %DT("A")="Requested Start Time: ",%DT="FATE"
|
|---|
| 29 | S %DT(0)="NOW",%DT("B")="NOW" D ^%DT K %DT(0) I Y<0 Q
|
|---|
| 30 | S ZTDTH=Y
|
|---|
| 31 | S ZTDESC="INVALID STATE/INACTIVE COUNTY REPORT"
|
|---|
| 32 | S ZTRTN="PROC^"_DGNS_"(DGNS,.DGRPTYP)"
|
|---|
| 33 | D ^%ZTLOAD
|
|---|
| 34 | I $D(ZTSK) D
|
|---|
| 35 | .W !!,"REPORT QUEUED"
|
|---|
| 36 | E W !!,"REPORT NOT QUEUED"
|
|---|
| 37 | Q
|
|---|
| 38 | ;
|
|---|
| 39 | PROC(DGNS,DGRPTYP) ;
|
|---|
| 40 | N X,DGFARR,DGFORR,DGSARR,DFN,DGD1,DGGLB,DGFILEP,DGPARR,DGIENS,DGFILE,DGNODE,DGPTYP,DGTARR,DGNAME
|
|---|
| 41 | N DGIENS,DGSSN,DGPAGE,DGFLDNO,DGFLDS,DGPTR,DGTXT,DGFLD,DGQUIT,DGEND,DGSTRT,X1
|
|---|
| 42 | S DGFILE=2
|
|---|
| 43 | S DGGLB="^DPT"
|
|---|
| 44 | K ^TMP($J,DGNS)
|
|---|
| 45 | D FILE2(.DGFORR,"FOTXT")
|
|---|
| 46 | D FILE2(.DGFARR,"FATXT")
|
|---|
| 47 | S DGSTRT=$S(DGRPTYP=3:1,1:DGRPTYP)
|
|---|
| 48 | S DGEND=$S(DGRPTYP=3:2,1:DGRPTYP)
|
|---|
| 49 | S DFN=0
|
|---|
| 50 | F S DFN=$O(^DPT(DFN)) Q:'DFN D
|
|---|
| 51 | . K DGPARR
|
|---|
| 52 | . I $$ISACT(DFN)'="Y" Q
|
|---|
| 53 | . D FLDL
|
|---|
| 54 | . Q
|
|---|
| 55 | D RPT(DGNS,.DGRPTYP,DGSTRT,DGEND)
|
|---|
| 56 | D XMY(.DGSARR,.DGRPTYP)
|
|---|
| 57 | K ^TMP($J,DGNS)
|
|---|
| 58 | Q
|
|---|
| 59 | ;
|
|---|
| 60 | FLDL ;
|
|---|
| 61 | I DGRPTYP'=2 D
|
|---|
| 62 | . S DGFILEP=0
|
|---|
| 63 | . F S DGFILEP=$O(DGFARR(1,DGFILEP)) Q:'DGFILEP D FLDLG
|
|---|
| 64 | . Q
|
|---|
| 65 | I DGRPTYP'=1 D
|
|---|
| 66 | . S DGFILEP=0
|
|---|
| 67 | . F S DGFILEP=$O(DGFORR(1,DGFILEP)) Q:'DGFILEP D FLDLG
|
|---|
| 68 | . Q
|
|---|
| 69 | D:$D(DGPARR) BUILD(DGNS,DFN,.DGPARR,.DGFARR,.DGSARR)
|
|---|
| 70 | Q
|
|---|
| 71 | FLDLG ;
|
|---|
| 72 | I DGFILEP=DGFILE D
|
|---|
| 73 | . S DGIENS=DFN_","
|
|---|
| 74 | . D CHECK1(DGRPTYP,.DGFARR,.DGFORR,DGFILEP,DGIENS,.DGPARR,DGSTRT,DGEND)
|
|---|
| 75 | . Q
|
|---|
| 76 | E D
|
|---|
| 77 | . S X=+$O(^DD(DGFILE,"SB",DGFILEP,0))
|
|---|
| 78 | . S DGNODE=$P($P($G(^DD(DGFILE,X,0)),U,4),";") Q:'$L(DGNODE)
|
|---|
| 79 | . S DGD1=0
|
|---|
| 80 | . F S DGD1=$O(@DGGLB@(DFN,DGNODE,DGD1)) Q:'DGD1 D
|
|---|
| 81 | .. S DGIENS=DGD1_","_DFN_","
|
|---|
| 82 | .. D CHECK1(DGRPTYP,.DGFARR,.DGFORR,DGFILEP,DGIENS,.DGPARR,DGSTRT,DGEND)
|
|---|
| 83 | .. Q
|
|---|
| 84 | . Q
|
|---|
| 85 | Q
|
|---|
| 86 | CHECK1(DGRPTYP,DGFARR,DGFORR,DGFILEP,DGIENS,DGPARR,DGSTRT,DGEND) ;
|
|---|
| 87 | ;
|
|---|
| 88 | ;For each report type
|
|---|
| 89 | F DGPTYP=DGSTRT:1:DGEND D CHG
|
|---|
| 90 | Q
|
|---|
| 91 | CHG ;
|
|---|
| 92 | N FOREIGN
|
|---|
| 93 | ;Extract appropriate fields for report type
|
|---|
| 94 | I DGPTYP=1 S DGFLDS=DGFARR(1,DGFILEP)
|
|---|
| 95 | E S DGFLDS=DGFORR(1,DGFILEP)
|
|---|
| 96 | K DGTARR,DGERR,SDQUERY,SDQDATA
|
|---|
| 97 | N I D GETS^DIQ(DGFILEP,DGIENS,DGFLDS,"I","DGTARR","DGERR")
|
|---|
| 98 | S DGFLD=0
|
|---|
| 99 | F S DGFLD=$O(DGTARR(DGFILEP,DGIENS,DGFLD)) Q:'DGFLD D
|
|---|
| 100 | . S DGPTR=DGTARR(DGFILEP,DGIENS,DGFLD,"I") Q:'DGPTR
|
|---|
| 101 | . S FOREIGN=$$FOREIGN(DGPTR)
|
|---|
| 102 | . I FOREIGN="Y",DGPTYP=1 Q
|
|---|
| 103 | . I FOREIGN="N",DGPTYP=2 Q
|
|---|
| 104 | . ;Check county inactive date for both foreign and US
|
|---|
| 105 | . I DGFLD=.117 D
|
|---|
| 106 | .. S X1=DGTARR(DGFILEP,DGIENS,.115,"I")
|
|---|
| 107 | .. S X=$G(^DIC(5,X1,1,DGPTR,0))
|
|---|
| 108 | .. S:$P(X,U,5)!$D(DGPARR(DGPTYP,DGFILEP,DGIENS,.115)) DGPARR(DGPTYP,DGFILEP,DGIENS,DGFLD)=$P(X,U)
|
|---|
| 109 | .. Q
|
|---|
| 110 | . S X=$G(^DIC(5,DGPTR,0))
|
|---|
| 111 | . I '$P(X,U,5)!($E($P(X,U,1),1)="Z") S DGPARR(DGPTYP,DGFILEP,DGIENS,DGFLD)=$P(X,U)
|
|---|
| 112 | . Q
|
|---|
| 113 | Q
|
|---|
| 114 | ;
|
|---|
| 115 | BUILD(DGNS,DGDO,DGPARR,DGFARR,DGSARR) ;
|
|---|
| 116 | ;
|
|---|
| 117 | N X,DGNAME,DGSSN,DGPTYP
|
|---|
| 118 | S X=$G(^DPT(DFN,0))
|
|---|
| 119 | S DGNAME=$P(X,U) Q:'$L(DGNAME)
|
|---|
| 120 | S DGSSN=$P(X,U,9)
|
|---|
| 121 | S:'$L(DGSSN) DGSSN="NONE"
|
|---|
| 122 | S DGPTYP=0
|
|---|
| 123 | F S DGPTYP=$O(DGPARR(DGPTYP)) Q:'DGPTYP D DGFILEP
|
|---|
| 124 | Q
|
|---|
| 125 | DGFILEP ;
|
|---|
| 126 | N DGFILEP
|
|---|
| 127 | S DGFILEP=0
|
|---|
| 128 | F S DGFILEP=$O(DGPARR(DGPTYP,DGFILEP)) Q:'DGFILEP D DGIENS
|
|---|
| 129 | Q
|
|---|
| 130 | DGIENS ;
|
|---|
| 131 | N DGIENS
|
|---|
| 132 | S DGIENS=""
|
|---|
| 133 | F S DGIENS=$O(DGPARR(DGPTYP,DGFILEP,DGIENS)) Q:DGIENS="" D DGFLD
|
|---|
| 134 | Q
|
|---|
| 135 | DGFLD ;
|
|---|
| 136 | N DGFLD
|
|---|
| 137 | S DGFLD=0
|
|---|
| 138 | F S DGFLD=$O(DGPARR(DGPTYP,DGFILEP,DGIENS,DGFLD)) Q:'DGFLD D
|
|---|
| 139 | . I DGPTYP=1 D
|
|---|
| 140 | .. S ^TMP($J,DGNS,DGPTYP,DGNAME,DGSSN,DGIENS,DGFARR(0,DGFILEP,DGFLD))=DGPARR(DGPTYP,DGFILEP,DGIENS,DGFLD)
|
|---|
| 141 | .. S DGSARR(DGPTYP,DGFARR(0,DGFILEP,DGFLD))=$G(DGSARR(DGPTYP,DGFARR(0,DGFILEP,DGFLD)))+1
|
|---|
| 142 | .. Q
|
|---|
| 143 | . I DGPTYP=2 D
|
|---|
| 144 | .. S ^TMP($J,DGNS,DGPTYP,DGNAME,DGSSN,DGIENS,DGFORR(0,DGFILEP,DGFLD))=DGPARR(DGPTYP,DGFILEP,DGIENS,DGFLD)
|
|---|
| 145 | .. S DGSARR(DGPTYP,DGFORR(0,DGFILEP,DGFLD))=$G(DGSARR(DGPTYP,DGFORR(0,DGFILEP,DGFLD)))+1
|
|---|
| 146 | .. Q
|
|---|
| 147 | . Q
|
|---|
| 148 | Q
|
|---|
| 149 | ;
|
|---|
| 150 | HDR(DGRPTYP,DGPTYP,DGPAGE) ;
|
|---|
| 151 | N DGQUIT
|
|---|
| 152 | S DGQUIT=0
|
|---|
| 153 | I DGPAGE,$E(IOST,1,2)="C-" K X,Y,DIR S DIR(0)="E" D ^DIR S DGQUIT=$D(DIRUT)
|
|---|
| 154 | D:'DGQUIT
|
|---|
| 155 | .W @IOF
|
|---|
| 156 | .S X="Report of States Not Recognized by AAC and Inactive Counties"
|
|---|
| 157 | .W ?(IOM\2-($L(X)\2)),X
|
|---|
| 158 | .S X=DGRPTYP(DGPTYP)
|
|---|
| 159 | .W !,?(IOM\2-($L(X)\2)),X
|
|---|
| 160 | .S DGPAGE=DGPAGE+1
|
|---|
| 161 | .W ?(IOM-10),"PAGE: "_DGPAGE
|
|---|
| 162 | .W !!,"NAME",?26,"SSN",?38,"FIELD",?68,"STATE/COUNTY"
|
|---|
| 163 | .W !
|
|---|
| 164 | Q DGQUIT
|
|---|
| 165 | ;
|
|---|
| 166 | RPT(DGNS,DGRPTYP,DGSTRT,DGEND) ;
|
|---|
| 167 | N DGPAGE,DGQUIT,DGPTYP
|
|---|
| 168 | S DGPAGE=0
|
|---|
| 169 | S DGQUIT=0
|
|---|
| 170 | S DGPTYP=0
|
|---|
| 171 | F DGPTYP=DGSTRT:1:DGEND Q:DGQUIT D RPTG
|
|---|
| 172 | Q
|
|---|
| 173 | RPTG ;
|
|---|
| 174 | N DGNAME,CNT
|
|---|
| 175 | S CNT=0
|
|---|
| 176 | S DGQUIT=$$HDR(.DGRPTYP,DGPTYP,.DGPAGE)
|
|---|
| 177 | Q:DGQUIT
|
|---|
| 178 | S DGNAME=""
|
|---|
| 179 | F S DGNAME=$O(^TMP($J,DGNS,DGPTYP,DGNAME)) Q:'$L(DGNAME) Q:DGQUIT D RDGSSN
|
|---|
| 180 | W !!,"Total records reported: ",CNT
|
|---|
| 181 | Q
|
|---|
| 182 | RDGSSN ;
|
|---|
| 183 | N DGSSN
|
|---|
| 184 | S DGSSN=""
|
|---|
| 185 | F S DGSSN=$O(^TMP($J,DGNS,DGPTYP,DGNAME,DGSSN)) Q:'$L(DGSSN) Q:DGQUIT D RDGIENS
|
|---|
| 186 | Q
|
|---|
| 187 | RDGIENS ;
|
|---|
| 188 | N DGIENS
|
|---|
| 189 | S DGIENS=""
|
|---|
| 190 | F S DGIENS=$O(^TMP($J,DGNS,DGPTYP,DGNAME,DGSSN,DGIENS)) Q:DGIENS="" Q:DGQUIT D RDGTXT
|
|---|
| 191 | Q
|
|---|
| 192 | RDGTXT ;
|
|---|
| 193 | N DGTEXT
|
|---|
| 194 | S DGTXT=""
|
|---|
| 195 | F S DGTXT=$O(^TMP($J,DGNS,DGPTYP,DGNAME,DGSSN,DGIENS,DGTXT)) Q:'$L(DGTXT) D Q:DGQUIT
|
|---|
| 196 | . I $Y>(IOSL-4) S DGQUIT=$$HDR(.DGRPTYP,DGPTYP,.DGPAGE) Q:DGQUIT
|
|---|
| 197 | . S DGTEXT=$G(^TMP($J,DGNS,DGPTYP,DGNAME,DGSSN,DGIENS,DGTXT))
|
|---|
| 198 | . W !,$E(DGNAME,1,25),?26,DGSSN,?38,DGTXT,?68,$E($P(DGTEXT,U,1),1,12)
|
|---|
| 199 | . S CNT=CNT+1
|
|---|
| 200 | . Q
|
|---|
| 201 | Q
|
|---|
| 202 | ;
|
|---|
| 203 | XMY(DGSARR,DGRPTYP) ;
|
|---|
| 204 | N DGTXT,XMDUZ,XMSUB,XMY,XMTEXT,MSG,DGLINE,X
|
|---|
| 205 | S XMY(DUZ)="",XMTEXT="MSG(",XMDUZ=.5
|
|---|
| 206 | S XMSUB="Invalid State/Inactive County Report Summary"
|
|---|
| 207 | S MSG(1)="The following counts have been found in the PATIENT file:"
|
|---|
| 208 | S MSG(5)=""
|
|---|
| 209 | S DGPTYP=0
|
|---|
| 210 | S DGLINE=10
|
|---|
| 211 | I DGRPTYP'=2,'$D(DGSARR(1)) D
|
|---|
| 212 | . S DGLINE=DGLINE+1
|
|---|
| 213 | . S MSG(DGLINE)=DGRPTYP(1)
|
|---|
| 214 | . S DGLINE=DGLINE+1
|
|---|
| 215 | . S MSG(DGLINE)=" No Invalid States or Inactive Counties Found"
|
|---|
| 216 | . Q
|
|---|
| 217 | I DGRPTYP'=1,'$D(DGSARR(2)) D
|
|---|
| 218 | . S DGLINE=DGLINE+1
|
|---|
| 219 | . S MSG(DGLINE)=DGRPTYP(2)
|
|---|
| 220 | . S DGLINE=DGLINE+1
|
|---|
| 221 | . S MSG(DGLINE)=" No Invalid States or Inactive Counties Found"
|
|---|
| 222 | . Q
|
|---|
| 223 | F S DGPTYP=$O(DGSARR(DGPTYP)) Q:'DGPTYP D
|
|---|
| 224 | . S DGLINE=DGLINE+1
|
|---|
| 225 | . S MSG(DGLINE)=""
|
|---|
| 226 | . S DGLINE=DGLINE+1
|
|---|
| 227 | . S MSG(DGLINE)=DGRPTYP(DGPTYP)
|
|---|
| 228 | . S DGLINE=DGLINE+1
|
|---|
| 229 | . S MSG(DGLINE)=""
|
|---|
| 230 | . S DGTXT=""
|
|---|
| 231 | . F S DGTXT=$O(DGSARR(DGPTYP,DGTXT)) Q:'$L(DGTXT) D
|
|---|
| 232 | .. S DGLINE=DGLINE+1
|
|---|
| 233 | .. S X="",$P(X," ",32-$L(DGTXT))=""
|
|---|
| 234 | .. S MSG(DGLINE)=" "_DGTXT_X_DGSARR(DGPTYP,DGTXT)
|
|---|
| 235 | .. Q
|
|---|
| 236 | . Q
|
|---|
| 237 | D ^XMD
|
|---|
| 238 | Q
|
|---|
| 239 | ;
|
|---|
| 240 | FILE2(DGFARR,TAG) ;
|
|---|
| 241 | N I,X,DGFILED,DGFLDNO
|
|---|
| 242 | F I=1:1 S X=$P($T(@TAG+I),";;",2) Q:X="END" D
|
|---|
| 243 | .S DGFILED=$P(X,";"),DGFLDNO=$P(X,";",2),DGFARR(0,DGFILED,DGFLDNO)=$P(X,";",3) S:'$D(DGFARR(1,DGFILED)) DGFARR(1,DGFILED)=""
|
|---|
| 244 | .S DGFARR(1,DGFILED)=DGFARR(1,DGFILED)_$E(";",$L(DGFARR(1,DGFILED))>0)_DGFLDNO
|
|---|
| 245 | Q
|
|---|
| 246 | ;
|
|---|
| 247 | FOTXT ;
|
|---|
| 248 | ;;2;.115;Permanent Address - State
|
|---|
| 249 | ;;2;.1215;Temporary Address - State
|
|---|
| 250 | ;;2;.1415;Confidential Address - State
|
|---|
| 251 | ;;END
|
|---|
| 252 | ;
|
|---|
| 253 | FATXT ;
|
|---|
| 254 | ;;2;.093;Place of Birth
|
|---|
| 255 | ;;2;.115;Permanent Address - State
|
|---|
| 256 | ;;2;.117;Permanent Address - County
|
|---|
| 257 | ;;2;.1215;Temporary Address - State
|
|---|
| 258 | ;;2;.12111;Temporary Address - County
|
|---|
| 259 | ;;2;.1415;Confidential Address - State
|
|---|
| 260 | ;;2;.14111;Confidential Address - County
|
|---|
| 261 | ;;2;.1654;Ineligible TWX
|
|---|
| 262 | ;;2;.1659;Missing Person TWX
|
|---|
| 263 | ;;2;.217;Next of Kin
|
|---|
| 264 | ;;2;.2197;Next of Kin 2
|
|---|
| 265 | ;;2;.256;Spouse's Employer
|
|---|
| 266 | ;;2;.2917;VA Guardian
|
|---|
| 267 | ;;2;.2927;Civil Guardian
|
|---|
| 268 | ;;2;.3117;Employer
|
|---|
| 269 | ;;2;.3317;Emergency Contact 2
|
|---|
| 270 | ;;2;.337;Emergency Contact
|
|---|
| 271 | ;;2;.347;Designee
|
|---|
| 272 | ;;2;2.06;Insurance Type - Emp Claims
|
|---|
| 273 | ;;2;3.09;Insurance Type - Insured's
|
|---|
| 274 | ;;2;13;Insurance Type - Agent's
|
|---|
| 275 | ;;2;35;Attorney
|
|---|
| 276 | ;;END
|
|---|
| 277 | ;
|
|---|
| 278 | ISACT(DFN) ;
|
|---|
| 279 | N X,DGACT,HLQ
|
|---|
| 280 | S HLQ=""""""
|
|---|
| 281 | S DGACT=$P($G(^DPT(DFN,.35)),U) ; date of death
|
|---|
| 282 | I DGACT Q "N"
|
|---|
| 283 | S DGACT=$S(+$$LTD^VAFHUTL(DFN)=-1:0,1:+$$LTD^VAFHUTL(DFN)) ; active appointment
|
|---|
| 284 | S:'DGACT DGACT=$$PHARM^IVMLDEM6(DFN) ; active RX
|
|---|
| 285 | Q $S(DGACT:"Y",1:"N")
|
|---|
| 286 | ;
|
|---|
| 287 | FOREIGN(STATE) ;uses state to determine foreign address
|
|---|
| 288 | ;someday should use country codes in the patient file
|
|---|
| 289 | N DESC,X
|
|---|
| 290 | I $G(STATE)="" Q "N"
|
|---|
| 291 | S X=$G(^DIC(5,STATE,0))
|
|---|
| 292 | I $P(X,"^",6)=1 Q "N"
|
|---|
| 293 | Q "Y"
|
|---|
