DGRSTBAD ;JDH,EG,PHH-STATE FILE REPORT ; 03/16/2007 4:15 PM
 ;;5.3;Registration;**694,738**;Aug 13, 1993;Build 6
 Q
EN N %ZIS,DGNS,DIR,X,Y,DGRPTYP,DIRUT,MSG,POP,ZTSK
 S DIR("A")="Report on States Not Recognized by AAC or Inactive Counties for"
 S DGRPTYP(1)="US and US Possessions Only"
 S DGRPTYP(2)="Foreign Addresses Only"
 S DIR("B")=1
 S DIR(0)="S^1:"_DGRPTYP(1)_";2:"_DGRPTYP(2)_";3:Both"
 D ^DIR G:$D(DIRUT) EXIT
 S DGRPTYP=Y
 S MSG(1)=""
 S MSG(2)="This report may take a long time to generate.  It is recommended that the report"
 S MSG(3)="be queued to print."
 S MSG(4)=""
 D BMES^XPDUTL(.MSG)
 S %ZIS="Q" D ^%ZIS G:POP EXIT
 S DGNS="DGRSTBAD"
 I $D(IO("Q")) D ZTSK G EXIT
 D PROC(DGNS,.DGRPTYP),^%ZISC
 Q
EXIT D HOME^%ZIS
 Q
 ;
ZTSK ;
 N ZTSAVE,ZTDTH,ZTRTN,ZTDESC,Y
 S (ZTSAVE("DGRPTYP"),ZTSAVE("DGRPTYP("),ZTSAVE("DGNS"))=""
 S %DT("A")="Requested Start Time: ",%DT="FATE"
 S %DT(0)="NOW",%DT("B")="NOW" D ^%DT K %DT(0) I Y<0 Q
 S ZTDTH=Y
 S ZTDESC="INVALID STATE/INACTIVE COUNTY REPORT"
 S ZTRTN="PROC^"_DGNS_"(DGNS,.DGRPTYP)"
 D ^%ZTLOAD
 I $D(ZTSK) D
 .W !!,"REPORT QUEUED"
 E  W !!,"REPORT NOT QUEUED"
 Q
 ;
PROC(DGNS,DGRPTYP) ;
 N X,DGFARR,DGFORR,DGSARR,DFN,DGD1,DGGLB,DGFILEP,DGPARR,DGIENS,DGFILE,DGNODE,DGPTYP,DGTARR,DGNAME
 N DGIENS,DGSSN,DGPAGE,DGFLDNO,DGFLDS,DGPTR,DGTXT,DGFLD,DGQUIT,DGEND,DGSTRT,X1
 S DGFILE=2
 S DGGLB="^DPT"
 K ^TMP($J,DGNS)
 D FILE2(.DGFORR,"FOTXT")
 D FILE2(.DGFARR,"FATXT")
 S DGSTRT=$S(DGRPTYP=3:1,1:DGRPTYP)
 S DGEND=$S(DGRPTYP=3:2,1:DGRPTYP)
 S DFN=0
 F  S DFN=$O(^DPT(DFN)) Q:'DFN  D
 . K DGPARR
 . I $$ISACT(DFN)'="Y" Q
 . D FLDL
 . Q
 D RPT(DGNS,.DGRPTYP,DGSTRT,DGEND)
 D XMY(.DGSARR,.DGRPTYP)
 K ^TMP($J,DGNS)
 Q
 ;
FLDL ;
 I DGRPTYP'=2 D
 . S DGFILEP=0
 . F  S DGFILEP=$O(DGFARR(1,DGFILEP)) Q:'DGFILEP  D FLDLG
 . Q
 I DGRPTYP'=1 D
 . S DGFILEP=0
 . F  S DGFILEP=$O(DGFORR(1,DGFILEP)) Q:'DGFILEP  D FLDLG
 . Q
 D:$D(DGPARR) BUILD(DGNS,DFN,.DGPARR,.DGFARR,.DGSARR)
 Q
