- DGBTE ;ALB/SCK/BLD - BENEFICIARY TRAVEL SETUP/MAIN ENTRY CALL UP ; 1/5/24 11:28am
- ;;1.0;Beneficiary Travel;**2,19,20,22,25,28,39,41**;September 25, 2001;Build 7
- START ;
- Q ;DGBT*1*41 Remove functionality
- N TRNSMDE,REMARKS,CLMTYPE,INSTIT,SPMODE,DGBTCMTY,DGBTDIVI,DGBTDIV,DGBTDIVN,DGANS,DGBTINCA,DGBTDTY,DGBTAPPTYP,DGBTDCLM,IOM,PATCHDT,DGBTPDIV
- ;DGBTINCA = Alternate Income
- K DGBTFDA,ERRMSG,DGBTX1,SGCOMPLETE
- ;
- D QUIT^DGBTEND ; kill all variables
- D PATCH
- 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 F D PATIENT Q:$G(DGANS)="Q" ;dbe patch DGBT*1*22 - return to select patient prompt
- . S DIC="^DG(40.8,",DIC(0)="AEQMNZ",DIC("A")="Select DIVISION: " W !!
- . D ^DIC K DIC Q:Y'>0
- . S (DGBTPDIV,DGBTDIVI)=+Y,DGBTDIV=$P(Y,U,2) ;dbe patch DGBT*1*22 - Added DGBTPDIV to save selected division if previous claim is edited
- . D INSTIT S DGBTMD=1
- Q:$G(DGANS)="Q" ;dbe patch DGBT*1*22
- ; if not a multi-divisional center, default to institution name
- S (DGBTPDIV,DGBTDIVI)=$O(^DG(40.8,0)),DGBTDIV=$P(^DG(40.8,DGBTDIVI,0),U) D INSTIT ;DGBT*1.0*28 - added variable DGBTPDIV
- ;
- PATIENT ; patient lookup, quit if patient doesn't exist
- N VAEL
- D QUIT^DGBTEND
- S DGBTOLD=0 ;PAVEL DGBT*1*20
- 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 I +Y'>0 D EXIT S DGANS="Q" Q
- ; get patient information#, call return patient return variables routine and set whether new claim or not
- S:DGBTDIVI'=DGBTPDIV DGBTDIVI=DGBTPDIV ;dbe patch DGBT*1*22 - restore selected division from previous claim editing
- S DFN=+Y D 6^VADPT,KVAR^DGBTEND,PID^VADPT,RESADDR^DGBTUTL1(.DGBTADDR) ;*39 - call resaddr to get values for address
- S DGBTNEW=$S($D(^DGBT(392,"C",DFN)):0,1:1)
- S SPCOMPLETE=0,DGBTAPPTYP=0
- S DGBTNSC=$$NSC^DGBTUTL
- ;
- ;next 2 lines were added by the BT Dashboard project(DGBT*1.0*19) and Integrated into DGBTE by BLD for DGBT*1.0*20
- S ^XTMP("DGBT BTD",0)=$$DT^XLFDT_"^"_$$DT^XLFDT
- S ^XTMP("DGBT BTD","CLAIMERS",$G(DUZ,-1))=$G(DFN,-1)
- ;
- OLDCLAIM ; find any past claims through DGBTE1 call
- D ^DGBTE1 I '$D(DGBTA) D PATIENT Q ; 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 D EXIT2 Q
- . ; check for certifying official and that current (or past) FY deductible 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"
- ;
- COREFLS ; coreFLS vendor interface active/inactive
- S DGBTCORE=$P($G(^DG(43,1,"BT")),U,4)
- ;
- SCREEN ; display B/T claim information through screen1
- N DGBTQUIT
- D SCREEN^DGBT1 I $G(DGBTQUIT) D:'$G(CHZFLG) EXIT2,PATIENT D:$G(CHZFLG) EXIT,PATIENT Q
- Q:$G(ENDMENU)
- S:$D(^DGBT(392,DGBTDT,"SP")) SPCOMPLETE=1
- I '+VAEL(1) W !!,"Eligibility is missing from registration and is required to continue.",*7 D EXIT2 Q
- I $G(DGANS)="I" Q ;BLD DG*1*20
- S DIR("A")="Continue processing claim",DIR("?")="Sorry, enter 'Y'es or RETURN to continue processing claim, 'N'o to exit",DIR(0)="Y",DIR("B")="YES"
- D ^DIR S ANS=Y K DIR
- I 'ANS S SPCOMPLETE=0 D EXIT2,CLEANUP^DGBTSP,PATIENT Q ;S DGANS="Q" Q ;BLD DG*1*20
- N DGBTELL S DGBTELL=$$ELIG^DGBTUTL1(DFN) ;PAVEL DGBT*1.0*20
- I +$G(DGBTELL)'=14,(+$G(DGBTELL)'=15) W !!," Eligible: ",$P(DGBTELL,U,2),!!
- I +$G(DGBTELL)=15 W !!,"Not Eligible: ",$P(DGBTELL,U,2),!!
- I +DGBTELL=14 S:'$G(CHZFLG) DGBTTOUT=-1,DGBTOLD=0 G DELETE1^DGBTEND ;User exit with ^ so delete the claim !!??
- D ;Store Result of E7 in fields 43.1 43.2
- .K FDA,ERRMSG
- .S FDA(392,DGBTDTI_",",43)=$G(DGBTCPAP)
- .S FDA(392,DGBTDTI_",",43.1)=+$G(DGBTELL)
- .S FDA(392,DGBTDTI_",",43.4)=$G(DGBTSCAP)
- .S FDA(392,DGBTDTI_",",43.5)=$G(DGBTQAP)
- .S:$L($P(DGBTELL,": ",2)) FDA(392,DGBTDTI_",",43.2)=$P($G(DGBTELL),": ",2,99)
- .D FILE^DIE("EKTS","FDA","ERRMSG") ;
- .I $D(ERRMSG),ERRMSG("DIERR",1,"TEXT",1)["The record is currently locked" W !!,"The patients record is currently locked..."
- I $D(ERRMSG) D EXIT Q
- ;
- ;the following question is for E1 in patch DGBT*1.0*20
- ;
- SPMODE ;BLD DGBT*1*20 - SPMODE line tag will display question whether or special mode claim or mileage claim
- ; CLMTYP = type of BT claim, Mileage or Special Mode
- ;
- S (SPCOMPLETE,DGBTSP)=0
- D EN^DGBTSP(.DGBTSP) I $D(DTOUT)!($D(DUOUT)) K:$G(DGBTTOUT)=-1&($G(CHZFLG)=0) ^DGBT(392,DGBTDTI,"A") D:'$G(SPCOMPLETE) EXIT2 D:$G(SPCOMPLETE)&('$G(CHZFLG)) CLEANUP^DGBTSP D PATIENT,EXIT Q ;DGBT*1.0*28 - added check for 'chzflg
- I +DGBTELL=15 D I $G(DGBTTOUT)=-1 D:$G(DGBTTOUT)=-1&($G(CHZFLG)=0) EXIT2 D:$G(DGBTTOUT)=-1&($G(CHZFLG)) EXIT D PATIENT,EXIT Q
- .W !!,"CLAIM HAS BEEN DENIED AND DENIAL OF BENEFITS LETTER WILL BE ISSUED"
- .D DGBTDR^DGBTDLT Q:$G(DGBTTOUT)=-1
- .W !!,"PLEASE COMPLETE THE INVOICE INFORMATION." H 2
- S DA=DGBTDT,DIE="^DGBT(392,",DR="11///"_DGBTDIVI S:'$G(CHZFLG)!($P(^DGBT(392,DGBTDT,0),U,12)="") DR=DR_";12////"_DUZ S:'$G(CHZFLG)!($P(^DGBT(392,DGBTDT,0),U,13)="") DR=DR_";13///"_DT D ^DIE ;dbe patch DGBT*1*25
- I DGBTCMTY="S" D RESTART^DGBTSP(DGBTCMTY) I $D(DTOUT)!($D(DUOUT))!('$G(SPCOMPLETE)) S:'$G(SPCOMPLTE) DGBTTOUT=-1 D:'$G(SPCOMPLETE) EXIT2 D:$G(SPCOMPLETE) CLEANUP^DGBTSP D PATIENT,EXIT Q
- ;
- SCREEN2 ;
- I $G(DGBTSP)=0&('$D(^DGBT(392,"C",DFN,DGBTDTI))) D CLEANUP^DGBTSP,EXIT2 Q
- I $G(DFN)=""&($G(DGBTSP)=0) D PATIENT Q
- D SCREEN^DGBT2
- COMPLT ; complete claims processing
- ;
- I DGBTCMTY="M" S SPCOMPLETE=0
- I $G(SPCOMPLETE)=1 W !!,"Complete claim for ",DGBTDTE_" " S %=1 D YN^DICN S:%=2 SPCOMPLETE=0 K:%=2&(CHZFLG=0) ^DGBT(392,DGBTDTI,"A") I %'=1 D:%<1 HELP1 G:%<1 COMPLT D:(%=2)&($G(SPCOMPLETE)=0) EXIT2,PATIENT Q ;dbe patch DGBT*1*22
- ;
- I $G(DGBTCMTY)="M" D G:(%=2)&($G(DGBTSP)=0) EXIT G:%=2 EXIT3 G:%=-1 EXIT2 D:%<1 HELP1 G:%<1 COMPLT
- .S DA=DGBTDT,DIE="^DGBT(392,",DR="11///"_DGBTDIVI S:'$G(CHZFLG)!($P(^DGBT(392,DGBTDT,0),U,12)="") DR=DR_";12////"_DUZ S:'$G(CHZFLG)!($P(^DGBT(392,DGBTDT,0),U,13)="") DR=DR_";13///"_DT D ^DIE S %=1 ;dbe patch DGBT*1*25
- .W !!,"Complete claim for ",DGBTDTE D YN^DICN S:%=2 %=-1 S:%=-1&($G(CHZFLG)=0) DGBTTOUT=-1
- I $D(DGBTSP)>1 D FILE^DGBTSP1(.SPCOMPLETE) S NOLINE=1 D:$G(DGBTSP)=0 PATIENT D:$G(DGBTSP)=1 SCREEN^DGBTCDSP D EXIT D:$G(DGANS) PATIENT Q
- I $G(DGBTCMTY)="M" F I="SP","SPAD" K ^DGBT(392,DGBTDT,I) ;clean up special mode if during an edit user switches from special mode to mileage
- I $G(SPCOMPLETE)=1&(DGBTCMTY'="M") D EXIT Q
- D SCREEN^DGBTEE
- I $G(DGBTTOUT)=-1,$G(DGBTCMTY)="M" G DELETE1^DGBTEND ;PAVEL DGBT*1*20
- G:$G(DGBTTOUT)=-1 EXIT3
- D ^DGBTEND
- Q
- 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
- I $D(DGANS) D QUIT^DGBTEND Q
- I $G(DGBTCMTY)="S" D END^DGBTCDSP Q
- D QUIT^DGBTEND Q
- Q
- EXIT2 ; delete claim through DIK call, return to patient label
- D DELETE1^DGBTEND
- Q
- EXIT3 ;
- I $G(DGBTCMTY)="S" S:$D(^DGBT(392,DGBTDT,"SP")) DGBTTOUT="" D DELETE1^DGBTEND Q
- I $D(^DGBT(392,DGBTDT,"A")) S DGBTTOUT=""
- D DELETE^DGBTEND
- Q
- ;
- PATCH ;this return the date DGBT*1.0*20 was first loaded
- ;
- N PATCHNBR
- S PATCHNBR=$O(^XPD(9.7,"B","DGBT*1.0*20",""))
- S PATCHDT=$P(^XPD(9.7,PATCHNBR,0),"^",3)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGBTE 8274 printed Feb 18, 2025@23:07:01 Page 2
- DGBTE ;ALB/SCK/BLD - BENEFICIARY TRAVEL SETUP/MAIN ENTRY CALL UP ; 1/5/24 11:28am
- +1 ;;1.0;Beneficiary Travel;**2,19,20,22,25,28,39,41**;September 25, 2001;Build 7
- START ;
- +1 ;DGBT*1*41 Remove functionality
- QUIT
- +2 NEW TRNSMDE,REMARKS,CLMTYPE,INSTIT,SPMODE,DGBTCMTY,DGBTDIVI,DGBTDIV,DGBTDIVN,DGANS,DGBTINCA,DGBTDTY,DGBTAPPTYP,DGBTDCLM,IOM,PATCHDT,DGBTPDIV
- +3 ;DGBTINCA = Alternate Income
- +4 KILL DGBTFDA,ERRMSG,DGBTX1,SGCOMPLETE
- +5 ;
- +6 ; kill all variables
- DO QUIT^DGBTEND
- +7 DO PATCH
- +8 SET PRCABN=1
- SET IOP="HOME"
- DO ^%ZIS
- KILL IOP
- +9 SET DGBTIME=300
- if '$DATA(DTIME)
- SET DTIME=DGBTIME
- if '$DATA(U)
- SET U="^"
- +10 ; if date/time is undefined, set DT value
- +11 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 ;dbe patch DGBT*1*22 - return to select patient prompt
- 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 ;dbe patch DGBT*1*22 - Added DGBTPDIV to save selected division if previous claim is edited
- SET (DGBTPDIV,DGBTDIVI)=+Y
- SET DGBTDIV=$PIECE(Y,U,2)
- +7 DO INSTIT
- SET DGBTMD=1
- End DoDot:1
- if Y'>0
- GOTO EXIT
- FOR
- DO PATIENT
- if $GET(DGANS)="Q"
- QUIT
- +8 ;dbe patch DGBT*1*22
- if $GET(DGANS)="Q"
- QUIT
- +9 ; if not a multi-divisional center, default to institution name
- +10 ;DGBT*1.0*28 - added variable DGBTPDIV
- SET (DGBTPDIV,DGBTDIVI)=$ORDER(^DG(40.8,0))
- SET DGBTDIV=$PIECE(^DG(40.8,DGBTDIVI,0),U)
- DO INSTIT
- +11 ;
- PATIENT ; patient lookup, quit if patient doesn't exist
- +1 NEW VAEL
- +2 DO QUIT^DGBTEND
- +3 ;PAVEL DGBT*1*20
- SET DGBTOLD=0
- +4 ; kill local variables except med division vars
- DO QUIT1^DGBTEND
- +5 SET DGBTTOUT=""
- SET DIC="^DPT("
- SET DIC(0)="AEQMZ"
- SET DIC("A")="Select PATIENT: "
- +6 WRITE !!
- DO ^DIC
- KILL DIC
- IF +Y'>0
- DO EXIT
- SET DGANS="Q"
- QUIT
- +7 ; get patient information#, call return patient return variables routine and set whether new claim or not
- +8 ;dbe patch DGBT*1*22 - restore selected division from previous claim editing
- if DGBTDIVI'=DGBTPDIV
- SET DGBTDIVI=DGBTPDIV
- +9 ;*39 - call resaddr to get values for address
- SET DFN=+Y
- DO 6^VADPT
- DO KVAR^DGBTEND
- DO PID^VADPT
- DO RESADDR^DGBTUTL1(.DGBTADDR)
- +10 SET DGBTNEW=$SELECT($DATA(^DGBT(392,"C",DFN)):0,1:1)
- +11 SET SPCOMPLETE=0
- SET DGBTAPPTYP=0
- +12 SET DGBTNSC=$$NSC^DGBTUTL
- +13 ;
- +14 ;next 2 lines were added by the BT Dashboard project(DGBT*1.0*19) and Integrated into DGBTE by BLD for DGBT*1.0*20
- +15 SET ^XTMP("DGBT BTD",0)=$$DT^XLFDT_"^"_$$DT^XLFDT
- +16 SET ^XTMP("DGBT BTD","CLAIMERS",$GET(DUZ,-1))=$GET(DFN,-1)
- +17 ;
- OLDCLAIM ; find any past claims through DGBTE1 call
- +1 ; set to call test routine, call old claims
- DO ^DGBTE1
- IF '$DATA(DGBTA)
- DO PATIENT
- 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 deductible 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
- DO EXIT2
- QUIT
- +5 ;
- COREFLS ; coreFLS vendor interface active/inactive
- +1 SET DGBTCORE=$PIECE($GET(^DG(43,1,"BT")),U,4)
- +2 ;
- SCREEN ; display B/T claim information through screen1
- +1 NEW DGBTQUIT
- +2 DO SCREEN^DGBT1
- IF $GET(DGBTQUIT)
- if '$GET(CHZFLG)
- DO EXIT2
- DO PATIENT
- if $GET(CHZFLG)
- DO EXIT
- DO PATIENT
- QUIT
- +3 if $GET(ENDMENU)
- QUIT
- +4 if $DATA(^DGBT(392,DGBTDT,"SP"))
- SET SPCOMPLETE=1
- +5 IF '+VAEL(1)
- WRITE !!,"Eligibility is missing from registration and is required to continue.",*7
- DO EXIT2
- QUIT
- +6 ;BLD DG*1*20
- IF $GET(DGANS)="I"
- QUIT
- +7 SET DIR("A")="Continue processing claim"
- SET DIR("?")="Sorry, enter 'Y'es or RETURN to continue processing claim, 'N'o to exit"
- SET DIR(0)="Y"
- SET DIR("B")="YES"
- +8 DO ^DIR
- SET ANS=Y
- KILL DIR
- +9 ;S DGANS="Q" Q ;BLD DG*1*20
- IF 'ANS
- SET SPCOMPLETE=0
- DO EXIT2
- DO CLEANUP^DGBTSP
- DO PATIENT
- QUIT
- +10 ;PAVEL DGBT*1.0*20
- NEW DGBTELL
- SET DGBTELL=$$ELIG^DGBTUTL1(DFN)
- +11 IF +$GET(DGBTELL)'=14
- IF (+$GET(DGBTELL)'=15)
- WRITE !!," Eligible: ",$PIECE(DGBTELL,U,2),!!
- +12 IF +$GET(DGBTELL)=15
- WRITE !!,"Not Eligible: ",$PIECE(DGBTELL,U,2),!!
- +13 ;User exit with ^ so delete the claim !!??
- IF +DGBTELL=14
- if '$GET(CHZFLG)
- SET DGBTTOUT=-1
- SET DGBTOLD=0
- GOTO DELETE1^DGBTEND
- +14 ;Store Result of E7 in fields 43.1 43.2
- Begin DoDot:1
- +15 KILL FDA,ERRMSG
- +16 SET FDA(392,DGBTDTI_",",43)=$GET(DGBTCPAP)
- +17 SET FDA(392,DGBTDTI_",",43.1)=+$GET(DGBTELL)
- +18 SET FDA(392,DGBTDTI_",",43.4)=$GET(DGBTSCAP)
- +19 SET FDA(392,DGBTDTI_",",43.5)=$GET(DGBTQAP)
- +20 if $LENGTH($PIECE(DGBTELL,"
- SET FDA(392,DGBTDTI_",",43.2)=$PIECE($GET(DGBTELL),": ",2,99)
- +21 ;
- DO FILE^DIE("EKTS","FDA","ERRMSG")
- +22 IF $DATA(ERRMSG)
- IF ERRMSG("DIERR",1,"TEXT",1)["The record is currently locked"
- WRITE !!,"The patients record is currently locked..."
- End DoDot:1
- +23 IF $DATA(ERRMSG)
- DO EXIT
- QUIT
- +24 ;
- +25 ;the following question is for E1 in patch DGBT*1.0*20
- +26 ;
- SPMODE ;BLD DGBT*1*20 - SPMODE line tag will display question whether or special mode claim or mileage claim
- +1 ; CLMTYP = type of BT claim, Mileage or Special Mode
- +2 ;
- +3 SET (SPCOMPLETE,DGBTSP)=0
- +4 ;DGBT*1.0*28 - added check for 'chzflg
- DO EN^DGBTSP(.DGBTSP)
- IF $DATA(DTOUT)!($DATA(DUOUT))
- if $GET(DGBTTOUT)=-1&($GET(CHZFLG)=0)
- KILL ^DGBT(392,DGBTDTI,"A")
- if '$GET(SPCOMPLETE)
- DO EXIT2
- if $GET(SPCOMPLETE)&('$GET(CHZFLG))
- DO CLEANUP^DGBTSP
- DO PATIENT
- DO EXIT
- QUIT
- +5 IF +DGBTELL=15
- Begin DoDot:1
- +6 WRITE !!,"CLAIM HAS BEEN DENIED AND DENIAL OF BENEFITS LETTER WILL BE ISSUED"
- +7 DO DGBTDR^DGBTDLT
- if $GET(DGBTTOUT)=-1
- QUIT
- +8 WRITE !!,"PLEASE COMPLETE THE INVOICE INFORMATION."
- HANG 2
- End DoDot:1
- IF $GET(DGBTTOUT)=-1
- if $GET(DGBTTOUT)=-1&($GET(CHZFLG)=0)
- DO EXIT2
- if $GET(DGBTTOUT)=-1&($GET(CHZFLG))
- DO EXIT
- DO PATIENT
- DO EXIT
- QUIT
- +9 ;dbe patch DGBT*1*25
- SET DA=DGBTDT
- SET DIE="^DGBT(392,"
- SET DR="11///"_DGBTDIVI
- if '$GET(CHZFLG)!($PIECE(^DGBT(392,DGBTDT,0),U,12)="")
- SET DR=DR_";12////"_DUZ
- if '$GET(CHZFLG)!($PIECE(^DGBT(392,DGBTDT,0),U,13)="")
- SET DR=DR_";13///"_DT
- DO ^DIE
- +10 IF DGBTCMTY="S"
- DO RESTART^DGBTSP(DGBTCMTY)
- IF $DATA(DTOUT)!($DATA(DUOUT))!('$GET(SPCOMPLETE))
- if '$GET(SPCOMPLTE)
- SET DGBTTOUT=-1
- if '$GET(SPCOMPLETE)
- DO EXIT2
- if $GET(SPCOMPLETE)
- DO CLEANUP^DGBTSP
- DO PATIENT
- DO EXIT
- QUIT
- +11 ;
- SCREEN2 ;
- +1 IF $GET(DGBTSP)=0&('$DATA(^DGBT(392,"C",DFN,DGBTDTI)))
- DO CLEANUP^DGBTSP
- DO EXIT2
- QUIT
- +2 IF $GET(DFN)=""&($GET(DGBTSP)=0)
- DO PATIENT
- QUIT
- +3 DO SCREEN^DGBT2
- COMPLT ; complete claims processing
- +1 ;
- +2 IF DGBTCMTY="M"
- SET SPCOMPLETE=0
- +3 ;dbe patch DGBT*1*22
- IF $GET(SPCOMPLETE)=1
- WRITE !!,"Complete claim for ",DGBTDTE_" "
- SET %=1
- DO YN^DICN
- if %=2
- SET SPCOMPLETE=0
- if %=2&(CHZFLG=0)
- KILL ^DGBT(392,DGBTDTI,"A")
- IF %'=1
- if %<1
- DO HELP1
- if %<1
- GOTO COMPLT
- if (%=2)&($GET(SPCOMPLETE)=0)
- DO EXIT2
- DO PATIENT
- QUIT
- +4 ;
- +5 IF $GET(DGBTCMTY)="M"
- Begin DoDot:1
- +6 ;dbe patch DGBT*1*25
- SET DA=DGBTDT
- SET DIE="^DGBT(392,"
- SET DR="11///"_DGBTDIVI
- if '$GET(CHZFLG)!($PIECE(^DGBT(392,DGBTDT,0),U,12)="")
- SET DR=DR_";12////"_DUZ
- if '$GET(CHZFLG)!($PIECE(^DGBT(392,DGBTDT,0),U,13)="")
- SET DR=DR_";13///"_DT
- DO ^DIE
- SET %=1
- +7 WRITE !!,"Complete claim for ",DGBTDTE
- DO YN^DICN
- if %=2
- SET %=-1
- if %=-1&($GET(CHZFLG)=0)
- SET DGBTTOUT=-1
- End DoDot:1
- if (%=2)&($GET(DGBTSP)=0)
- GOTO EXIT
- if %=2
- GOTO EXIT3
- if %=-1
- GOTO EXIT2
- if %<1
- DO HELP1
- if %<1
- GOTO COMPLT
- +8 IF $DATA(DGBTSP)>1
- DO FILE^DGBTSP1(.SPCOMPLETE)
- SET NOLINE=1
- if $GET(DGBTSP)=0
- DO PATIENT
- if $GET(DGBTSP)=1
- DO SCREEN^DGBTCDSP
- DO EXIT
- if $GET(DGANS)
- DO PATIENT
- QUIT
- +9 ;clean up special mode if during an edit user switches from special mode to mileage
- IF $GET(DGBTCMTY)="M"
- FOR I="SP","SPAD"
- KILL ^DGBT(392,DGBTDT,I)
- +10 IF $GET(SPCOMPLETE)=1&(DGBTCMTY'="M")
- DO EXIT
- QUIT
- +11 DO SCREEN^DGBTEE
- +12 ;PAVEL DGBT*1*20
- IF $GET(DGBTTOUT)=-1
- IF $GET(DGBTCMTY)="M"
- GOTO DELETE1^DGBTEND
- +13 if $GET(DGBTTOUT)=-1
- GOTO EXIT3
- +14 DO ^DGBTEND
- +15 QUIT
- 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 IF $DATA(DGANS)
- DO QUIT^DGBTEND
- QUIT
- +2 IF $GET(DGBTCMTY)="S"
- DO END^DGBTCDSP
- QUIT
- +3 DO QUIT^DGBTEND
- QUIT
- +4 QUIT
- EXIT2 ; delete claim through DIK call, return to patient label
- +1 DO DELETE1^DGBTEND
- +2 QUIT
- EXIT3 ;
- +1 IF $GET(DGBTCMTY)="S"
- if $DATA(^DGBT(392,DGBTDT,"SP"))
- SET DGBTTOUT=""
- DO DELETE1^DGBTEND
- QUIT
- +2 IF $DATA(^DGBT(392,DGBTDT,"A"))
- SET DGBTTOUT=""
- +3 DO DELETE^DGBTEND
- +4 QUIT
- +5 ;
- PATCH ;this return the date DGBT*1.0*20 was first loaded
- +1 ;
- +2 NEW PATCHNBR
- +3 SET PATCHNBR=$ORDER(^XPD(9.7,"B","DGBT*1.0*20",""))
- +4 SET PATCHDT=$PIECE(^XPD(9.7,PATCHNBR,0),"^",3)
- +5 QUIT