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

DGYPREG1.m

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