Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGRSTBAD

DGRSTBAD.m

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