DGBTR.m

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