FLDLG ;  
 I DGFILEP=DGFILE D
 . S DGIENS=DFN_","
 . D CHECK1(DGRPTYP,.DGFARR,.DGFORR,DGFILEP,DGIENS,.DGPARR,DGSTRT,DGEND)
 . Q
 E  D
 . S X=+$O(^DD(DGFILE,"SB",DGFILEP,0))
 . S DGNODE=$P($P($G(^DD(DGFILE,X,0)),U,4),";") Q:'$L(DGNODE)
 . S DGD1=0
 . F  S DGD1=$O(@DGGLB@(DFN,DGNODE,DGD1)) Q:'DGD1  D
 .. S DGIENS=DGD1_","_DFN_","
 .. D CHECK1(DGRPTYP,.DGFARR,.DGFORR,DGFILEP,DGIENS,.DGPARR,DGSTRT,DGEND)
 .. Q
 . Q
 Q
CHECK1(DGRPTYP,DGFARR,DGFORR,DGFILEP,DGIENS,DGPARR,DGSTRT,DGEND) ;
 ;
 ;For each report type
 F DGPTYP=DGSTRT:1:DGEND D CHG
 Q
CHG ;
 N FOREIGN
 ;Extract appropriate fields for report type
 I DGPTYP=1 S DGFLDS=DGFARR(1,DGFILEP)
 E  S DGFLDS=DGFORR(1,DGFILEP)
 K DGTARR,DGERR,SDQUERY,SDQDATA
 N I D GETS^DIQ(DGFILEP,DGIENS,DGFLDS,"I","DGTARR","DGERR")
 S DGFLD=0
 F  S DGFLD=$O(DGTARR(DGFILEP,DGIENS,DGFLD)) Q:'DGFLD  D
 . S DGPTR=DGTARR(DGFILEP,DGIENS,DGFLD,"I") Q:'DGPTR
 . S FOREIGN=$$FOREIGN(DGPTR)
 . I FOREIGN="Y",DGPTYP=1 Q
 . I FOREIGN="N",DGPTYP=2 Q
 . ;Check county inactive date for both foreign and US
 . I DGFLD=.117 D
 .. S X1=DGTARR(DGFILEP,DGIENS,.115,"I")
 .. S X=$G(^DIC(5,X1,1,DGPTR,0))
 .. S:$P(X,U,5)!$D(DGPARR(DGPTYP,DGFILEP,DGIENS,.115)) DGPARR(DGPTYP,DGFILEP,DGIENS,DGFLD)=$P(X,U)
 .. Q
 . S X=$G(^DIC(5,DGPTR,0))
 . I '$P(X,U,5)!($E($P(X,U,1),1)="Z") S DGPARR(DGPTYP,DGFILEP,DGIENS,DGFLD)=$P(X,U)
 . Q
 Q
 ;
BUILD(DGNS,DGDO,DGPARR,DGFARR,DGSARR) ;
 ;
 N X,DGNAME,DGSSN,DGPTYP
 S X=$G(^DPT(DFN,0))
 S DGNAME=$P(X,U) Q:'$L(DGNAME)
 S DGSSN=$P(X,U,9)
 S:'$L(DGSSN) DGSSN="NONE"
 S DGPTYP=0
 F  S DGPTYP=$O(DGPARR(DGPTYP)) Q:'DGPTYP  D DGFILEP
 Q
DGFILEP ;
 N DGFILEP
 S DGFILEP=0
 F  S DGFILEP=$O(DGPARR(DGPTYP,DGFILEP)) Q:'DGFILEP  D DGIENS
 Q
DGIENS ;
 N DGIENS
 S DGIENS=""
 F  S DGIENS=$O(DGPARR(DGPTYP,DGFILEP,DGIENS)) Q:DGIENS=""  D DGFLD
 Q
