- DGBTR ;ALB/LM - BENEFICIARY TRAVEL RE-PRINT; 1/30/89@8:00 ;4/26/91 14:32
- ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
- ;
- Q
- DISPLAY S DGBTR=1 D ASK G:'$D(DGBTDT) QUIT G:'$D(^DGBT(392,DGBTDT,0)) QUIT S VADAT("W")=DGBTDT D ^VADATE S DGBTDTE=VADATE("E"),IOP="" D ^%ZIS D SCREEN^DGBTCD D QUIT G DISPLAY
- ;
- REPRINT S DGBTR=0 D ASK G:'$D(DGBTDT) QUIT G:'$D(^DGBT(392,DGBTDT,0)) QUIT D START^DGBTCR G QUIT
- ;
- ASK S DIC="^DPT(",DIC(0)="AEQMZ" D ^DIC G QUIT:Y<1 S DFN=+Y I '$D(^DGBT(392,"C",DFN)) W !!,"There are no computer entries on file for this patient.",! G ASK
- D 6^VADPT
- K ^UTILITY($J,"DGBT")
- W:'DGBTR !!,"Only claims with ACCOUNT TYPE of ALL OTHER or C&P are listed as choices.",! G LIST
- Q
- LIST S X="",(DGBTC,DGBTCH)=0 F I=0:0 S I=$O(^DGBT(392,"AI",DFN,I)) Q:'I S J=^(I) I $S(DGBTR:1,$D(^DGBT(392,"ACTP",4,J)):1,$D(^DGBT(392,"ACTP",5,J)):1,1:0) S DGBTC=DGBTC+1,^UTILITY($J,"DGBT",DGBTC,I)=9999999.99999-I
- I '$D(^UTILITY($J,"DGBT"))!'$D(^DGBT(392,"C",DFN)) W !,"There are no computer entries on file for this patient with these account types.",! G ASK
- I $D(^UTILITY($J,"DGBT")) W !,"Select Claim DATE/TIME: ",!
- F I=0:0 S I=$O(^UTILITY($J,"DGBT",I)) Q:'I!(DGBTCH)!(X["^") F J=0:0 S J=$O(^UTILITY($J,"DGBT",I,J)) Q:'J S K=I,VADAT("W")=^(J) D ^VADATE W !?5,I,".",?10,VADATE("E") I K#5=0 D CHOZ G QUIT:$D(DTOUT) Q:DGBTCH
- D:K#5'=0 CHOZ G QUIT:$D(DTOUT) I DGBTCH S DGBTA=$O(^UTILITY($J,"DGBT",X,0)),DGBTA=^UTILITY($J,"DGBT",X,DGBTA) S (DGBTDT,VADAT("W"))=DGBTA D ^VADATE W " ",VADATE("E")
- G:'DGBTCH ASK Q
- CHOZ ;
- I K'=DGBTC S DIR("A",1)="",DIR("A",2)="Type '^' to Stop, or" S DIR("?")="^D HELP^DGBTR"
- S DIR("A")="Choose 1-"_$S(K=1:"",1:K)_": ",DIR(0)="NOA^1:"_K D ^DIR K DIR S:$D(DTOUT) DTOUT=1 I Y,$D(^UTILITY($J,"DGBT",Y)) S DGBTCH=1 Q
- Q
- QUIT K DIC,DTOUT,X,VA,VADAT,VADATE,DGBTDT,DFN,VAEL,VADM,VAPA,DFN,DGBTA,DGBTC,DGBTCH,DGBTDTE,DGBTR,I,J,K,Y,DGBTFCTY,DGBTMR,DGBTTCTY,VAERR,DGBTCNU,DGBTVAR
- Q
- HELP W !!,"ANSWER WITH NUMERIC CHOICE. BECAUSE ENTRIES ARE STORED BY DATE.TIME.SECONDS,",!,"YOU MUST ENTER A NUMERIC CHOICE." Q
- DGBTR ;ALB/LM - BENEFICIARY TRAVEL RE-PRINT; 1/30/89@8:00 ;4/26/91 14:32
- +1 ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
- +2 ;
- +3 QUIT
- DISPLAY SET DGBTR=1
- DO ASK
- IF '$DATA(DGBTDT)
- GOTO QUIT
- IF '$DATA(^DGBT(392,DGBTDT,0))
- GOTO QUIT
- SET VADAT("W")=DGBTDT
- DO ^VADATE
- SET DGBTDTE=VADATE("E")
- SET IOP=""
- DO ^%ZIS
- DO SCREEN^DGBTCD
- DO QUIT
- GOTO DISPLAY
- +1 ;
- REPRINT SET DGBTR=0
- DO ASK
- IF '$DATA(DGBTDT)
- GOTO QUIT
- IF '$DATA(^DGBT(392,DGBTDT,0))
- GOTO QUIT
- DO START^DGBTCR
- GOTO QUIT
- +1 ;
- ASK SET DIC="^DPT("
- SET DIC(0)="AEQMZ"
- DO ^DIC
- IF Y<1
- GOTO QUIT
- SET DFN=+Y
- IF '$DATA(^DGBT(392,"C",DFN))
- WRITE !!,"There are no computer entries on file for this patient.",!
- GOTO ASK
- +1 DO 6^VADPT
- +2 KILL ^UTILITY($JOB,"DGBT")
- +3 IF 'DGBTR
- WRITE !!,"Only claims with ACCOUNT TYPE of ALL OTHER or C&P are listed as choices.",!
- GOTO LIST
- +4 QUIT
- LIST SET X=""
- SET (DGBTC,DGBTCH)=0
- FOR I=0:0
- SET I=$ORDER(^DGBT(392,"AI",DFN,I))
- IF 'I
- QUIT
- SET J=^(I)
- IF $SELECT(DGBTR:1,$DATA(^DGBT(392,"ACTP",4,J)):1,$DATA(^DGBT(392,"ACTP",5,J)):1,1:0)
- SET DGBTC=DGBTC+1
- SET ^UTILITY($JOB,"DGBT",DGBTC,I)=9999999.99999-I
- +1 IF '$DATA(^UTILITY($JOB,"DGBT"))!'$DATA(^DGBT(392,"C",DFN))
- WRITE !,"There are no computer entries on file for this patient with these account types.",!
- GOTO ASK
- +2 IF $DATA(^UTILITY($JOB,"DGBT"))
- WRITE !,"Select Claim DATE/TIME: ",!
- +3 FOR I=0:0
- SET I=$ORDER(^UTILITY($JOB,"DGBT",I))
- IF 'I!(DGBTCH)!(X["^")
- QUIT
- FOR J=0:0
- SET J=$ORDER(^UTILITY($JOB,"DGBT",I,J))
- IF 'J
- QUIT
- SET K=I
- SET VADAT("W")=^(J)
- DO ^VADATE
- WRITE !?5,I,".",?10,VADATE("E")
- IF K#5=0
- DO CHOZ
- IF $DATA(DTOUT)
- GOTO QUIT
- IF DGBTCH
- QUIT
- +4 IF K#5'=0
- DO CHOZ
- IF $DATA(DTOUT)
- GOTO QUIT
- IF DGBTCH
- SET DGBTA=$ORDER(^UTILITY($JOB,"DGBT",X,0))
- SET DGBTA=^UTILITY($JOB,"DGBT",X,DGBTA)
- SET (DGBTDT,VADAT("W"))=DGBTA
- DO ^VADATE
- WRITE " ",VADATE("E")
- +5 IF 'DGBTCH
- GOTO ASK
- QUIT
- CHOZ ;
- +1 IF K'=DGBTC
- SET DIR("A",1)=""
- SET DIR("A",2)="Type '^' to Stop, or"
- SET DIR("?")="^D HELP^DGBTR"
- +2 SET DIR("A")="Choose 1-"_$SELECT(K=1:"",1:K)_": "
- SET DIR(0)="NOA^1:"_K
- DO ^DIR
- KILL DIR
- IF $DATA(DTOUT)
- SET DTOUT=1
- IF Y
- IF $DATA(^UTILITY($JOB,"DGBT",Y))
- SET DGBTCH=1
- QUIT
- +3 QUIT
- QUIT KILL DIC,DTOUT,X,VA,VADAT,VADATE,DGBTDT,DFN,VAEL,VADM,VAPA,DFN,DGBTA,DGBTC,DGBTCH,DGBTDTE,DGBTR,I,J,K,Y,DGBTFCTY,DGBTMR,DGBTTCTY,VAERR,DGBTCNU,DGBTVAR
- +1 QUIT
- HELP WRITE !!,"ANSWER WITH NUMERIC CHOICE. BECAUSE ENTRIES ARE STORED BY DATE.TIME.SECONDS,",!,"YOU MUST ENTER A NUMERIC CHOICE."
- QUIT
