103 lines
3.9 KiB
Mathematica
103 lines
3.9 KiB
Mathematica
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
|