DGFLD ;
 N DGFLD
 S DGFLD=0
 F  S DGFLD=$O(DGPARR(DGPTYP,DGFILEP,DGIENS,DGFLD)) Q:'DGFLD  D
 . I DGPTYP=1 D
 .. S ^TMP($J,DGNS,DGPTYP,DGNAME,DGSSN,DGIENS,DGFARR(0,DGFILEP,DGFLD))=DGPARR(DGPTYP,DGFILEP,DGIENS,DGFLD)
 .. S DGSARR(DGPTYP,DGFARR(0,DGFILEP,DGFLD))=$G(DGSARR(DGPTYP,DGFARR(0,DGFILEP,DGFLD)))+1
 .. Q
 . I DGPTYP=2 D
 .. S ^TMP($J,DGNS,DGPTYP,DGNAME,DGSSN,DGIENS,DGFORR(0,DGFILEP,DGFLD))=DGPARR(DGPTYP,DGFILEP,DGIENS,DGFLD)
 .. S DGSARR(DGPTYP,DGFORR(0,DGFILEP,DGFLD))=$G(DGSARR(DGPTYP,DGFORR(0,DGFILEP,DGFLD)))+1
 .. Q
 . Q
 Q
 ;
HDR(DGRPTYP,DGPTYP,DGPAGE) ;
 N DGQUIT
 S DGQUIT=0
 I DGPAGE,$E(IOST,1,2)="C-" K X,Y,DIR S DIR(0)="E" D ^DIR S DGQUIT=$D(DIRUT)
 D:'DGQUIT
 .W @IOF
 .S X="Report of States Not Recognized by AAC and Inactive Counties"
 .W ?(IOM\2-($L(X)\2)),X
 .S X=DGRPTYP(DGPTYP)
 .W !,?(IOM\2-($L(X)\2)),X
 .S DGPAGE=DGPAGE+1
 .W ?(IOM-10),"PAGE: "_DGPAGE
 .W !!,"NAME",?26,"SSN",?38,"FIELD",?68,"STATE/COUNTY"
 .W !
 Q DGQUIT
 ;
RPT(DGNS,DGRPTYP,DGSTRT,DGEND) ;
 N DGPAGE,DGQUIT,DGPTYP
 S DGPAGE=0
 S DGQUIT=0
 S DGPTYP=0
 F DGPTYP=DGSTRT:1:DGEND Q:DGQUIT  D RPTG
 Q
RPTG ;
 N DGNAME,CNT
 S CNT=0
 S DGQUIT=$$HDR(.DGRPTYP,DGPTYP,.DGPAGE)
 Q:DGQUIT
 S DGNAME=""
 F  S DGNAME=$O(^TMP($J,DGNS,DGPTYP,DGNAME)) Q:'$L(DGNAME)  Q:DGQUIT  D RDGSSN
 W !!,"Total records reported: ",CNT
 Q
RDGSSN ;
 N DGSSN
 S DGSSN=""
 F  S DGSSN=$O(^TMP($J,DGNS,DGPTYP,DGNAME,DGSSN)) Q:'$L(DGSSN)  Q:DGQUIT  D RDGIENS
 Q
RDGIENS ;
 N DGIENS
 S DGIENS=""
 F  S DGIENS=$O(^TMP($J,DGNS,DGPTYP,DGNAME,DGSSN,DGIENS)) Q:DGIENS=""  Q:DGQUIT  D RDGTXT
 Q
RDGTXT ;
 N DGTEXT
 S DGTXT=""
 F  S DGTXT=$O(^TMP($J,DGNS,DGPTYP,DGNAME,DGSSN,DGIENS,DGTXT)) Q:'$L(DGTXT)  D  Q:DGQUIT
 . I $Y>(IOSL-4) S DGQUIT=$$HDR(.DGRPTYP,DGPTYP,.DGPAGE) Q:DGQUIT
 . S DGTEXT=$G(^TMP($J,DGNS,DGPTYP,DGNAME,DGSSN,DGIENS,DGTXT))
 . W !,$E(DGNAME,1,25),?26,DGSSN,?38,DGTXT,?68,$E($P(DGTEXT,U,1),1,12)
 . S CNT=CNT+1
 . Q
 Q
 ;
