- DGBTCE ;ALB/SCK/BLD,LAB - BENEFICIARY TRAVEL CLAIM RE-ENTER/EDIT ;03/20/2019
- ;;1.0;Beneficiary Travel;**2,14,17,20,30,37**;September 25, 2001;Build 1
- Q
- SCREEN ;
- D QUIT^DGBTCE1
- S DGBTTOUT=""
- D SCREEN^DGBTEE1 Q:'$D(^DGBT(392,DGBTDT,0)) I DGBTTOUT=-1 S DGBTTOUT=1 Q
- I $D(DGBTOACT) I DGBTOACT'=DGBTACCT S DGBTVAR(0)=^DGBT(392,DGBTDT,0) D FILE
- S (DGBTMAL,DGBTFAB,DGBTME,DGBTCP,DGBTFLAG,DGBTDE,DGBTDCV,DGBTDCM,DGBTDPV,DGBTDPM)=0
- S:$G(DGBTACCT)'>0 DGBTACCT=$P($G(DGBTVAR(0)),U,6)
- I DGBTACCT=4!(DGBTACCT=5) I $$ABP^DGBTUTL(DFN) W !!,"*ALERT: Patient has an active bus pass, which expires on ",$$FMTE^XLFDT($$ABP^DGBTUTL(DFN)),".",! S DIR("A")="Press RETURN to continue",DIR(0)="E" D ^DIR K DIR ;20
- S DGBTAP=VADM(1),DIE="^DGBT(392,",DA=DGBTDT,DR=$S(DGBTACCT=4:"42//"_DGBTAP,DGBTACCT=5:"43;S DGBTCP=X;42//"_DGBTAP,1:"44")
- D ^DIE K DIE,DQ,DR I $D(DTOUT)!($D(Y)) S DGBTTOUT=1 Q
- I DGBTACCT=4!(DGBTACCT=5) S:$D(DGBTVAR("M")) DGBTWAY=$P(DGBTVAR("M"),"^"),DGBTMILE=$P(DGBTVAR("M"),"^",2) S:$D(DGBTVAR("D")) DGBTCITY=$P(DGBTVAR("D"),"^",4),DGBTSTAT=$P(DGBTVAR("D"),"^",5)
- S DGBTDIV=$P($G(^DGBT(392,DA,0)),U,11),DGBTRMK=$S($D(DGBTREC):$$DICLKUP^DGBTUTL(DGBTREC,DGBTDIV,4),1:"")
- S DIE="^DGBT(392,",DA=DGBTDT
- ;DGBT*1.0*37 replace 4 slashes 3///' the ' allows for the internal value of a pointer to be validated and pushed
- S DR="3///`"_DGBTELIG_";6///`"_DGBTACTN_";21;I X="""" S Y=24;22;I X="""" S Y=24;23;24;24.1;24.2;25;I X="""" S Y=28;26;I X="""" S Y=28;27;28;28.1;28.2"
- D ^DIE K DIE I $D(DTOUT)!($D(Y)) S DGBTTOUT=1 Q
- W:DGBTRMK]"" !!,*7,"MILEAGE REMARKS: ",DGBTRMK,!
- I DGBTACCT=4!(DGBTACCT=5) D Q:$G(DGBTTOUT)
- .I $G(MONTOT)'="" N OTRIPTYP S OTRIPTYP=$$GET1^DIQ(392,DGBTDT,31,"I")
- . S DR="31//;S DGBTOWRT=X;32//;S DGBTML=X"
- . I DGBTACCT=5&(DGBTCP=1) S DGBTMR=DGBTMR1
- . S DIE="^DGBT(392,",DA=DGBTDT
- . D ^DIE K DIE,DQ,DR I $D(DTOUT)!($D(Y)) S DGBTTOUT=1
- .I ($G(MONTOT)'="")&($G(OTRIPTYP)'=$$GET1^DIQ(392,DGBTDT,31,"I")) D
- ..N NTRIPTYP S NTRIPTYP=$$GET1^DIQ(392,DGBTDT,31,"I")
- ..I (OTRIPTYP=1)&(NTRIPTYP=2) D Q
- ...S $P(MONTOT,U)=$P(MONTOT,U)+1
- ...S $P(MONTOT,U,2)=$P(MONTOT,U,2)-1
- ...S $P(MONTOT,U,3)=$P(MONTOT,U,3)+1
- ..I (OTRIPTYP=2)&(NTRIPTYP=1) D Q
- ...S $P(MONTOT,U)=$P(MONTOT,U)-1
- ...S $P(MONTOT,U,2)=$P(MONTOT,U,2)+1
- ...S $P(MONTOT,U,3)=$P(MONTOT,U,3)-1
- . N MODE S DIR(0)="Y",DIR("B")=$S($D(^DGBT(392,DGBTDT,"C")):"YES",1:"NO"),DIR("A")="COMMON CARRIER USED" D ^DIR K DIR S MODE=Y I $D(DIRUT),$G(DUOUT) S DGBTTOUT=-1 Q ;20
- . I 'MODE,$D(^DGBT(392,DGBTDT,"C")) S $P(^DGBT(392,DGBTDT,"A"),"^",4)="" F I="B","C" K ^DGBT(392,DGBTDT,I)
- . I $$GET1^DIQ(392,DGBTDT,44)'=""!($G(MODE)) S DIE="^DGBT(392,",DA=DGBTDT,DR="44COMMON CARRIER MODE" D ^DIE I $D(Y) S DGBTTOUT=1 Q ;20
- . S DIE="^DGBT(392,",DA=DGBTDT I $$UP^XLFSTR($$GET1^DIQ(392,DGBTDT,44))["BUS" S DR="52R;I X'=""P"" S Y="""";53R" D ^DIE I $D(Y) S DGBTTOUT=1 Q ;20
- . I $$GET1^DIQ(392,DGBTDT,44)'="" S DIE="^DGBT(392,",DA=DGBTDT,DR="54;55;55.1" D ^DIE I $D(Y) S DGBTTOUT=1 Q ;20
- DIE1 ;
- S DGBTMLT=$S($D(DGBTVAR("M"))&((DGBTACCT=4)!(DGBTACCT=5)):$J((DGBTOWRT*DGBTML*DGBTMR),0,2),1:""),$P(^DGBT(392,DGBTDT,"M"),"^",3)=DGBTMLT,$P(DGBTVAR("M"),"^",3)=DGBTMLT
- ;
- S DIE="^DGBT(392,",DA=DGBTDT
- I 'DGBTCORE D
- . S DR="I DGBTACCT=4!(DGBTACCT=5) S Y=""@1"";41;7;@1;I DGBTMLFB=0 S Y=""@2"";34//;S DGBTMAL=X;35//;S DGBTFAB=X;@2;8//;S DGBTME=X"
- I DGBTCORE S DR="" D
- . S DR(1,392,1)="I DGBTACCT=4!(DGBTACCT=5) S Y=""@1"";41;@3;14;S DGBTCSL=$$AFTER^DGBTCSL(392,D0,X,$G(DGBTPRV)) S:DGBTCSL<1 Y=""@3"" W:DGBTCSL<1 "" Required"" K DGBTPRV,DGBTCSL;"
- . S DR(1,392,2)="@1;I DGBTMLFB=0 S Y=""@2"";34//;S DGBTMAL=X;35//;S DGBTFAB=X;@2;8//;S DGBTME=X"
- DIE3 ;
- D ^DIE K DIE,DQ,DR I $D(DTOUT)!($D(Y)) S DGBTTOUT=1 Q
- ;
- TCOST ;CALCULATE TOTAL COST AND MONTHLY CUM. DEDUCTIBLE
- MLFB ;
- S DGBTMAF=$S(DGBTMLFB:DGBTMAL+DGBTFAB,1:0),DGBTMETC=DGBTME+$S($D(DGBTMAL):DGBTMAL,1:0)
- I DGBTACCT'=4&(DGBTACCT'=5) S DGBTPA=DGBTMAF+DGBTME G CONT
- I $D(DGBTMLT) S DGBTTC=$S(DGBTMLT+DGBTMAF'>DGBTMETC:DGBTMLT+DGBTMAF,DGBTMLT+DGBTMAF>DGBTMETC&(DGBTME>0):DGBTMETC,DGBTME'>0:DGBTMLT+DGBTMAF,1:DGBTMETC)
- I DGBTACCT=5 S DGBTDE=0 S DGBTPA=$S((DGBTMLT+DGBTMAF)'=0:DGBTTC,1:DGBTMETC) G CONT
- DED ;
- I $G(MONTOT)'="" N ODED S ODED=$$GET1^DIQ(392,DGBTDT,9)
- F I=$E(DGBTDT,1,5)_"00.2399":0 S I=$O(^DGBT(392,"C",DFN,I)) Q:'I!($E(I,1,5)>$E(DGBTDT,1,5)) I I'=DGBTDT S DGBTDCM=DGBTDCM+($P(^DGBT(392,I,0),"^",9))
- I $D(^DG(43.1,$O(^DG(43.1,(9999999.99999-DGBTDT))),"BT")) S DGBTRATE=^("BT"),DGBTDPV=$P(DGBTRATE,"^"),DGBTDPM=$P(DGBTRATE,"^",2),DGBTMR=$P(DGBTRATE,"^",3)
- I $D(^DGBT(392,DGBTDT,"M")) S:$P(^("M"),"^")=1 DGBTDPV=DGBTDPV/2 I DGBTWAY'=$P(^("M"),"^")!(DGBTMILE'=$P(^("M"),"^",2)) I $D(^DGBT(392,DGBTDT,0)) S $P(^(0),"^",9)="" K ^DGBT(392,"AD",$P(^(0),"^",2),$E(DGBTDT,2,5),DGBTDT)
- S DGBTDRM=DGBTDPM-DGBTDCM
- I DGBTDRM<0 S DGBTDRM=0
- I DGBTDE<0 S DGBTDE=0
- S DGBTDCV=$S(DGBTDCM'<DGBTDPM:0,DGBTDRM'<DGBTDPV&(DGBTTC'<DGBTDPV):DGBTDPV,DGBTDRM'<DGBTDPV&(DGBTTC'>DGBTDPV):DGBTTC,DGBTDRM'>DGBTDPV&(DGBTTC'>DGBTDRM):DGBTTC,DGBTDRM'>DGBTDPV&(DGBTTC'<DGBTDRM):DGBTDRM,1:0)
- I $P(MONTOT,"^",5)="YES"&('$G(CHZFLG)) S DGBTDCV=0 ;*30 modified to preserve waiver status of existing claims
- DED1 ;
- S DR="I $P(^DGBT(392,DGBTDT,0),""^"",9)]"""" S Y=""@9"";9///"_DGBTDCV_";@9;9;S DGBTDE=X S:DGBTDE>DGBTTC DGBTDE=DGBTTC,DGBTFLAG=2 S:DGBTDE>DGBTDRM DGBTDE=DGBTDRM,DGBTFLAG=1"
- DIE4 ;
- I $G(^DGBT(392,DGBTDT,0))'="" D
- .I $P(^DGBT(392,DGBTDT,0),U,9)="" S $P(^DGBT(392,DGBTDT,0),U,9)=+$G(DGBTDCV)
- S DIE="^DGBT(392,",DA=DGBTDT D ^DIE K DIE,DQ,DR I $D(DTOUT)!($D(Y)) S DGBTTOUT=1 Q
- I ($G(MONTOT)'="")&($G(ODED)'=DGBTDE) D
- .S $P(MONTOT,U,4)=$P(MONTOT,U,4)+DGBTDE
- .S $P(MONTOT,U,4)=$P(MONTOT,U,4)-ODED
- CONT ;
- D CONT^DGBTCE1
- Q
- FILE ; Reset values if account changes
- S DGBTVAR(0)=$P(DGBTVAR(0),"^",1,6)_"^^0^^"_$S($L(DGBTVAR(0),"^")>10:$P(DGBTVAR(0),"^",10,$L(DGBTVAR(0),"^")),1:""),DGBTVAR("A")="^"_$P(DGBTVAR("A"),"^",2)_"^^^"_$S($L(DGBTVAR("A"),"^")>4:$P(DGBTVAR("A"),"^",5,$L(DGBTVAR("A"),"^")),1:"")
- I DGBTACCT<4 S DGBTVAR("M")="^^^"_$S($L(DGBTVAR("M"),"^")>3:$P(DGBTVAR("M"),"^",4,$L(DGBTVAR("M"),"^")),1:"")
- S ^DGBT(392,DGBTDT,0)=DGBTVAR(0),^("A")=DGBTVAR("A") S:DGBTACCT<4 ^("M")=DGBTVAR("M") S DA=DGBTDT,DIK="^DGBT(392," D IX^DIK
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGBTCE 6250 printed Mar 13, 2025@20:45:06 Page 2
- DGBTCE ;ALB/SCK/BLD,LAB - BENEFICIARY TRAVEL CLAIM RE-ENTER/EDIT ;03/20/2019
- +1 ;;1.0;Beneficiary Travel;**2,14,17,20,30,37**;September 25, 2001;Build 1
- +2 QUIT
- SCREEN ;
- +1 DO QUIT^DGBTCE1
- +2 SET DGBTTOUT=""
- +3 DO SCREEN^DGBTEE1
- if '$DATA(^DGBT(392,DGBTDT,0))
- QUIT
- IF DGBTTOUT=-1
- SET DGBTTOUT=1
- QUIT
- +4 IF $DATA(DGBTOACT)
- IF DGBTOACT'=DGBTACCT
- SET DGBTVAR(0)=^DGBT(392,DGBTDT,0)
- DO FILE
- +5 SET (DGBTMAL,DGBTFAB,DGBTME,DGBTCP,DGBTFLAG,DGBTDE,DGBTDCV,DGBTDCM,DGBTDPV,DGBTDPM)=0
- +6 if $GET(DGBTACCT)'>0
- SET DGBTACCT=$PIECE($GET(DGBTVAR(0)),U,6)
- +7 ;20
- IF DGBTACCT=4!(DGBTACCT=5)
- IF $$ABP^DGBTUTL(DFN)
- WRITE !!,"*ALERT: Patient has an active bus pass, which expires on ",$$FMTE^XLFDT($$ABP^DGBTUTL(DFN)),".",!
- SET DIR("A")="Press RETURN to continue"
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- +8 SET DGBTAP=VADM(1)
- SET DIE="^DGBT(392,"
- SET DA=DGBTDT
- SET DR=$SELECT(DGBTACCT=4:"42//"_DGBTAP,DGBTACCT=5:"43;S DGBTCP=X;42//"_DGBTAP,1:"44")
- +9 DO ^DIE
- KILL DIE,DQ,DR
- IF $DATA(DTOUT)!($DATA(Y))
- SET DGBTTOUT=1
- QUIT
- +10 IF DGBTACCT=4!(DGBTACCT=5)
- if $DATA(DGBTVAR("M"))
- SET DGBTWAY=$PIECE(DGBTVAR("M"),"^")
- SET DGBTMILE=$PIECE(DGBTVAR("M"),"^",2)
- if $DATA(DGBTVAR("D"))
- SET DGBTCITY=$PIECE(DGBTVAR("D"),"^",4)
- SET DGBTSTAT=$PIECE(DGBTVAR("D"),"^",5)
- +11 SET DGBTDIV=$PIECE($GET(^DGBT(392,DA,0)),U,11)
- SET DGBTRMK=$SELECT($DATA(DGBTREC):$$DICLKUP^DGBTUTL(DGBTREC,DGBTDIV,4),1:"")
- +12 SET DIE="^DGBT(392,"
- SET DA=DGBTDT
- +13 ;DGBT*1.0*37 replace 4 slashes 3///' the ' allows for the internal value of a pointer to be validated and pushed
- +14 SET DR="3///`"_DGBTELIG_";6///`"_DGBTACTN_";21;I X="""" S Y=24;22;I X="""" S Y=24;23;24;24.1;24.2;25;I X="""" S Y=28;26;I X="""" S Y=28;27;28;28.1;28.2"
- +15 DO ^DIE
- KILL DIE
- IF $DATA(DTOUT)!($DATA(Y))
- SET DGBTTOUT=1
- QUIT
- +16 if DGBTRMK]""
- WRITE !!,*7,"MILEAGE REMARKS: ",DGBTRMK,!
- +17 IF DGBTACCT=4!(DGBTACCT=5)
- Begin DoDot:1
- +18 IF $GET(MONTOT)'=""
- NEW OTRIPTYP
- SET OTRIPTYP=$$GET1^DIQ(392,DGBTDT,31,"I")
- +19 SET DR="31//;S DGBTOWRT=X;32//;S DGBTML=X"
- +20 IF DGBTACCT=5&(DGBTCP=1)
- SET DGBTMR=DGBTMR1
- +21 SET DIE="^DGBT(392,"
- SET DA=DGBTDT
- +22 DO ^DIE
- KILL DIE,DQ,DR
- IF $DATA(DTOUT)!($DATA(Y))
- SET DGBTTOUT=1
- +23 IF ($GET(MONTOT)'="")&($GET(OTRIPTYP)'=$$GET1^DIQ(392,DGBTDT,31,"I"))
- Begin DoDot:2
- +24 NEW NTRIPTYP
- SET NTRIPTYP=$$GET1^DIQ(392,DGBTDT,31,"I")
- +25 IF (OTRIPTYP=1)&(NTRIPTYP=2)
- Begin DoDot:3
- +26 SET $PIECE(MONTOT,U)=$PIECE(MONTOT,U)+1
- +27 SET $PIECE(MONTOT,U,2)=$PIECE(MONTOT,U,2)-1
- +28 SET $PIECE(MONTOT,U,3)=$PIECE(MONTOT,U,3)+1
- End DoDot:3
- QUIT
- +29 IF (OTRIPTYP=2)&(NTRIPTYP=1)
- Begin DoDot:3
- +30 SET $PIECE(MONTOT,U)=$PIECE(MONTOT,U)-1
- +31 SET $PIECE(MONTOT,U,2)=$PIECE(MONTOT,U,2)+1
- +32 SET $PIECE(MONTOT,U,3)=$PIECE(MONTOT,U,3)-1
- End DoDot:3
- QUIT
- End DoDot:2
- +33 ;20
- NEW MODE
- SET DIR(0)="Y"
- SET DIR("B")=$SELECT($DATA(^DGBT(392,DGBTDT,"C")):"YES",1:"NO")
- SET DIR("A")="COMMON CARRIER USED"
- DO ^DIR
- KILL DIR
- SET MODE=Y
- IF $DATA(DIRUT)
- IF $GET(DUOUT)
- SET DGBTTOUT=-1
- QUIT
- +34 IF 'MODE
- IF $DATA(^DGBT(392,DGBTDT,"C"))
- SET $PIECE(^DGBT(392,DGBTDT,"A"),"^",4)=""
- FOR I="B","C"
- KILL ^DGBT(392,DGBTDT,I)
- +35 ;20
- IF $$GET1^DIQ(392,DGBTDT,44)'=""!($GET(MODE))
- SET DIE="^DGBT(392,"
- SET DA=DGBTDT
- SET DR="44COMMON CARRIER MODE"
- DO ^DIE
- IF $DATA(Y)
- SET DGBTTOUT=1
- QUIT
- +36 ;20
- SET DIE="^DGBT(392,"
- SET DA=DGBTDT
- IF $$UP^XLFSTR($$GET1^DIQ(392,DGBTDT,44))["BUS"
- SET DR="52R;I X'=""P"" S Y="""";53R"
- DO ^DIE
- IF $DATA(Y)
- SET DGBTTOUT=1
- QUIT
- +37 ;20
- IF $$GET1^DIQ(392,DGBTDT,44)'=""
- SET DIE="^DGBT(392,"
- SET DA=DGBTDT
- SET DR="54;55;55.1"
- DO ^DIE
- IF $DATA(Y)
- SET DGBTTOUT=1
- QUIT
- End DoDot:1
- if $GET(DGBTTOUT)
- QUIT
- DIE1 ;
- +1 SET DGBTMLT=$SELECT($DATA(DGBTVAR("M"))&((DGBTACCT=4)!(DGBTACCT=5)):$JUSTIFY((DGBTOWRT*DGBTML*DGBTMR),0,2),1:"")
- SET $PIECE(^DGBT(392,DGBTDT,"M"),"^",3)=DGBTMLT
- SET $PIECE(DGBTVAR("M"),"^",3)=DGBTMLT
- +2 ;
- +3 SET DIE="^DGBT(392,"
- SET DA=DGBTDT
- +4 IF 'DGBTCORE
- Begin DoDot:1
- +5 SET DR="I DGBTACCT=4!(DGBTACCT=5) S Y=""@1"";41;7;@1;I DGBTMLFB=0 S Y=""@2"";34//;S DGBTMAL=X;35//;S DGBTFAB=X;@2;8//;S DGBTME=X"
- End DoDot:1
- +6 IF DGBTCORE
- SET DR=""
- Begin DoDot:1
- +7 SET DR(1,392,1)="I DGBTACCT=4!(DGBTACCT=5) S Y=""@1"";41;@3;14;S DGBTCSL=$$AFTER^DGBTCSL(392,D0,X,$G(DGBTPRV)) S:DGBTCSL<1 Y=""@3"" W:DGBTCSL<1 "" Required"" K DGBTPRV,DGBTCSL;"
- +8 SET DR(1,392,2)="@1;I DGBTMLFB=0 S Y=""@2"";34//;S DGBTMAL=X;35//;S DGBTFAB=X;@2;8//;S DGBTME=X"
- End DoDot:1
- DIE3 ;
- +1 DO ^DIE
- KILL DIE,DQ,DR
- IF $DATA(DTOUT)!($DATA(Y))
- SET DGBTTOUT=1
- QUIT
- +2 ;
- TCOST ;CALCULATE TOTAL COST AND MONTHLY CUM. DEDUCTIBLE
- MLFB ;
- +1 SET DGBTMAF=$SELECT(DGBTMLFB:DGBTMAL+DGBTFAB,1:0)
- SET DGBTMETC=DGBTME+$SELECT($DATA(DGBTMAL):DGBTMAL,1:0)
- +2 IF DGBTACCT'=4&(DGBTACCT'=5)
- SET DGBTPA=DGBTMAF+DGBTME
- GOTO CONT
- +3 IF $DATA(DGBTMLT)
- SET DGBTTC=$SELECT(DGBTMLT+DGBTMAF'>DGBTMETC:DGBTMLT+DGBTMAF,DGBTMLT+DGBTMAF>DGBTMETC&(DGBTME>0):DGBTMETC,DGBTME'>0:DGBTMLT+DGBTMAF,1:DGBTMETC)
- +4 IF DGBTACCT=5
- SET DGBTDE=0
- SET DGBTPA=$SELECT((DGBTMLT+DGBTMAF)'=0:DGBTTC,1:DGBTMETC)
- GOTO CONT
- DED ;
- +1 IF $GET(MONTOT)'=""
- NEW ODED
- SET ODED=$$GET1^DIQ(392,DGBTDT,9)
- +2 FOR I=$EXTRACT(DGBTDT,1,5)_"00.2399":0
- SET I=$ORDER(^DGBT(392,"C",DFN,I))
- if 'I!($EXTRACT(I,1,5)>$EXTRACT(DGBTDT,1,5))
- QUIT
- IF I'=DGBTDT
- SET DGBTDCM=DGBTDCM+($PIECE(^DGBT(392,I,0),"^",9))
- +3 IF $DATA(^DG(43.1,$ORDER(^DG(43.1,(9999999.99999-DGBTDT))),"BT"))
- SET DGBTRATE=^("BT")
- SET DGBTDPV=$PIECE(DGBTRATE,"^")
- SET DGBTDPM=$PIECE(DGBTRATE,"^",2)
- SET DGBTMR=$PIECE(DGBTRATE,"^",3)
- +4 IF $DATA(^DGBT(392,DGBTDT,"M"))
- if $PIECE(^("M"),"^")=1
- SET DGBTDPV=DGBTDPV/2
- IF DGBTWAY'=$PIECE(^("M"),"^")!(DGBTMILE'=$PIECE(^("M"),"^",2))
- IF $DATA(^DGBT(392,DGBTDT,0))
- SET $PIECE(^(0),"^",9)=""
- KILL ^DGBT(392,"AD",$PIECE(^(0),"^",2),$EXTRACT(DGBTDT,2,5),DGBTDT)
- +5 SET DGBTDRM=DGBTDPM-DGBTDCM
- +6 IF DGBTDRM<0
- SET DGBTDRM=0
- +7 IF DGBTDE<0
- SET DGBTDE=0
- +8 SET DGBTDCV=$SELECT(DGBTDCM'<DGBTDPM:0,DGBTDRM'<DGBTDPV&(DGBTTC'<DGBTDPV):DGBTDPV,DGBTDRM'<DGBTDPV&(DGBTTC'>DGBTDPV):DGBTTC,DGBTDRM'>DGBTDPV&(DGBTTC'>DGBTDRM):DGBTTC,DGBTDRM'>DGBTDPV&(DGBTTC'<DGBTDRM):DGBTDRM,1:0)
- +9 ;*30 modified to preserve waiver status of existing claims
- IF $PIECE(MONTOT,"^",5)="YES"&('$GET(CHZFLG))
- SET DGBTDCV=0
- DED1 ;
- +1 SET DR="I $P(^DGBT(392,DGBTDT,0),""^"",9)]"""" S Y=""@9"";9///"_DGBTDCV_";@9;9;S DGBTDE=X S:DGBTDE>DGBTTC DGBTDE=DGBTTC,DGBTFLAG=2 S:DGBTDE>DGBTDRM DGBTDE=DGBTDRM,DGBTFLAG=1"
- DIE4 ;
- +1 IF $GET(^DGBT(392,DGBTDT,0))'=""
- Begin DoDot:1
- +2 IF $PIECE(^DGBT(392,DGBTDT,0),U,9)=""
- SET $PIECE(^DGBT(392,DGBTDT,0),U,9)=+$GET(DGBTDCV)
- End DoDot:1
- +3 SET DIE="^DGBT(392,"
- SET DA=DGBTDT
- DO ^DIE
- KILL DIE,DQ,DR
- IF $DATA(DTOUT)!($DATA(Y))
- SET DGBTTOUT=1
- QUIT
- +4 IF ($GET(MONTOT)'="")&($GET(ODED)'=DGBTDE)
- Begin DoDot:1
- +5 SET $PIECE(MONTOT,U,4)=$PIECE(MONTOT,U,4)+DGBTDE
- +6 SET $PIECE(MONTOT,U,4)=$PIECE(MONTOT,U,4)-ODED
- End DoDot:1
- CONT ;
- +1 DO CONT^DGBTCE1
- +2 QUIT
- FILE ; Reset values if account changes
- +1 SET DGBTVAR(0)=$PIECE(DGBTVAR(0),"^",1,6)_"^^0^^"_$SELECT($LENGTH(DGBTVAR(0),"^")>10:$PIECE(DGBTVAR(0),"^",10,$LENGTH(DGBTVAR(0),"^")),1:"")
- SET DGBTVAR("A")="^"_$PIECE(DGBTVAR("A"),"^",2)_"^^^"_$SELECT($LENGTH(DGBTVAR("A"),"^")>4:$PIECE(DGBTVAR("A"),"^",5,$LENGTH(DGBTVAR("A"),"^")),1:"")
- +2 IF DGBTACCT<4
- SET DGBTVAR("M")="^^^"_$SELECT($LENGTH(DGBTVAR("M"),"^")>3:$PIECE(DGBTVAR("M"),"^",4,$LENGTH(DGBTVAR("M"),"^")),1:"")
- +3 SET ^DGBT(392,DGBTDT,0)=DGBTVAR(0)
- SET ^("A")=DGBTVAR("A")
- if DGBTACCT<4
- SET ^("M")=DGBTVAR("M")
- SET DA=DGBTDT
- SET DIK="^DGBT(392,"
- DO IX^DIK
- +4 QUIT
