- DGBTE ;ALB/SCK-BENEFICIARY TRAVEL SETUP/MAIN ENTRY CALL UP; 11/20/92@1000; 11/25/92
- ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
- START ;
- D QUIT^DGBTEND ; kill all variables
- S PRCABN=1,IOP="HOME" D ^%ZIS K IOP
- S DGBTIME=300 S:'$D(DTIME) DTIME=DGBTIME S:'$D(U) U="^"
- ; if date/time is undefined, set DT value
- I '$D(DT)#2 S %DT="",S="T" D ^%DT S DT=Y
- DIVISN ; if MED CTR DIV file set up (first record) and record does not exist, write warning, kill variables, and exit
- S X=$G(^DG(40.8,0)) I X="" W !,"WARNING...MEDICAL CENTER DIVISION FILE IS NOT SET UP",!,"USE THE ADT PARAMETER OPTION FILE TO SET UP DIVISION" G EXIT
- ; check if multi-divisional center (GL node exists and 2nd piece=1). Do lookup, if it exists-set local variables
- I $D(^DG(43,1,"GL")),$P(^("GL"),U,2) D G:Y'>0 EXIT G PATIENT
- . S DIC="^DG(40.8,",DIC(0)="AEQMNZ",DIC("A")="Select DIVISION: " W !!
- . D ^DIC K DIC Q:Y'>0
- . S DGBTDIVI=+Y,DGBTDIV=$P(Y,U,2)
- . D INSTIT S DGBTMD=1
- ; if not a multi-divisional center, default to institution name
- S DGBTDIVI=$O(^DG(40.8,0)),DGBTDIV=$P(^DG(40.8,DGBTDIVI,0),U) D INSTIT
- ;
- PATIENT ; patient lookup, quit if patient doesn't exist
- D QUIT1^DGBTEND ; kill local variables except med division vars
- S DGBTTOUT="",DIC="^DPT(",DIC(0)="AEQMZ",DIC("A")="Select PATIENT: "
- W !! D ^DIC K DIC G:Y'>0 EXIT
- ; get patient information#, call return patient return variables routine and set wether new claim or not
- S DFN=+Y D 6^VADPT,KVAR^DGBTEND,PID^VADPT
- S DGBTNEW=$S($D(^DGBT(392,"C",DFN)):0,1:1)
- ;
- OLDCLAIM ; find any past claims through DGBTE1 call
- D ^DGBTE1 Q:'$D(DGBTA) ; set to call test routine, call old claims
- I '$D(^DG(43,1,"BT"))!('$D(^DG(43.1,$O(^DG(43.1,(9999999.9999999-DGBTDT))),"BT"))) D G EXIT2
- . ; check for certifying official and that current (or past) FY deductable is set up
- . W !!,"***WARNING...BENE TRAVEL PARAMETERS HAVE NOT BEEN SET UP",!,"USE THE BENEFICIARY TRAVEL PARAMETER RATES ENTER/EDIT OPTION TO PROPERLY INITIALIZE"
- ;
- SCREEN ; display B/T claim information through screen1
- D SCREEN^DGBT1
- I '+VAEL(1) W !!,"Eligibility is missing from registration and is required to continue." G EXIT2
- S DIR("A")="Continue processing claim",DIR("?")="Sorry, enter 'Y'es or RETURN to continue procesing claim, 'N'o to exit",DIR(0)="Y",DIR("B")="YES"
- D ^DIR S ANS=Y K DIR G:'ANS!($D(DTOUT))!($D(DUOUT)) EXIT3
- SCREEN2 ;
- D SCREEN^DGBT2
- COMPLT ; complete claims processing
- ;
- I '$D(^DGBT(392,DGBTDT,"A")) S DA=DGBTDT,DIE="^DGBT(392,",DR="11///"_DGBTDIVI_";12////"_DUZ_";13///"_DT D ^DIE S %=1 W !!,"Complete claim for ",DGBTDTE D YN^DICN G:%=2 EXIT3 G:%=-1 EXIT2 D:%<1 HELP1 G:%<1 COMPLT D SCREEN^DGBTEE
- G:DGBTTOUT=-1 EXIT2
- G ^DGBTEND
- HELP1 ;
- W !!?10,$S(%=-1:"SORRY, '^' NOT ALLOWED",1:"ENTER 'Y'ES OR 'N'O")
- Q
- INSTIT ; check for pointer to institution file and for address information on institution
- S DGBTDIVN=$P(^DG(40.8,DGBTDIVI,0),"^",7)
- I 'DGBTDIVN W !!,"INSTITUTION HAS NOT BEEN DEFINED FOR ",$P(^(0),"^"),!,"USE THE ADT PARAMETER OPTION TO UPDATE",! Q
- I $D(^DIC(4,DGBTDIVN,0)),$S($D(^(1))#10=0:1,$P(^(1),"^",3)']"":1,1:0) W !!,"INSTITUTION ADDRESS NOT ENTERED. PLEASE UPDATE USING THE INSTITUTION FILE ENTER/EDIT",! Q
- Q
- EXIT ; kills off all variables before quitting
- G QUIT^DGBTEND
- Q
- EXIT2 ; delete claim through DIK call, return to patient label
- G DELETE1^DGBTEND
- Q
- EXIT3 ;
- G DELETE^DGBTEND
- Q
- DGBTE ;ALB/SCK-BENEFICIARY TRAVEL SETUP/MAIN ENTRY CALL UP; 11/20/92@1000; 11/25/92
- +1 ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
- START ;
- +1 ; kill all variables
- DO QUIT^DGBTEND
- +2 SET PRCABN=1
- SET IOP="HOME"
- DO ^%ZIS
- KILL IOP
- +3 SET DGBTIME=300
- IF '$DATA(DTIME)
- SET DTIME=DGBTIME
- IF '$DATA(U)
- SET U="^"
- +4 ; if date/time is undefined, set DT value
- +5 IF '$DATA(DT)#2
- SET %DT=""
- SET S="T"
- DO ^%DT
- SET DT=Y
- DIVISN ; if MED CTR DIV file set up (first record) and record does not exist, write warning, kill variables, and exit
- +1 SET X=$GET(^DG(40.8,0))
- IF X=""
- WRITE !,"WARNING...MEDICAL CENTER DIVISION FILE IS NOT SET UP",!,"USE THE ADT PARAMETER OPTION FILE TO SET UP DIVISION"
- GOTO EXIT
- +2 ; check if multi-divisional center (GL node exists and 2nd piece=1). Do lookup, if it exists-set local variables
- +3 IF $DATA(^DG(43,1,"GL"))
- IF $PIECE(^("GL"),U,2)
- Begin DoDot:1
- +4 SET DIC="^DG(40.8,"
- SET DIC(0)="AEQMNZ"
- SET DIC("A")="Select DIVISION: "
- WRITE !!
- +5 DO ^DIC
- KILL DIC
- IF Y'>0
- QUIT
- +6 SET DGBTDIVI=+Y
- SET DGBTDIV=$PIECE(Y,U,2)
- +7 DO INSTIT
- SET DGBTMD=1
- End DoDot:1
- IF Y'>0
- GOTO EXIT
- GOTO PATIENT
- +8 ; if not a multi-divisional center, default to institution name
- +9 SET DGBTDIVI=$ORDER(^DG(40.8,0))
- SET DGBTDIV=$PIECE(^DG(40.8,DGBTDIVI,0),U)
- DO INSTIT
- +10 ;
- PATIENT ; patient lookup, quit if patient doesn't exist
- +1 ; kill local variables except med division vars
- DO QUIT1^DGBTEND
- +2 SET DGBTTOUT=""
- SET DIC="^DPT("
- SET DIC(0)="AEQMZ"
- SET DIC("A")="Select PATIENT: "
- +3 WRITE !!
- DO ^DIC
- KILL DIC
- IF Y'>0
- GOTO EXIT
- +4 ; get patient information#, call return patient return variables routine and set wether new claim or not
- +5 SET DFN=+Y
- DO 6^VADPT
- DO KVAR^DGBTEND
- DO PID^VADPT
- +6 SET DGBTNEW=$SELECT($DATA(^DGBT(392,"C",DFN)):0,1:1)
- +7 ;
- OLDCLAIM ; find any past claims through DGBTE1 call
- +1 ; set to call test routine, call old claims
- DO ^DGBTE1
- IF '$DATA(DGBTA)
- QUIT
- +2 IF '$DATA(^DG(43,1,"BT"))!('$DATA(^DG(43.1,$ORDER(^DG(43.1,(9999999.9999999-DGBTDT))),"BT")))
- Begin DoDot:1
- +3 ; check for certifying official and that current (or past) FY deductable is set up
- +4 WRITE !!,"***WARNING...BENE TRAVEL PARAMETERS HAVE NOT BEEN SET UP",!,"USE THE BENEFICIARY TRAVEL PARAMETER RATES ENTER/EDIT OPTION TO PROPERLY INITIALIZE"
- End DoDot:1
- GOTO EXIT2
- +5 ;
- SCREEN ; display B/T claim information through screen1
- +1 DO SCREEN^DGBT1
- +2 IF '+VAEL(1)
- WRITE !!,"Eligibility is missing from registration and is required to continue."
- GOTO EXIT2
- +3 SET DIR("A")="Continue processing claim"
- SET DIR("?")="Sorry, enter 'Y'es or RETURN to continue procesing claim, 'N'o to exit"
- SET DIR(0)="Y"
- SET DIR("B")="YES"
- +4 DO ^DIR
- SET ANS=Y
- KILL DIR
- IF 'ANS!($DATA(DTOUT))!($DATA(DUOUT))
- GOTO EXIT3
- SCREEN2 ;
- +1 DO SCREEN^DGBT2
- COMPLT ; complete claims processing
- +1 ;
- +2 IF '$DATA(^DGBT(392,DGBTDT,"A"))
- SET DA=DGBTDT
- SET DIE="^DGBT(392,"
- SET DR="11///"_DGBTDIVI_";12////"_DUZ_";13///"_DT
- DO ^DIE
- SET %=1
- WRITE !!,"Complete claim for ",DGBTDTE
- DO YN^DICN
- IF %=2
- GOTO EXIT3
- IF %=-1
- GOTO EXIT2
- IF %<1
- DO HELP1
- IF %<1
- GOTO COMPLT
- DO SCREEN^DGBTEE
- +3 IF DGBTTOUT=-1
- GOTO EXIT2
- +4 GOTO ^DGBTEND
- HELP1 ;
- +1 WRITE !!?10,$SELECT(%=-1:"SORRY, '^' NOT ALLOWED",1:"ENTER 'Y'ES OR 'N'O")
- +2 QUIT
- INSTIT ; check for pointer to institution file and for address information on institution
- +1 SET DGBTDIVN=$PIECE(^DG(40.8,DGBTDIVI,0),"^",7)
- +2 IF 'DGBTDIVN
- WRITE !!,"INSTITUTION HAS NOT BEEN DEFINED FOR ",$PIECE(^(0),"^"),!,"USE THE ADT PARAMETER OPTION TO UPDATE",!
- QUIT
- +3 IF $DATA(^DIC(4,DGBTDIVN,0))
- IF $SELECT($DATA(^(1))#10=0:1,$PIECE(^(1),"^",3)']"":1,1:0)
- WRITE !!,"INSTITUTION ADDRESS NOT ENTERED. PLEASE UPDATE USING THE INSTITUTION FILE ENTER/EDIT",!
- QUIT
- +4 QUIT
- EXIT ; kills off all variables before quitting
- +1 GOTO QUIT^DGBTEND
- +2 QUIT
- EXIT2 ; delete claim through DIK call, return to patient label
- +1 GOTO DELETE1^DGBTEND
- +2 QUIT
- EXIT3 ;
- +1 GOTO DELETE^DGBTEND
- +2 QUIT