XMY(DGSARR,DGRPTYP) ;
 N DGTXT,XMDUZ,XMSUB,XMY,XMTEXT,MSG,DGLINE,X
 S XMY(DUZ)="",XMTEXT="MSG(",XMDUZ=.5
 S XMSUB="Invalid State/Inactive County Report Summary"
 S MSG(1)="The following counts have been found in the PATIENT file:"
 S MSG(5)=""
 S DGPTYP=0
 S DGLINE=10
 I DGRPTYP'=2,'$D(DGSARR(1)) D
 . S DGLINE=DGLINE+1
 . S MSG(DGLINE)=DGRPTYP(1)
 . S DGLINE=DGLINE+1
 . S MSG(DGLINE)="   No Invalid States or Inactive Counties Found"
 . Q
 I DGRPTYP'=1,'$D(DGSARR(2)) D
 . S DGLINE=DGLINE+1
 . S MSG(DGLINE)=DGRPTYP(2)
 . S DGLINE=DGLINE+1
 . S MSG(DGLINE)="   No Invalid States or Inactive Counties Found"
 . Q
 F  S DGPTYP=$O(DGSARR(DGPTYP)) Q:'DGPTYP  D
 . S DGLINE=DGLINE+1
 . S MSG(DGLINE)=""
 . S DGLINE=DGLINE+1
 . S MSG(DGLINE)=DGRPTYP(DGPTYP)
 . S DGLINE=DGLINE+1
 . S MSG(DGLINE)=""
 . S DGTXT=""
 . F  S DGTXT=$O(DGSARR(DGPTYP,DGTXT)) Q:'$L(DGTXT)  D
 .. S DGLINE=DGLINE+1
 .. S X="",$P(X," ",32-$L(DGTXT))=""
 .. S MSG(DGLINE)="   "_DGTXT_X_DGSARR(DGPTYP,DGTXT)
 .. Q
 . Q
 D ^XMD
 Q
 ;
FILE2(DGFARR,TAG) ;
 N I,X,DGFILED,DGFLDNO
 F I=1:1 S X=$P($T(@TAG+I),";;",2) Q:X="END"  D
 .S DGFILED=$P(X,";"),DGFLDNO=$P(X,";",2),DGFARR(0,DGFILED,DGFLDNO)=$P(X,";",3) S:'$D(DGFARR(1,DGFILED)) DGFARR(1,DGFILED)=""
 .S DGFARR(1,DGFILED)=DGFARR(1,DGFILED)_$E(";",$L(DGFARR(1,DGFILED))>0)_DGFLDNO
 Q
 ;
FOTXT ;
 ;;2;.115;Permanent Address - State
 ;;2;.1215;Temporary Address - State
 ;;2;.1415;Confidential Address - State
 ;;END
 ;
FATXT ;
 ;;2;.093;Place of Birth
 ;;2;.115;Permanent Address - State
 ;;2;.117;Permanent Address - County
 ;;2;.1215;Temporary Address - State
 ;;2;.12111;Temporary Address - County
 ;;2;.1415;Confidential Address - State
 ;;2;.14111;Confidential Address - County
 ;;2;.1654;Ineligible TWX
 ;;2;.1659;Missing   Person TWX
 ;;2;.217;Next of Kin
 ;;2;.2197;Next of Kin 2
 ;;2;.256;Spouse's Employer
 ;;2;.2917;VA Guardian
 ;;2;.2927;Civil Guardian
 ;;2;.3117;Employer
 ;;2;.3317;Emergency Contact 2
 ;;2;.337;Emergency Contact
 ;;2;.347;Designee
 ;;2;2.06;Insurance Type - Emp Claims
 ;;2;3.09;Insurance Type - Insured's
 ;;2;13;Insurance Type - Agent's
 ;;2;35;Attorney
 ;;END
 ;
ISACT(DFN) ;
 N X,DGACT,HLQ
 S HLQ=""""""
 S DGACT=$P($G(^DPT(DFN,.35)),U) ; date of death
 I DGACT Q "N"
 S DGACT=$S(+$$LTD^VAFHUTL(DFN)=-1:0,1:+$$LTD^VAFHUTL(DFN)) ; active appointment
 S:'DGACT DGACT=$$PHARM^IVMLDEM6(DFN) ; active RX
 Q $S(DGACT:"Y",1:"N")
 ;
FOREIGN(STATE) ;uses state to determine foreign address
 ;someday should use country codes in the patient file
 N DESC,X
 I $G(STATE)="" Q "N"
 S X=$G(^DIC(5,STATE,0))
 I $P(X,"^",6)=1 Q "N"
 Q "Y"