source: FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGYPREG1.m@ 636

DGYPREG1 ;ALB/REW - POST-INIT PATIENT FILE POST-INIT CONT'D ;1-APR-93
 ;;5.3;Registration;;Aug 13, 1993
CFLREP ;End of Patient File Loop: Problem CFL Fields
 N DGDJ
 D SETUP(1) ; 1=CFL 2=TOTVACHK
 D CSUM(1),CDET
 D END
 Q
TOTVAREP ;End of Patient File Loop: Problem MB Fields
 S DGDJ=$G(DGDJ)
 N FROM,REP,SUB,TEXT,TO
 N DGACT,DGDJ,DGFSTINT,DGL4,DGLPCT,DGPTNM,DGX,DGTEXT,X
 S DGLPCT=0
 D SETUP(2) ;1=CFL 2=TOTVA
 D CSUM(2)
 S DGFSTINT=+(9999999-$G(DGFSTDT)) ;INTERNAL FIRST DATE TO PRINT
 I $G(DGFSTDT) D
 .D MESS("    Only patients whose Last Activity Date is AFTER "_$E(DGFSTDT,4,5)_"/"_$E(DGFSTDT,6,7)_"/"_$E(DGFSTDT,2,3)_" will be listed.",1)
 I $G(DGTOTBD)>DGMAXPT D
 .D MESS("    Only "_DGMAXPT_" patients will be listed.",2)
 .D MESS("   To see more, run the PIMS Monetary Benefit Amounts Conversion Report",1)
 D MESS("PATIENT NAME     LAST  ACTIVITY         A&A      H.B.      Dis.   Pension")
 D MESS($E(DGSPACE,1,17)_"4-ID    DATE        AMOUNT    AMOUNT    AMOUNT    AMOUNT")
 D MESS(DGUND)
 F DGACT=0:0 S DGACT=$O(^TMP("DGBDMB",$J,DGACT)) Q:'DGACT  F DFN=0:0 S DFN=$O(^TMP("DGBDMB",$J,DGACT,DFN)) Q:'DFN!(DGLPCT'<DGMAXPT)!(DGACT>DGFSTINT)  S DGX=$G(^(DFN)) D
 .D GETID
 .S X=9999999-DGACT
 .S DGTEXT=DGPTNM_$E(DGSPACE,$L(DGPTNM),16)_DGL4_"  "_$E(X,4,5)_"-"_$E(X,6,7)_"-"_$E(X,2,3)_$E(DGSPACE,$L(X),6)_"  "
 .F X=1:1:4 S DGTEXT=DGTEXT_$J($P(DGX,U,X),10,2)
 .D MESS(DGTEXT)
 .S DGLPCT=DGLPCT+1
 D END
 Q
END ;
 N DIFROM
 D ^XMD
 ;K @DGROOT
 K DGFSTDT,DGMAXPT,DGROOT,DGSPACE,DGTEXT,DGUCCT,DGUND,DGX,DGXM,DIR,XMDUZ,XMSUB,XMTEXT,XMY
 Q
SETUP(REP) ;
 Q:'$G(REP)
 S DGDJ=$S($G(DGDJ):DGDJ,1:$J)
 S $P(DGUND,"=",76)=""
 S $P(DGSPACE," ",81)=""
 S:'$G(DGMAXPT) DGMAXPT=1999
 S XMSUB=$S(REP=1:"Claims Folder Location Conversion Report",(REP=2):"Total Annual VA Check Amount Conversion Report",1:"PATIENT File ZIP+4 Population Complete")
 S XMDUZ=.5
 S XMY(DUZ)=""
 S XMY(.5)=""
 S DGROOT="^TMP("_$S(REP=1:"""DGCFLREP""",(REP=2):"""DGTOTVA""",1:"""DGZIP4""")_","_$J
 S XMTEXT=DGROOT_","
 S DGROOT=DGROOT_")"
 K @DGROOT
 D:(REP<3) HEAD^DGYPREG2(REP)
 Q
CSUM(REP) ;PRINTS SUMMARY
 ;OUTPUT: DGUCCT = #Un-Convertible Patients
 N ACT,ACTCT,CT,DFN,SUB,Z
 D MESS("    "_($E(DGSPACE,1,23)_"TOTAL    ACTIVE  INACTIVE"))
 S Z=9999999-(DT-10000)
 S DGUCCT=0
 I REP=1 F SUB="DGBDCFL","DGGDCFL" S (CT,ACTCT)=0 D SUM  S:SUB="DGBDCFL" DGUCCT=CT
 I REP=2 F SUB="DGBDMB","DGGDMB" S (CT,ACTCT)=0 D SUM  S:SUB="DGBDMB" DGUCCT=CT
 D MESS("")
 Q
SUM ;
 F ACT=0:0 S ACT=$O(^TMP(SUB,$J,ACT)) Q:'ACT  D
 .S DFN=0 F CT=CT:1 S DFN=$O(^TMP(SUB,$J,ACT,DFN)) Q:'DFN  S:ACT<Z ACTCT=ACTCT+1
 D MESS("    "_$S(SUB["DGBD":"Un-Convertible:",1:"Convertible:")_$E(DGSPACE,$S(SUB["DGGD":12,1:15),19)_$J(CT,8)_"  "_$J(ACTCT,8)_"  "_$J((CT-ACTCT),8))
 Q
CDET ;
 N DGCT,DGDT,DGACT,DGFSTINT,DGL4,DGPTNM,X
 Q:'$G(DGMAXPT)
 Q:'$G(DGUCCT)
 D MESS("")
 S DGFSTINT=+(9999999-$G(DGFSTDT)) ;INTERNAL FIRST DATE TO PRINT
 I $G(DGFSTDT) D
 .D MESS("    Only patients whose Last Activity Date is AFTER "_$E(DGFSTDT,4,5)_"/"_$E(DGFSTDT,6,7)_"/"_$E(DGFSTDT,2,3)_" will be listed.",1)
 I DGUCCT>DGMAXPT D
 .D MESS("    Only "_DGMAXPT_" patients will be listed.",2)
 .D MESS("   To see more, run the PIMS Claim Folder Location Conversion Report",1)
 D MESS("PATIENT NAME      LAST  ACTIVITY     CLAIM FOLDER")
 D MESS($E(DGSPACE,1,18)_"4-ID  DATE         LOCATION")
 D MESS(DGUND)
 S CT=0
 F DGACT=0:0 S DGACT=$O(^TMP("DGBDCFL",$J,DGACT)) Q:('DGACT)!(DGMAXPT'>CT)!(DGACT>DGFSTINT)  S DFN=0 F CT=CT:1:DGMAXPT S DFN=$O(^TMP("DGBDCFL",$J,DGACT,DFN)) Q:'DFN  S DGX=$G(^(DFN)) D
 .D GETID
 .S X=9999999-DGACT
 .D MESS(DGPTNM_$E(DGSPACE,$L(DGPTNM),17)_DGL4_"  "_$E(X,4,5)_"-"_$E(X,6,7)_"-"_$E(X,2,3)_$E(DGSPACE,$L(X),6)_"     "_$P(DGX,U,2))
 Q
GETID ;
 N DGPNODE
 S DGPNODE=$G(^DPT(DFN,0))
 S DGPTNM=$E($P(DGPNODE,U,1),1,15),DGL4=$E($P(DGPNODE,U,9),6,9)
 Q
ACTDT(DFN) ;RETURNS LAST ACTIVE DATE
 N A,ACTDT,X,Y
 S ACTDT=0
 S X=$O(^DPT(DFN,"DIS",0)) S:X ACTDT=9999999-X ;REG
 S:$G(^DPT(DFN,.105)) ACTDT=DT ;INPATIENT
 F A=0:0 S A=$O(^DGS(41.1,"B",DFN,A)) Q:A'>0  S X=$P($G(^DGS(41.1,+A,0)),U,2) S:X>ACTDT ACTDT=X ;ADM
 S X=ACTDT F  S X=$O(^DPT(DFN,"S",X)) S:X Y=X I 'X S:$G(Y)>ACTDT ACTDT=Y Q  ;CLIN
 S X=ACTDT F  S X=$O(^DGPM("APRD",DFN,X)) S:X Y=X I 'X S:$G(Y)>ACTDT ACTDT=Y Q  ;PM
MESS(TEXT,LINES) ;ADD TO MAIL TEXT
 ;
 ; INPUT VARIABLES:
 ;  DGROOT - ARRAY HOLDING MAIL TEXT (NEEDS TO BE DEFINED)
 ;  TEXT   - CONTENT OF NEXT LINE (PARAMETER)
 ;  LINES  - [Optional] Parameter to do following line feed(s)
 ;  DGXM   - LINE COUNT (NEEDS TO BE DEFINED)
 Q:'$G(DGXM)!'$D(TEXT)
 N I
 S LINES=+$G(LINES)
 F I=0:1:LINES D
 .S DGXM=DGXM+1
 .S @DGROOT@(DGXM,0)=TEXT
 .S TEXT=""
 Q