Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGBTE

DGBTE.m

Go to the documentation of this file.
  1. 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
  1. START ;
  1. Q ;DGBT*1*41 Remove functionality
  1. N TRNSMDE,REMARKS,CLMTYPE,INSTIT,SPMODE,DGBTCMTY,DGBTDIVI,DGBTDIV,DGBTDIVN,DGANS,DGBTINCA,DGBTDTY,DGBTAPPTYP,DGBTDCLM,IOM,PATCHDT,DGBTPDIV
  1. ;DGBTINCA = Alternate Income
  1. K DGBTFDA,ERRMSG,DGBTX1,SGCOMPLETE
  1. ;
  1. D QUIT^DGBTEND ; kill all variables
  1. D PATCH
  1. S PRCABN=1,IOP="HOME" D ^%ZIS K IOP
  1. S DGBTIME=300 S:'$D(DTIME) DTIME=DGBTIME S:'$D(U) U="^"
  1. ; if date/time is undefined, set DT value
  1. I '$D(DT)#2 S %DT="",S="T" D ^%DT S DT=Y
  1. DIVISN ; if MED CTR DIV file set up (first record) and record does not exist, write warning, kill variables, and exit
  1. 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
  1. ; check if multi-divisional center (GL node exists and 2nd piece=1). Do lookup, if it exists-set local variables
  1. 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
  1. . S DIC="^DG(40.8,",DIC(0)="AEQMNZ",DIC("A")="Select DIVISION: " W !!
  1. . D ^DIC K DIC Q:Y'>0
  1. . 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
  1. . D INSTIT S DGBTMD=1
  1. Q:$G(DGANS)="Q" ;dbe patch DGBT*1*22
  1. ; if not a multi-divisional center, default to institution name
  1. 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
  1. ;
  1. PATIENT ; patient lookup, quit if patient doesn't exist
  1. N VAEL
  1. D QUIT^DGBTEND
  1. S DGBTOLD=0 ;PAVEL DGBT*1*20
  1. D QUIT1^DGBTEND ; kill local variables except med division vars
  1. S DGBTTOUT="",DIC="^DPT(",DIC(0)="AEQMZ",DIC("A")="Select PATIENT: "
  1. W !! D ^DIC K DIC I +Y'>0 D EXIT S DGANS="Q" Q
  1. ; get patient information#, call return patient return variables routine and set whether new claim or not
  1. S:DGBTDIVI'=DGBTPDIV DGBTDIVI=DGBTPDIV ;dbe patch DGBT*1*22 - restore selected division from previous claim editing
  1. S DFN=+Y D 6^VADPT,KVAR^DGBTEND,PID^VADPT,RESADDR^DGBTUTL1(.DGBTADDR) ;*39 - call resaddr to get values for address
  1. S DGBTNEW=$S($D(^DGBT(392,"C",DFN)):0,1:1)
  1. S SPCOMPLETE=0,DGBTAPPTYP=0
  1. S DGBTNSC=$$NSC^DGBTUTL
  1. ;
  1. ;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
  1. S ^XTMP("DGBT BTD",0)=$$DT^XLFDT_"^"_$$DT^XLFDT
  1. S ^XTMP("DGBT BTD","CLAIMERS",$G(DUZ,-1))=$G(DFN,-1)
  1. ;
  1. OLDCLAIM ; find any past claims through DGBTE1 call
  1. D ^DGBTE1 I '$D(DGBTA) D PATIENT Q ; set to call test routine, call old claims
  1. I '$D(^DG(43,1,"BT"))!('$D(^DG(43.1,$O(^DG(43.1,(9999999.9999999-DGBTDT))),"BT"))) D D EXIT2 Q
  1. . ; check for certifying official and that current (or past) FY deductible is set up
  1. . W !!,"***WARNING...BENE TRAVEL PARAMETERS HAVE NOT BEEN SET UP",!,"USE THE BENEFICIARY TRAVEL PARAMETER RATES ENTER/EDIT OPTION TO PROPERLY INITIALIZE"
  1. ;
  1. COREFLS ; coreFLS vendor interface active/inactive
  1. S DGBTCORE=$P($G(^DG(43,1,"BT")),U,4)
  1. ;
  1. SCREEN ; display B/T claim information through screen1
  1. N DGBTQUIT
  1. D SCREEN^DGBT1 I $G(DGBTQUIT) D:'$G(CHZFLG) EXIT2,PATIENT D:$G(CHZFLG) EXIT,PATIENT Q
  1. Q:$G(ENDMENU)
  1. S:$D(^DGBT(392,DGBTDT,"SP")) SPCOMPLETE=1
  1. I '+VAEL(1) W !!,"Eligibility is missing from registration and is required to continue.",*7 D EXIT2 Q
  1. I $G(DGANS)="I" Q ;BLD DG*1*20
  1. 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"
  1. D ^DIR S ANS=Y K DIR
  1. I 'ANS S SPCOMPLETE=0 D EXIT2,CLEANUP^DGBTSP,PATIENT Q ;S DGANS="Q" Q ;BLD DG*1*20
  1. N DGBTELL S DGBTELL=$$ELIG^DGBTUTL1(DFN) ;PAVEL DGBT*1.0*20
  1. I +$G(DGBTELL)'=14,(+$G(DGBTELL)'=15) W !!," Eligible: ",$P(DGBTELL,U,2),!!
  1. I +$G(DGBTELL)=15 W !!,"Not Eligible: ",$P(DGBTELL,U,2),!!
  1. I +DGBTELL=14 S:'$G(CHZFLG) DGBTTOUT=-1,DGBTOLD=0 G DELETE1^DGBTEND ;User exit with ^ so delete the claim !!??
  1. D ;Store Result of E7 in fields 43.1 43.2
  1. .K FDA,ERRMSG
  1. .S FDA(392,DGBTDTI_",",43)=$G(DGBTCPAP)
  1. .S FDA(392,DGBTDTI_",",43.1)=+$G(DGBTELL)
  1. .S FDA(392,DGBTDTI_",",43.4)=$G(DGBTSCAP)
  1. .S FDA(392,DGBTDTI_",",43.5)=$G(DGBTQAP)
  1. .S:$L($P(DGBTELL,": ",2)) FDA(392,DGBTDTI_",",43.2)=$P($G(DGBTELL),": ",2,99)
  1. .D FILE^DIE("EKTS","FDA","ERRMSG") ;
  1. .I $D(ERRMSG),ERRMSG("DIERR",1,"TEXT",1)["The record is currently locked" W !!,"The patients record is currently locked..."
  1. I $D(ERRMSG) D EXIT Q
  1. ;
  1. ;the following question is for E1 in patch DGBT*1.0*20
  1. ;
  1. 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
  1. ;
  1. S (SPCOMPLETE,DGBTSP)=0
  1. 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
  1. 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
  1. .W !!,"CLAIM HAS BEEN DENIED AND DENIAL OF BENEFITS LETTER WILL BE ISSUED"
  1. .D DGBTDR^DGBTDLT Q:$G(DGBTTOUT)=-1
  1. .W !!,"PLEASE COMPLETE THE INVOICE INFORMATION." H 2
  1. 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
  1. 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
  1. ;
  1. SCREEN2 ;
  1. I $G(DGBTSP)=0&('$D(^DGBT(392,"C",DFN,DGBTDTI))) D CLEANUP^DGBTSP,EXIT2 Q
  1. I $G(DFN)=""&($G(DGBTSP)=0) D PATIENT Q
  1. D SCREEN^DGBT2
  1. COMPLT ; complete claims processing
  1. ;
  1. I DGBTCMTY="M" S SPCOMPLETE=0
  1. 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
  1. ;
  1. I $G(DGBTCMTY)="M" D G:(%=2)&($G(DGBTSP)=0) EXIT G:%=2 EXIT3 G:%=-1 EXIT2 D:%<1 HELP1 G:%<1 COMPLT
  1. .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
  1. .W !!,"Complete claim for ",DGBTDTE D YN^DICN S:%=2 %=-1 S:%=-1&($G(CHZFLG)=0) DGBTTOUT=-1
  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
  1. 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
  1. I $G(SPCOMPLETE)=1&(DGBTCMTY'="M") D EXIT Q
  1. D SCREEN^DGBTEE
  1. I $G(DGBTTOUT)=-1,$G(DGBTCMTY)="M" G DELETE1^DGBTEND ;PAVEL DGBT*1*20
  1. G:$G(DGBTTOUT)=-1 EXIT3
  1. D ^DGBTEND
  1. Q
  1. HELP1 ;
  1. W !!?10,$S(%=-1:"SORRY, '^' NOT ALLOWED",1:"ENTER 'Y'ES OR 'N'O")
  1. Q
  1. INSTIT ; check for pointer to institution file and for address information on institution
  1. S DGBTDIVN=$P(^DG(40.8,DGBTDIVI,0),"^",7)
  1. I 'DGBTDIVN W !!,"INSTITUTION HAS NOT BEEN DEFINED FOR ",$P(^(0),"^"),!,"USE THE ADT PARAMETER OPTION TO UPDATE",! Q
  1. 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
  1. Q
  1. EXIT ; kills off all variables before quitting
  1. I $D(DGANS) D QUIT^DGBTEND Q
  1. I $G(DGBTCMTY)="S" D END^DGBTCDSP Q
  1. D QUIT^DGBTEND Q
  1. Q
  1. EXIT2 ; delete claim through DIK call, return to patient label
  1. D DELETE1^DGBTEND
  1. Q
  1. EXIT3 ;
  1. I $G(DGBTCMTY)="S" S:$D(^DGBT(392,DGBTDT,"SP")) DGBTTOUT="" D DELETE1^DGBTEND Q
  1. I $D(^DGBT(392,DGBTDT,"A")) S DGBTTOUT=""
  1. D DELETE^DGBTEND
  1. Q
  1. ;
  1. PATCH ;this return the date DGBT*1.0*20 was first loaded
  1. ;
  1. N PATCHNBR
  1. S PATCHNBR=$O(^XPD(9.7,"B","DGBT*1.0*20",""))
  1. S PATCHDT=$P(^XPD(9.7,PATCHNBR,0),"^",3)
  1. Q