119 lines
4.5 KiB
Mathematica
119 lines
4.5 KiB
Mathematica
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
|