- DGBTEF ;ALB/SCK,LAB - BENEFICIARY TRAVEL ENTER/EDIT CERTIFICATION FILE ; 03/20/2019
- ;;1.0;Beneficiary Travel;**7,21,37,39**;September 25, 2001;Build 6
- CERT ;
- D QUIT S DIC="^DPT(",DIC(0)="AEQMZ" W !! D ^DIC K DIC G QUIT:Y'>0 S DFN=+Y
- G:'$O(^DGBT(392.2,"C",DFN,0)) ADD S DGBT=$O(^(0))
- S DGBT=^DGBT(392.2,DGBT,0) W !!,"Last Certification: " S VADAT("W")=+DGBT D ^VADATE W VADATE("E"),?39,"Eligible: ",$S($P(DGBT,U,3):"YES",1:"NO"),?55,"Amount Certified: ",$P(DGBT,U,4)
- AE ;
- S DIR("A")="'A'DD A NEW DATE, 'E'DIT EXISTING OR 'Q'UIT: ",DIR("A",1)="",DIR("B")="ADD",DIR("?")="Q - to 'Q'uit",DIR("?",1)=""
- S DIR("?",2)="ENTER A - to 'A'dd a new certification date",DIR("?",3)="E - to 'E'dit an existing entry for this patient"
- S DIR(0)="SAO^A:ADD;E:EDIT;Q:QUIT"
- D ^DIR K DIR Q:$D(DUOUT)!($D(DTOUT))!(Y="Q") G EDIT:Y="E",ADD:Y="A"
- Q
- ADD ;
- S DIR(0)="D^:NOW:PXR",DIR("A")="Select CERTIFICATION DATE: ",DIR("A",1)="",DIR("B")="NOW",DIR("?")="^D DHELP^DGBTEF"
- D ^DIR K DIR G QUIT:$D(DUOUT) G QUIT1:$D(DTOUT) S DGBTA=9999999.99999-(+Y),DGBTDT=+Y
- I $D(^DGBT(392.2,"C",DFN)) F I=0:0 S I=$O(^DGBT(392.2,"C",DFN,I)) Q:'I I I[$P(DGBTA,".") W !!,"There is already a certification for " S VADAT("W")=DGBTDT D ^VADATE W VADATE("E"),".",!,"Only one certification per date is necessary." G AE
- LOCK ;
- I DGBTA'["." D DHELP G:DGBTA'["." ADD
- L +^DGBT(392.2,DGBTA):$G(DILOCKTM,3) I '$T!$D(^DGBT(392.2,DGBTA)) L -^DGBT(392.2,DGBTA) S DGBTA=$$FMADD^XLFDT(DGBTA,,,,1) G LOCK ;dbe patch DGBT*1*21
- S VADAT("W")=9999999.99999-DGBTA D ^VADATE W " ",VADATE("E")
- ;DGBT*1.0*37 changed logic for 4 slashes to 3 slashes with ', ' allows internal value to be validated and pushed.
- K DD,DO S X=DGBTDT,DINUM=DGBTA,DIC="^DGBT(392.2,",DIC(0)="L",DIC("DR")="2///`"_DFN D FILE^DICN K DIC("DR") L -^DGBT(392.2,DGBTA) G:Y'>0 CERT
- DIE ;
- N X3 ;Clean copy used by COMMA^%DTC
- S X=$$LST^DGMTU(DFN,"",1) I $G(X),$D(^DGMT(408.31,+X,0)) S X=$P(^(0),"^",4),X2="0$" D COMMA^%DTC S DGBTMTI=X K X,X2 W !!,"REPORTED MEANS TEST INCOME: ",DGBTMTI
- ;I $D(^DG(41.3,DFN,0)),$D(^(1,0)),$D(^(2,0)) S DGBTMTD=$P(^DG(41.3,DFN,1,$P(^(1,0),"^",3),0),"^",3),X=$P(^DG(41.3,DFN,2,$P(^(2,0),"^",3),0),"^",4),X2="0$" D COMMA^%DTC S DGBTMTI=X K X,X2 W !!,"REPORTED MEANS TEST INCOME: ",DGBTMTI
- D 6^VADPT,RESADDR^DGBTUTL1(.DGBTADDR) S DGBTCC=$S($D(^DIC(5,+DGBTADDR(5),1,+DGBTADDR(7),0)):$P(^(0),"^",3),1:""),DGBTEL=$P(VAEL(1),"^",2) ;*39 - updated to use residential address
- S DA=DGBTA,DIE="^DGBT(392.2,",DIE("NO^")="12345"
- S DR=".01;4;3;5////"_DUZ_";6///"_DT_";11///^S X=DGBTADDR(1);12///^S X=DGBTADDR(2);13///^S X=DGBTADDR(3);14///^S X=DGBTADDR(4);15///" ;*39 - updated to use residential address
- S DR=DR_$S(DGBTADDR(5)]"":+DGBTADDR(5),1:"")_";16///^S X=$P(DGBTADDR(6),U);17///"_DGBTCC_";18///"_$P(VAEL(9),"^")_";19///"_DGBTEL ;*39 - split line to meet 245 byte limit
- D ^DIE G QUIT:$D(DTOUT) G:'$D(DA) CERT
- I $D(^DGBT(392.2,DA,0)) S X=$P(^DGBT(392.2,DA,0),U,4),X2="0$" D COMMA^%DTC S DGBTCA=X K X,X2
- I $D(^DGBT(392.2,DA,0)),$D(DGBTMTI),DGBTMTI'=DGBTCA W !!?5," * * * * Discrepancy exists in incomes reported, please verify * * * *",! S DGBTINFL=1
- G CERT
- EDIT ;
- S X="",(DGBTC,DGBTCH,DGFL)=0 F I=0:0 S I=$O(^DGBT(392.2,"C",DFN,I)) Q:'I S DGBTC=DGBTC+1,^UTILITY($J,"DGBT",DGBTC,I)=""
- I '$D(^UTILITY($J,"DGBT"))!'$D(^DGBT(392.2,"C",DFN)) W !,"There are no computer entries on file for this patient." G CERT
- F I=0:0 S I=$O(^UTILITY($J,"DGBT",I)) Q:'I!(DGBTCH)!(X["^")!(DGFL) D
- . F J=0:0 S J=$O(^UTILITY($J,"DGBT",I,J)) Q:'J S K=I,Y=9999999.99999-J X ^DD("DD") W !?5,I,". ",?10,$P(Y,"@") I K#5=0 D CHOZ Q:DGBTCH!(DGFL)
- G:DGFL=1 QUIT D:K#5'=0 CHOZ I DGBTCH S DGBTA=$O(^UTILITY($J,"DGBT",X,0)) G DIE
- G:'$T QUIT G AE
- CHOZ ;
- S DIR("A")="Choose",DIR(0)="NO^1:"_K D ^DIR K DIR Q:$D(DIRUT)
- I Y,$D(^UTILITY($J,"DGBT",Y)) S DGBTCH=1,VADAT("W")=9999999.99999-$O(^(Y,0)) D ^VADATE W " ",VADATE("E") Q
- Q
- DHELP ;
- W !!,"Enter the date of annual certification.",!,"Time is required when adding a new certification date.",!,"Future dates are not allowed.",! S X="?",%DT="ER" D ^%DT Q
- QUIT1 ;
- I $D(DA) S DIK="^DGBT(392.2," D ^DIK K DIK
- QUIT ;
- K ^UTILITY($J,"DGBT"),%DT,D,DA,DD,DFN,DGBT,DGBTA,DGBTADDR,DGBTC,DGBTCA,DGBTCC,DGBTCH,DGBTDT,DGBTEL,DGBTINFL,DGBTMTD,DGBTMTI,DGFL,DIC,DIE,DINUM,DO,DR,I,J,K,VA,VADAT,VADATE,VADM,VAEL,VAERR,VAPA,VAROOT,X,Y,Z Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGBTEF 4346 printed Mar 13, 2025@20:45:23 Page 2
- DGBTEF ;ALB/SCK,LAB - BENEFICIARY TRAVEL ENTER/EDIT CERTIFICATION FILE ; 03/20/2019
- +1 ;;1.0;Beneficiary Travel;**7,21,37,39**;September 25, 2001;Build 6
- CERT ;
- +1 DO QUIT
- SET DIC="^DPT("
- SET DIC(0)="AEQMZ"
- WRITE !!
- DO ^DIC
- KILL DIC
- if Y'>0
- GOTO QUIT
- SET DFN=+Y
- +2 if '$ORDER(^DGBT(392.2,"C",DFN,0))
- GOTO ADD
- SET DGBT=$ORDER(^(0))
- +3 SET DGBT=^DGBT(392.2,DGBT,0)
- WRITE !!,"Last Certification: "
- SET VADAT("W")=+DGBT
- DO ^VADATE
- WRITE VADATE("E"),?39,"Eligible: ",$SELECT($PIECE(DGBT,U,3):"YES",1:"NO"),?55,"Amount Certified: ",$PIECE(DGBT,U,4)
- AE ;
- +1 SET DIR("A")="'A'DD A NEW DATE, 'E'DIT EXISTING OR 'Q'UIT: "
- SET DIR("A",1)=""
- SET DIR("B")="ADD"
- SET DIR("?")="Q - to 'Q'uit"
- SET DIR("?",1)=""
- +2 SET DIR("?",2)="ENTER A - to 'A'dd a new certification date"
- SET DIR("?",3)="E - to 'E'dit an existing entry for this patient"
- +3 SET DIR(0)="SAO^A:ADD;E:EDIT;Q:QUIT"
- +4 DO ^DIR
- KILL DIR
- if $DATA(DUOUT)!($DATA(DTOUT))!(Y="Q")
- QUIT
- if Y="E"
- GOTO EDIT
- if Y="A"
- GOTO ADD
- +5 QUIT
- ADD ;
- +1 SET DIR(0)="D^:NOW:PXR"
- SET DIR("A")="Select CERTIFICATION DATE: "
- SET DIR("A",1)=""
- SET DIR("B")="NOW"
- SET DIR("?")="^D DHELP^DGBTEF"
- +2 DO ^DIR
- KILL DIR
- if $DATA(DUOUT)
- GOTO QUIT
- if $DATA(DTOUT)
- GOTO QUIT1
- SET DGBTA=9999999.99999-(+Y)
- SET DGBTDT=+Y
- +3 IF $DATA(^DGBT(392.2,"C",DFN))
- FOR I=0:0
- SET I=$ORDER(^DGBT(392.2,"C",DFN,I))
- if 'I
- QUIT
- IF I[$PIECE(DGBTA,".")
- WRITE !!,"There is already a certification for "
- SET VADAT("W")=DGBTDT
- DO ^VADATE
- WRITE VADATE("E"),".",!,"Only one certification per date is necessary."
- GOTO AE
- LOCK ;
- +1 IF DGBTA'["."
- DO DHELP
- if DGBTA'["."
- GOTO ADD
- +2 ;dbe patch DGBT*1*21
- LOCK +^DGBT(392.2,DGBTA):$GET(DILOCKTM,3)
- IF '$TEST!$DATA(^DGBT(392.2,DGBTA))
- LOCK -^DGBT(392.2,DGBTA)
- SET DGBTA=$$FMADD^XLFDT(DGBTA,,,,1)
- GOTO LOCK
- +3 SET VADAT("W")=9999999.99999-DGBTA
- DO ^VADATE
- WRITE " ",VADATE("E")
- +4 ;DGBT*1.0*37 changed logic for 4 slashes to 3 slashes with ', ' allows internal value to be validated and pushed.
- +5 KILL DD,DO
- SET X=DGBTDT
- SET DINUM=DGBTA
- SET DIC="^DGBT(392.2,"
- SET DIC(0)="L"
- SET DIC("DR")="2///`"_DFN
- DO FILE^DICN
- KILL DIC("DR")
- LOCK -^DGBT(392.2,DGBTA)
- if Y'>0
- GOTO CERT
- DIE ;
- +1 ;Clean copy used by COMMA^%DTC
- NEW X3
- +2 SET X=$$LST^DGMTU(DFN,"",1)
- IF $GET(X)
- IF $DATA(^DGMT(408.31,+X,0))
- SET X=$PIECE(^(0),"^",4)
- SET X2="0$"
- DO COMMA^%DTC
- SET DGBTMTI=X
- KILL X,X2
- WRITE !!,"REPORTED MEANS TEST INCOME: ",DGBTMTI
- +3 ;I $D(^DG(41.3,DFN,0)),$D(^(1,0)),$D(^(2,0)) S DGBTMTD=$P(^DG(41.3,DFN,1,$P(^(1,0),"^",3),0),"^",3),X=$P(^DG(41.3,DFN,2,$P(^(2,0),"^",3),0),"^",4),X2="0$" D COMMA^%DTC S DGBTMTI=X K X,X2 W !!,"REPORTED MEANS TEST INCOME: ",DGBTMTI
- +4 ;*39 - updated to use residential address
- DO 6^VADPT
- DO RESADDR^DGBTUTL1(.DGBTADDR)
- SET DGBTCC=$SELECT($DATA(^DIC(5,+DGBTADDR(5),1,+DGBTADDR(7),0)):$PIECE(^(0),"^",3),1:"")
- SET DGBTEL=$PIECE(VAEL(1),"^",2)
- +5 SET DA=DGBTA
- SET DIE="^DGBT(392.2,"
- SET DIE("NO^")="12345"
- +6 ;*39 - updated to use residential address
- SET DR=".01;4;3;5////"_DUZ_";6///"_DT_";11///^S X=DGBTADDR(1);12///^S X=DGBTADDR(2);13///^S X=DGBTADDR(3);14///^S X=DGBTADDR(4);15///"
- +7 ;*39 - split line to meet 245 byte limit
- SET DR=DR_$SELECT(DGBTADDR(5)]"":+DGBTADDR(5),1:"")_";16///^S X=$P(DGBTADDR(6),U);17///"_DGBTCC_";18///"_$PIECE(VAEL(9),"^")_";19///"_DGBTEL
- +8 DO ^DIE
- if $DATA(DTOUT)
- GOTO QUIT
- if '$DATA(DA)
- GOTO CERT
- +9 IF $DATA(^DGBT(392.2,DA,0))
- SET X=$PIECE(^DGBT(392.2,DA,0),U,4)
- SET X2="0$"
- DO COMMA^%DTC
- SET DGBTCA=X
- KILL X,X2
- +10 IF $DATA(^DGBT(392.2,DA,0))
- IF $DATA(DGBTMTI)
- IF DGBTMTI'=DGBTCA
- WRITE !!?5," * * * * Discrepancy exists in incomes reported, please verify * * * *",!
- SET DGBTINFL=1
- +11 GOTO CERT
- EDIT ;
- +1 SET X=""
- SET (DGBTC,DGBTCH,DGFL)=0
- FOR I=0:0
- SET I=$ORDER(^DGBT(392.2,"C",DFN,I))
- if 'I
- QUIT
- SET DGBTC=DGBTC+1
- SET ^UTILITY($JOB,"DGBT",DGBTC,I)=""
- +2 IF '$DATA(^UTILITY($JOB,"DGBT"))!'$DATA(^DGBT(392.2,"C",DFN))
- WRITE !,"There are no computer entries on file for this patient."
- GOTO CERT
- +3 FOR I=0:0
- SET I=$ORDER(^UTILITY($JOB,"DGBT",I))
- if 'I!(DGBTCH)!(X["^")!(DGFL)
- QUIT
- Begin DoDot:1
- +4 FOR J=0:0
- SET J=$ORDER(^UTILITY($JOB,"DGBT",I,J))
- if 'J
- QUIT
- SET K=I
- SET Y=9999999.99999-J
- XECUTE ^DD("DD")
- WRITE !?5,I,". ",?10,$PIECE(Y,"@")
- IF K#5=0
- DO CHOZ
- if DGBTCH!(DGFL)
- QUIT
- End DoDot:1
- +5 if DGFL=1
- GOTO QUIT
- if K#5'=0
- DO CHOZ
- IF DGBTCH
- SET DGBTA=$ORDER(^UTILITY($JOB,"DGBT",X,0))
- GOTO DIE
- +6 if '$TEST
- GOTO QUIT
- GOTO AE
- CHOZ ;
- +1 SET DIR("A")="Choose"
- SET DIR(0)="NO^1:"_K
- DO ^DIR
- KILL DIR
- if $DATA(DIRUT)
- QUIT
- +2 IF Y
- IF $DATA(^UTILITY($JOB,"DGBT",Y))
- SET DGBTCH=1
- SET VADAT("W")=9999999.99999-$ORDER(^(Y,0))
- DO ^VADATE
- WRITE " ",VADATE("E")
- QUIT
- +3 QUIT
- DHELP ;
- +1 WRITE !!,"Enter the date of annual certification.",!,"Time is required when adding a new certification date.",!,"Future dates are not allowed.",!
- SET X="?"
- SET %DT="ER"
- DO ^%DT
- QUIT
- QUIT1 ;
- +1 IF $DATA(DA)
- SET DIK="^DGBT(392.2,"
- DO ^DIK
- KILL DIK
- QUIT ;
- +1 KILL ^UTILITY($JOB,"DGBT"),%DT,D,DA,DD,DFN,DGBT,DGBTA,DGBTADDR,DGBTC,DGBTCA,DGBTCC,DGBTCH,DGBTDT,DGBTEL,DGBTINFL,DGBTMTD,DGBTMTI,DGFL,DIC,DIE,DINUM,DO,DR,I,J,K,VA,VADAT,VADATE,VADM,VAEL,VAERR,VAPA,VAROOT,X,Y,Z
- QUIT
