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

DGYPREG ;ALB/REW - POST-INIT CONVERSION ROUTINES OF PATIENT FILE ;12-MAR-93
 ;;5.3;Registration;;Aug 13, 1993
 ;
EN1(DGDOMB,DGDOCFL) ;
 ;  INPUT:
 ;     DGDOMB - 0=NOTHING, 1=REPORT, 2=REPORT & CONVERSION
 ;     DGDOCFL- "
EN ;
 N CT,DGCFLBD,DGCFLCN,DGDAY,DGDJ,DGTOTBD,DGTOTCN,X,XCNP,XMZ
 S:('$D(DGDOMB))&('$D(DGDOCFL)) (DGDOMB,DGDOCFL)=1
 N DGSTDT,DGENDT,Y,%
 D STTIME("Patient File Loop"),LOOP,ENDTIME("Patient File Loop")
 Q
STTIME(DGDESC) I '$D(ZTQUEUED) D NOW^%DTC S DGSTDT=$H,DT=X,Y=% W !!,">>> "_DGDESC_" started: " D DT^DIQ W !!
 Q
ENDTIME(DGDESC) ; -get stop time
 I '$D(ZTQUEUED) D NOW^%DTC S DGENDT=$H W:'$D(ZTQUEUED) !!,">>> "_DGDESC_" complete at " S Y=% D DT^DIQ
 I $D(DGENDT) D
 .S DGDAY=+DGENDT-(+DGSTDT)*86400 ;additional seconds of over midnight
 .S X=DGDAY+$P(DGENDT,",",2)-$P(DGSTDT,",",2) W:'$D(ZTQUEUED) !,"    Elapse time for loop was: ",X\3600," Hours,  ",X\60-(X\3600*60)," Minutes,  ",X#60," Seconds"
 Q
INITLOOP ;
 S (DGCFLCN,DGCFLBD,DGTOTCN,DGTOTBD)=0
 S:'$D(DGDOMB)&('$D(DGDOCFL)) (DGDOMB,DGDOCFL)=2
 Q
LOOP ;
 D INITLOOP
 N DIRUT,DFN,RWVCOM,RWEND,RWSKIP,RWSTOP
 S RWSKIP=1,RWSTOP=99999999
 F DFN=0:0 S DFN=$O(^DPT(DFN)) Q:DFN'>0!(DFN>RWSTOP)  I '(DFN#RWSKIP) D
 .W:'$D(ZTQUEUED)&('(DFN#100)) "."
 .Q:'$D(^DPT(DFN,0))
 .D:$G(DGDOMB) TOTVAAMT(DFN,(DGDOMB-1)) ;:'$G(^DPT(DFN,.35))
 .D:$G(DGDOCFL) CFL(DFN,(DGDOCFL-1)) ;:'$G(^DPT(DFN,.35)) - CAN BE ADDED TO NOT HANDLE DEAD
 D ENDLOOP^DGYPREG3
 K ^TMP("DGGDCFL",$J),^TMP("DGBDCFL",$J),^TMP("DGGDMB",$J),^TMP("DGBDMB",$J),^TMP("DGCFLREP",$J),^TMP("DGTOTVA",$J)
 Q
NOREC(DA,PC) ;RE-STUFFS NO ANSWER TO ACTIVATE DELETION TRIGGER
 N DIE,DR,DGFLDN
 G:'$G(DA)!('$G(PC)) QTNOREC
 S DIE=2
 S DGFLDN=$S(PC=1:.36205,(PC=2):.36215,(PC=3):.3025,(PC=4):.36235,1:"")
 G:'DGFLDN QTNOREC
 S DR=DGFLDN_"////N"
 D ^DIE
QTNOREC Q
TOTVAAMT(DFN,DGOKPOP) ;Populates TOTAL ANNUAL VA CHECK AMOUNT IGNORES 0nnnnn entries
 ; DGOKPOP = FLAG TO POPULATE FIELD
 N AMT,CT,DGNODE,DGPCN,DGRECN,PC,X
 S DGNODE=$G(^DPT(DFN,.362))
 S DGPCN="12^13^11^14"
 G:$P(DGNODE,U,20)]"" QTTVMT
 S AMT(3)=$P($G(^DPT(DFN,.3)),U,3)
 I $E(AMT(3)) I AMT(3)<99999 D
 .I $P(^DPT(DFN,.3),U,11)["N" D
 ..D:$G(DGOKPOP) NOREC(DFN,3)
 .E  S CT=1 S:$G(DGOKPOP) $P(^DPT(DFN,.362),U,20)=AMT(3)
 F PC=1,2,4 S AMT(PC)=$P(DGNODE,U,PC) I $E(AMT(PC)) I AMT(PC)<99999 D
 .I $P(DGNODE,U,($P(DGPCN,U,PC)))["N" D
 ..D:$G(DGOKPOP) NOREC(DFN,PC)
 .E  D
 ..S CT=$G(CT)+1
 ..S:$G(DGOKPOP) $P(^DPT(DFN,.362),U,20)=AMT(PC)
 I $G(CT)>1 D
 .S:$G(DGOKPOP) $P(^DPT(DFN,.362),U,20)=""
 .S ^TMP("DGBDMB",$J,(9999999-$$ACTDT(DFN)),DFN)=AMT(1)_U_AMT(2)_U_AMT(3)_U_AMT(4)
 .S DGTOTBD=$G(DGTOTBD)+1
 I $G(CT)=1 S DGTOTCN=$G(DGTOTCN)+1 S ^TMP("DGGDMB",$J,(9999999-$$ACTDT(DFN)),DFN)=""
QTTVMT Q
CFL(DFN,DGOKPOP) ;SORT ENTRIES AS BAD, NO CONVERSION NEEDED, AND CONVERTIBLE
 ; DGOKPOP = FLAG TO POPULATE FIELD
 N DGPTR4
 S DGPTR4=$$GOODCFL(DFN)
 G:'DGPTR4 QTCFL
 I DGPTR4<0 D
 .S ^TMP("DGBDCFL",$J,(9999999-$$ACTDT(DFN)),DFN)=DGPTR4
 .S DGCFLBD=$G(DGCFLBD)+1
 I DGPTR4>0 D
 .S ^TMP("DGGDCFL",$J,(9999999-$$ACTDT(DFN)),DFN)=DGPTR4
 .S DGCFLCN=$G(DGCFLCN)+1
 .S:$G(DGOKPOP) $P(^DPT(DFN,.31),U,4)=+DGPTR4 ;THIS POPULATES NEW FIELD
QTCFL Q
GOODCFL(DFN) ;RETURNS POINTER^DESC (TO INSTITUTION FILE),-1 (BAD),0 (NO CHNG)
 N DGCFL,DGNODE,X
 ;  OUTPUT [RETURNED]POINTER^DGCFL(CLAIM FOLDER LOCATION)
 S DGNODE=$G(^DPT(DFN,.31))
 S DGCFL=$P(DGNODE,U,2)
 I (DGCFL']"")!($P(DGNODE,U,4)]"") S X=0 G QTGCFL
 I $E(DGCFL,1,3)="000" S X=0 G QTGCFL
 I 'DGCFL S X=-1 G QTGCFL
 S X=$O(^DIC(4,"D",+DGCFL,0))
 I 'X S X=-1
QTGCFL Q X_U_DGCFL
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
QTACTDT Q ACTDT