DGBTSP ;ALB/BLD - BENEFICIARY TRAVEL SPECIAL MODE OF TRANSPORTATION ; 12/18/2011@1000 ; 12/23/2012
;;1.0;Beneficiary Travel;**20,22,25,39,40**;December 27, 2011;Build 8
;
;MUST ENTER AT EN^DGBTSP
Q
;
EN(DGBTSP) ;main entry point from DGBTE
;
;TRNSMDE = mode of transportation
;REMARKS = will only have data if OTHER is chosen from mode of transportation list
N TRNSMDE,DGBTINTO,PREAUTH,DGBTACTYPE,MODEOFTRANS,OTHERTRANRMKS,AUTHORIZED,VENDOR,INVOICE,INVDT,OWTRP,TOTALMILES,TOTINVOICE,DGBTFDA
N BASERATE,MILEAGEFEE,NOSHOW,WAITTIME,EXTRACREW,SPEQUIP,REMARKS,DGBTINTO,ERRMSG,OTHERTRANSRMKS,ACTTYPE,ERRMSG
S DGBTSP=1,DGBTCMTY="S",SPCOMPLETE=0 ; DGBT*1.0*40 - default DGBTCMTY to "S"
;type of claim - Mileage or Special Mode Claim
S DGBTACTYPE=$$GET1^DIQ(392,DGBTDT,56,"I")
;
;DGBT*1.0*40 - removing mileage claim option
;
;S DIR("A")="Is this a Mileage or Special Mode Claim?",DIR("?")="Enter 'M' for Mileage Claim or RETURN to continue processing Mileage claim or 'S' for Special Mode Claim"
;S DIR(0)="S^M:MILEAGE;S:SPECIAL MODE^^W $S(X=""M"":""MILEAGE"",X=""S"":""SPECIAL MODE"",1:"""") K:X="" X"
;S DIR("B")=$S($G(DGBTSP("CLAIM TYPE"))'="":DGBTSP("CLAIM TYPE"),$G(DGBTACTYPE)'="":DGBTACTYPE,1:"M")
; *40 - only allow special mode claims, replacing with yes/no prompt
K DIR
S DIR(0)="Y"
S DIR("A")="Do you want to enter a Special Mode Claim"
S DIR("A",1)="Use the Beneficiary Travel Self-Service System (BTSSS) for Mileage Claims."
S DIR("B")="Yes"
D ^DIR K DIR
S:$D(^DGBT(392,DGBTDTI,"SP")) SPCOMPLETE=1
I ($D(DTOUT))!($D(DUOUT))!($G(Y)=0) K DGBTSP S DUOUT=1,DGBTSP=$S($D(^DGBT(392,DGBTDTI,"SP")):1,1:0),SPCOMPLETE=$S($G(CHZFLG)=1:1,1:0),DGBTTOUT=-1 Q ; *40 - need to set DUOUT to quit claim process
I $G(Y)=1 S Y="S",Y(0)="SPECIAL MODE" ; *40 - setting Y to make it compatible with existing code below
S DGBTSP("CLAIM TYPE")=$P(Y,",",1),DGBTCMTY=$P(Y,",",1)
;*************
I +DGBTELL=15 D
.S DGBTFDA(392,DGBTDTI_",",56)=$G(DGBTSP("CLAIM TYPE"))
.S DGBTFDA(392,DGBTDTI_",",3)=$P(VAEL(1),"^",2)
.I +VAEL(3) S DGBTFDA(392,DGBTDTI_",",4)=$P(VAEL(3),"^",2)
.S DGBTFDA(392,DGBTDTI_",",41)=$$GET1^DIQ(200,DUZ,.01)
.S DGBTFDA(392,DGBTDTI_",",42)=$$GET1^DIQ(2,DFN,.01)
.I $E(DGBTDTI,1,7)=DGBTDT D
..S DGBTFDA(392,DGBTDTI_",",6)=$S(DGBTCMTY="S":$$GET1^DIQ(392.3,6,.01),1:$$GET1^DIQ(392.3,8,.01))
.D FILE^DIE("EKTS","DGBTFDA","ERRMSG")
.;*************************
.I '$D(ERRMSG) S SPCOMPLETE=1
I DGBTSP("CLAIM TYPE")'="S" D
.S DA=DGBTDT,DIE="^DGBT(392,",DR="56///"_DGBTCMTY D ^DIE S %=1
.K DGBTSP S DGBTCMTY="M" S DGBTSP=0,SPCOMPLETE=0 D:$D(^DGBT(392,DGBTDT,"SP")) DELSP^DGBTSP1(DGBTDT)
Q
;
RESTART(DGBTCMTY) ;
N SPACCT,SPACTIEN
S SPACCT="826 SPECIAL MODE - NON-EMERGEN"
S (ACCT,SPACTIEN,DGBTQ)=0
F S ACCT=$O(^DGBT(392.3,"B",ACCT)) D Q:DGBTQ!($G(ACCT)="") ;dbe patch DGBT*1*25 - properly loop through account file
.I ACCT'["SPECIAL MODE - NON-EMERGEN" Q
.S SPACTIEN=$O(^DGBT(392.3,"B",ACCT,""))
.I $$GET1^DIQ(392.3,SPACTIEN,4,"I")'<DT!($$GET1^DIQ(392.3,SPACTIEN,4)=""),$$GET1^DIQ(392.3,SPACTIEN,5,"I")=3 S DGBTQ=1
.;E S ACCT="" ;dbe patch DGBT*1*25
I $G(ACCT)="" D Q ;dbe patch DGBT*1*25
.D ACTFILE^DGBTSP
.I 'CHZFLG S DGBTTOUT=-1,DGBTOLD=0,SPCOMPLETE=0
.E S DUOUT=1,SPCOMPLETE=0
S $P(^DGBT(392,DGBTDT,0),"^",9)=""
S DGBTSP("ACCOUNT")=$$GET1^DIQ(392.3,SPACTIEN,.01)
;
;mode of special transportation used
W !
S SPCOMPLETE=0
S MODEOFTRANS=$$GET1^DIQ(392,DGBTDT,57,"E")
S DIR("A")="MODE OF TRANSPORTATION: ",DIR("?")="This field points to the Beneficiary Travel Mode of Transportation file and indicates the mode of transportation used for this Beneficiary Travel Claim."
S DIR(0)="PA^392.42:EMZ"
S MODEOFTRANS=$S($G(MODEOFTRANS)'="":MODEOFTRANS,1:$G(DGBTSP("MODE OF TRANS")))
I MODEOFTRANS'="" S DIR("B")=$S($G(MODEOFTRANS)'="":MODEOFTRANS,1:$G(DGBTSP("MODE OF TRANS")))
D ^DIR S TRNSMDE=$P($G(Y(0)),",",1) K DIR S:$D(^DGBT(392,DGBTDTI,"SP")) SPCOMPLETE=1 I ($D(DTOUT))!($D(DUOUT)) K DGBTSP S DGBTSP=0 Q
S DGBTSP("MODE OF TRANS")=$P($G(Y(0)),",",1)
I TRNSMDE="OTHER" D SPRMKS(.DGBTSP)
D PREAUTH(.DGBTSP) Q:$D(DUOUT)!$D(DTOUT)!(SPCOMPLETE=0)
D VENDOR(.DGBTSP) Q:$D(DUOUT)!$D(DTOUT)
D ADDINFO(.DGBTSP) Q:$D(DUOUT)!$D(DTOUT)
Q
;
SPRMKS(DGBTSP) ;will allow user to enter other remarks about special mode transportation
W !
S OTHERTRANSRMKS=$$GET1^DIQ(392,DGBTDT,69,"I")
S DIR("A")="SPECIFY OTHER MODE OF TRANSPORTATION"
S DIR("?")="Enter other information about the type of Special Mode of Transportation. 3-25 characters."
S DIR(0)="FO^3:25"
I OTHERTRANSRMKS'="" S DIR("B")=$S($G(OTHERTRANSRMKS)'="":OTHERTRANSRMKS,1:$G(DGBTSP("OTHER TRANS REMARKS")))
D ^DIR K DIR S:$D(^DGBT(392,DGBTDTI,"SP")) SPCOMPLETE=1 I ($D(DTOUT))!($D(DUOUT)) K DGBTSP S DGBTSP=0 Q
S DGBTSP("OTHER TRANS REMARKS")=Y
Q
;
PREAUTH(DGBTSP) ;this will ask if trip was pre-authorized. If answer is no then ask end user if claim is approved or denied.
;if end user indicates that authorization has been denied, then the System denies the Claim and issues an Appeal Rights
;document and prompts the end user for the Vendor. The end user is only allowed to select a Vendor from the list
;of vendors already in the FMS system.
;
W !
Q:$G(DFN)=""!($G(DGBTSP)=0)
S PREAUTH=$$GET1^DIQ(392,DGBTDT,70)
S DIR("A")="WAS TRIP PRE-AUTHORIZED"
S DIR(0)="Y"
S DIR("?")="Sorry, enter 'N'o if not Pre-Authorized, 'Y'es if Pre-Authorized",DIR(0)="Y"
I PREAUTH'="" S DIR("B")=$S($G(PREAUTH)'="":$G(PREAUTH),1:$S($G(DGBTSP("PRE-AUTHORIZED"))=1:"YES",1:"NO"))
D ^DIR K DIR S:$D(^DGBT(392,DGBTDTI,"SP")) SPCOMPLETE=1 I ($D(DTOUT))!($D(DUOUT)) K DGBTSP S DGBTSP=0,SPCOMPLETE=0 Q
S DGBTSP("PRE-AUTHORIZED")=+Y
S DGBTSP("PRE-AUTHORIZED")=$G(Y(0))
I DGBTSP("PRE-AUTHORIZED")="YES" K DGBTSP("AUTHORIZED") S DGBTSP("AUTHORIZED")="YES" D CLRLTR^DGBTDLT(0)
I '+Y D I ($D(DTOUT))!($D(DUOUT))!(SPCOMPLETE=0) S DGBTSP=0 Q
.S AUTHORIZED=$$GET1^DIQ(392,DGBTDT,85)
.S DIR("A")="IS AUTHORIZATION APPROVED"
.S DIR("?")="Sorry, enter 'N'o if Claim not Authorized, 'Y'es if Claim is Authorized",DIR(0)="Y"
.S DIR(0)="Y"
.S DIR("B")=$S($G(AUTHORIZED)'="":$G(AUTHORIZED),1:$S($G(DGBTSP("AUTHORIZED"))=1:"YES",1:"NO"))
.D ^DIR K DIR S:+Y SPCOMPLETE=1 I ($D(DTOUT))!($D(DUOUT)) Q
.S DGBTSP("AUTHORIZED")=+Y
.S DGBTSP("AUTHORIZED")=$G(Y(0))
.I Y(0)="NO" D Q
..I $G(DGBTAPPTYP) W !!,"CLAIM HAS BEEN DENIED AND DENIAL OF BENEFITS LETTER HAS ALREADY BEEN ISSUED"
..I '$G(DGBTAPPTYP) W !!,"CLAIM HAS BEEN DENIED AND DENIAL OF BENEFITS LETTER WILL BE ISSUED"
..I '$G(DGBTAPPTYP) D DGBTDR^DGBTDLT Q:SPCOMPLETE=0
..W !!,"PLEASE COMPLETE THE INVOICE INFORMATION." H 1
..S SPCOMPLETE=1
I '$G(DGBTAPPTYP) D CLRLTR^DGBTDLT(0)
S SPCOMPLETE=1
Q
;
VENDOR(DGBTSP) ;allows the user to select from a vendor already in the FMS system
;
W !
Q:$G(DFN)=""!($G(DGBTSP)=0)
S VENDOR=$$GET1^DIQ(392,DGBTDT,71,"E")
S DIR("A")="SELECT VENDOR: "
S DIR("?")="Select a Vendor from the list only"
S DIR(0)="PA^440:EMZ"
S VENDOR=$S($G(VENDOR)'="":VENDOR,$G(DGBTSP("VENDOR"))'="":$G(DGBTSP("VENDOR")),1:"")
I VENDOR'="" S DIR("B")=$S($G(VENDOR)'="":VENDOR,1:$G(DGBTSP("VENDOR")))
D ^DIR K DIR S:$D(^DGBT(392,DGBTDTI,"SP")) SPCOMPLETE=1 I ($D(DTOUT))!($D(DUOUT)) K DGBTSP S DGBTSP=0,SPCOMPLETE=0 Q
S DGBTSP("VENDOR")=$P($G(Y),"^",1) ;dbe patch DGBT*1*22 - modified to use vendor ien
;
Q
;
ADDINFO(DGBTSP) ;this will ask additional questions of the end user about the invoice presented by the patient.
;
Q:$G(DFN)=""!($G(DGBTSP)=0)
N I
D INST(.DGBTINST)
;
;address information
S DIR("A")="PLACE OF DEPARTURE [LINE 1]"
S DIR("?")="ENTER "_"PLACE OF DEPARTURE [LINE 1]. 1 TO 30 CHARACTERS"
S DIR(0)="FO^1:30"
S DEPL1=$$GET1^DIQ(392,DGBTDTI,73)
S DIR("B")=$S($G(DEPL1)'="":$G(DEPL1),1:$G(DGBTADDR(1))) ;*39 - updated to use residential address
D ^DIR K DIR S:$D(^DGBT(392,DGBTDTI,"SP")) SPCOMPLETE=1 I $D(DTOUT)!($D(DUOUT)) S DGBTSP=0,SPCOMPLETE=0 Q
S DGBTSP("PLACE OF DEPARTURE")=Y
;
S DIR("A")="PLACE OF DEPARTURE [LINE 2]"
S DIR("?")="ENTER "_"PLACE OF DEPARTURE [LINE 2]. 1 TO 30 CHARACTERS"
S DIR(0)="FO^1:30"
S DEPL2=$$GET1^DIQ(392,DGBTDTI,74)
S DIR("B")=$S($G(DEPL2)'="":$G(DEPL2),1:$G(DGBTADDR(2))) ;*39 - updated to use residential address
I $G(DIR("B"))="" K DIR("B")
D ^DIR K DIR S:$D(^DGBT(392,DGBTDTI,"SP")) SPCOMPLETE=1 I $D(DTOUT)!($D(DUOUT)) S DGBTSP=0,SPCOMPLETE=0 Q
S DGBTSP("PLACE OF DEPARTURE 2")=Y
;
S DIR("A")="CITY OF DEPARTURE"
S DIR("?")="ENTER "_"CITY OF DEPARTURE. 3 TO 30 CHARACTERS"
S DIR(0)="FO^3:30"
S DEPCITY=$$GET1^DIQ(392,DGBTDTI,75)
S DIR("B")=$S($G(DEPCITY)'="":$G(DEPCITY),1:$G(DGBTADDR(4))) ;*39 - updated to use residential address
D ^DIR K DIR S:$D(^DGBT(392,DGBTDTI,"SP")) SPCOMPLETE=1 I $D(DTOUT)!($D(DUOUT)) S DGBTSP=0,SPCOMPLETE=0 Q
S DGBTSP("CITY OF DEPARTURE")=Y
;
S DIR("A")="STATE OF DEPARTURE"
S DIR("?")="ENTER "_"STATE OF DEPARTURE"
S DIR(0)="P^5:EMZ"
S DEPST=$$GET1^DIQ(392,DGBTDTI,76)
S DIR("B")=$S($G(DEPST)'="":$G(DEPST),1:$P($G(DGBTADDR(5)),"^",2)) ;*39 - updated to use residential address
D ^DIR K DIR S:$D(^DGBT(392,DGBTDTI,"SP")) SPCOMPLETE=1 I $D(DTOUT)!($D(DUOUT)) S DGBTSP=0,SPCOMPLETE=0 Q
S DGBTSP("STATE OF DEPARTURE")=$P(Y,"^",2)
;
S DIR("A")="ZIP CODE/DEPARTURE"
S DIR("?")="ENTER "_"ZIP CODE/DEPARTURE (5 NUMBERS)"
S DIR(0)="FO^5:5" ;$S(I="STATE OF DEPATURE":"P^5:EMZ",1:"FO^3:30")
S DEPZIP=$$GET1^DIQ(392,DGBTDTI,77)
S DIR("B")=$S($G(DEPZIP)'="":$G(DEPZIP),1:$E($P(DGBTADDR(6),U),1,5)) ;*39 - updated to use residential address
D ^DIR K DIR S:$D(^DGBT(392,DGBTDTI,"SP")) SPCOMPLETE=1 I $D(DTOUT)!($D(DUOUT)) S DGBTSP=0,SPCOMPLETE=0 Q
S DGBTSP("ZIP CODE/DEPARTURE")=Y
;
Q:$G(DGBTSP)=0
;
;destination information
W !
;
S DIR("A")="DESTINATION [LINE 1]"
S DIR("?")="ENTER "_"DESTINATION [LINE 1]. 1 TO 30 CHARACTERS"
S DIR(0)="FO^1:30"
S DISTL1=$$GET1^DIQ(392,DGBTDTI,78)
S DIR("B")=$S($G(DISTL1)'="":DISTL1,1:DGBTINST("DIVISION"))
D ^DIR K DIR S:$D(^DGBT(392,DGBTDTI,"SP")) SPCOMPLETE=1 I $D(DTOUT)!($D(DUOUT)) S DGBTSP=0,SPCOMPLETE=0 Q
S DGBTINST("DIVISION")=Y
;
S DIR("A")="DESTINATION [LINE 2]"
S DIR("?")="ENTER "_"DESTINATION [LINE 2]. 1 TO 30 CHARACTERS"
S DIR(0)="FO^1:30"
S DISTL2=$$GET1^DIQ(392,DGBTDTI,79)
S DIR("B")=$S($G(DISTL2)'="":DISTL2,1:DGBTINST("INST NAME"))
I $G(DIR("B"))="" K DIR("B")
D ^DIR K DIR S:$D(^DGBT(392,DGBTDTI,"SP")) SPCOMPLETE=1 I $D(DTOUT)!($D(DUOUT)) S DGBTSP=0,SPCOMPLETE=0 Q
S DGBTINST("INST NAME")=Y
;
S DIR("A")="DESTINATION [LINE 3]"
S DIR("?")="ENTER "_"DESTINATION [LINE 3]. 1 TO 30 CHARACTERS"
S DIR(0)="FO^1:30"
S DISTL1=$$GET1^DIQ(392,DGBTDTI,80)
S DIR("B")=$S($G(DISTL1)'="":DISTL1,1:DGBTINST("ADDRESS1"))
D ^DIR K DIR S:$D(^DGBT(392,DGBTDTI,"SP")) SPCOMPLETE=1 I $D(DTOUT)!($D(DUOUT)) S DGBTSP=0,SPCOMPLETE=0 Q
S DGBTINST("ADDRESS1")=Y
;
S DIR("A")="CITY"
S DIR("?")="ENTER "_"CITY OF DESTINATION. 3 TO 30 CHARACTERS"
S DIR(0)="FO^3:30"
S DISTCITY=$$GET1^DIQ(392,DGBTDTI,81)
S DIR("B")=$S($G(DISTCITY)'="":DISTCITY,1:DGBTINST("CITY"))
D ^DIR K DIR S:$D(^DGBT(392,DGBTDTI,"SP")) SPCOMPLETE=1 I $D(DTOUT)!($D(DUOUT)) S DGBTSP=0,SPCOMPLETE=0 Q
S DGBTINST("CITY")=Y
;
S DIR("A")="STATE OF DESTINATION"
S DIR("?")="ENTER "_"STATE OF DESTINATION"
S DIR(0)="PO^5:EMZ"
S DISTST=$$GET1^DIQ(392,DGBTDTI,82)
S DIR("B")=$S($G(DISTST)'="":DISTST,1:DGBTINST("STATE"))
D ^DIR K DIR S:$D(^DGBT(392,DGBTDTI,"SP")) SPCOMPLETE=1 I $D(DTOUT)!($D(DUOUT)) S DGBTSP=0,SPCOMPLETE=0 Q
S DGBTINST("STATE")=$P(Y,"^",2)
;
S DIR("A")="ZIP CODE/DESTINATION"
S DIR("?")="ENTER "_"ZIP CODE/DESTINATION (5 NUMBERS)"
S DIR(0)="FO^5:5"
S DISTZIP=$$GET1^DIQ(392,DGBTDTI,83)
S DIR("B")=$S($G(DISTZIP)'="":DISTZIP,1:DGBTINST("ZIP CODE"))
D ^DIR K DIR S:$D(^DGBT(392,DGBTDTI,"SP")) SPCOMPLETE=1 I $D(DTOUT)!($D(DUOUT)) S DGBTSP=0,SPCOMPLETE=0 Q
S DGBTINST("ZIP CODE")=Y
;
Q:$G(DGBTSP)=0
;invoice information
W !
S INVOICE=$$GET1^DIQ(392,DGBTDT,58,"I")
S DIR("A")="INVOICE NUMBER: "
S DIR("?")="Enter Special Mode invoice number. Should be min 1 max of 30."
S DIR(0)="FA^1:30"
S INVOICE=$S($G(INVOICE)'="":INVOICE,$G(DGBTSP("INVOICE NUMBER"))'="":$G(DGBTSP("INVOICE NUMBER")),1:"")
I INVOICE'="" S DIR("B")=$S($G(INVOICE)'="":INVOICE,1:$G(DGBTSP("INVOICE NUMBER")))
D ^DIR K DIR S:$D(^DGBT(392,DGBTDTI,"SP")) SPCOMPLETE=1 I ($D(DTOUT))!($D(DUOUT)) K DGBTSP S DGBTSP=0,SPCOMPLETE=0 Q
S DGBTSP("INVOICE NUMBER")=Y
;
W !
S INVDT=$$GET1^DIQ(392,DGBTDT,59,"E")
S DIR("A")="INVOICE DATE: "
S DIR("?")="^D HELP1^DGBTE1A"
S DIR(0)="DAO^3000101:DT+1:EX"
I INVDT'="" S DIR("B")=$S($G(INVDT)'="":$G(INVDT),$G(DGBTSP("DT INVOICE REC")):$G(DGBTSP("INVOICE NUMBER")),1:DGBTDTE)
D ^DIR K DIR S:$D(^DGBT(392,DGBTDTI,"SP")) SPCOMPLETE=1 I ($D(DTOUT))!($D(DUOUT)) K DGBTSP S DGBTSP=0,SPCOMPLETE=0 Q
S DGBTSP("DT INVOICE REC")=$G(Y(0))
;
W !
S OWRTP=$$GET1^DIQ(392,DGBTDT,67,"E")
S DIR("A")="ONE WAY/ROUND TRIP:"
S DIR("?")="Enter 'R' for Round Trip or 'O' for One Way Trip ."
S DIR(0)="SA^R:ROUND TRIP;O:ONE WAY TRIP"
S OWRTP=$S($G(OWRTP)'="":OWRTP,$G(DGBTSP("RT/ONE WAY")):$G(DGBTSP("RT/ONE WAY")),1:"")
I OWRTP'="" S DIR("B")=$S($G(OWRTP)'="":OWRTP,1:$G(DGBTSP("RT/ONE WAY")))
D ^DIR K DIR S:$D(^DGBT(392,DGBTDTI,"SP")) SPCOMPLETE=1 I ($D(DTOUT))!($D(DUOUT)) K DGBTSP S DGBTSP=0,SPCOMPLETE=0 Q
S DGBTSP("RT/ONE WAY")=Y
;
W !
S TOTALMILES=$$GET1^DIQ(392,DGBTDT,68,"E")
S DIR("A")="TOTAL MILES: "
S DIR("?")="Type a Number between 1 and 10000, 0 Decimal Digits" ;dbe patch DGBT*1*25
S DIR(0)="NA^1:10000:0" ;dbe patch DGBT*1*25 - reduced mileage maximum to 10,000 from 99,999
S TOTALMILES=$S($G(TOTALMILES)'="":TOTALMILES,$G(DGBTSP("TOTAL MILES")):$G(DGBTSP("TOTAL MILES")),1:"")
I TOTALMILES'="" S DIR("B")=$S($G(TOTALMILES)'="":TOTALMILES,1:$G(DGBTSP("TOTAL MILES")))
D ^DIR K DIR S:$D(^DGBT(392,DGBTDTI,"SP")) SPCOMPLETE=1 I ($D(DTOUT))!($D(DUOUT)) K DGBTSP S DGBTSP=0,SPCOMPLETE=0 Q
S DGBTSP("TOTAL MILES")=Y
;
F I=1:1 Q:I>1&($G(DGBTSP("TOTAL INVOICE"))'="")&($G(DGBTSP("TOTAL INVOICE"))=$G(DGBTINTO)) D INVAMT^DGBTSP1 Q:$G(DGBTSP)=0 I ($G(DGBTSP("TOTAL INVOICE"))'="")&($G(DGBTSP("TOTAL INVOICE"))'=$G(DGBTINTO)) D
.W !!,"TOTAL INVOICE DOES NOT EQUAL THE SUM OF THE COMPONENT FEES."
.W !,"YOU MUST CORRECT THE CLAIM BEFORE CONTINUING",!
;
Q:DGBTSP=0
;
W !
S REMARKS=$$GET1^DIQ(392,DGBTDT,72,"E")
S DIR("A")="REMARKS: "
S DIR("?")="Enter other information about the Special Mode of Transportation Invoice. 3-50 characters."
S DIR(0)="FOA^3:50"
I REMARKS'="" S DIR("B")=$S($G(REMARKS)'="":REMARKS,1:$G(DGBTSP("SP MODE OTHER REMARKS")))
D ^DIR K DIR S:$D(^DGBT(392,DGBTDTI,"SP")) SPCOMPLETE=1 I ($D(DTOUT))!($D(DUOUT)) K DGBTSP S DGBTSP=0,SPCOMPLETE=0 Q
S DGBTSP("SP MODE OTHER REMARKS")=Y
;
Q
;
INST(DGBTINST) ;get destination information
;
N FAC,ERROR,FIELDS,TEMP
S DGBTINST("DIVISION")=$$GET1^DIQ(40.8,DGBTDIVI,.01)
S DGBTINST("INST NAME")=$$GET1^DIQ(4,DGBTDIVN,.01)
S DGBTINST("ADDRESS1")=$$GET1^DIQ(4,DGBTDIVN,1.01)
S DGBTINST("CITY")=$$GET1^DIQ(4,DGBTDIVN,1.03)
S DGBTINST("STATE")=$$GET1^DIQ(4,DGBTDIVN,.02)
S DGBTINST("ZIP CODE")=$E($$GET1^DIQ(4,DGBTDIVN,1.04),1,5)
;
Q
;
CLEANUP ;this will clean up the ^DGBT(392,D0) file for nodes "M","D","T" and the 3 and 4 piece of the "A" node
;
Q:$G(DGBTDTI)=""
F I="M","D","B","C","T" I $D(DGBTDTI) K ^DGBT(392,DGBTDTI,I)
;F I=8,9,10 S $P(^DGBT(392,DGBTDTI,0),"^",I)=""
S DGBTDL("ISSUED")=$S($G(DGBTDL("ISSUED"))'="":$G(DGBTDL("ISSUED")),1:"")
S DGBTDL("ISSUED DATE")=$S($G(DGBTDL("ISSUED DATE"))'="":$G(DGBTDL("ISSUED DATE")),1:"")
S DGBTDL("CLAIM DENIED")=$S($G(DGBTDL("CLAIM DENIED"))'="":$G(DGBTDL("CLAIM DENIED")),1:"NO")
S DGBTDL("DT DENIED")=$S($G(DGBTDL("DT DENIED"))'="":$G(DGBTDL("DT DENIED")),1:"")
S DGBTDL("DENIED REASON")=$S($G(DGBTDL("DENIED REASON"))'="":$G(DGBTDL("DENIED REASON")),1:"")
;
S DGBTFDA(392,DGBTDTI_",",45)=$G(DGBTDL("ISSUED"))
S DGBTFDA(392,DGBTDTI_",",45.1)=$G(DGBTDL("ISSUED DATE"))
S DGBTFDA(392,DGBTDTI_",",45.2)=$G(DGBTDL("CLAIM DENIED"))
S DGBTFDA(392,DGBTDTI_",",45.3)=$G(DGBTDL("DT DENIED"))
S DGBTFDA(392,DGBTDTI_",",45.4)=$G(DGBTDL("DENIED REASON"))
S DGBTFDA(392,DGBTDTI_",",8)=""
S DGBTFDA(392,DGBTDTI_",",9)=""
S DGBTFDA(392,DGBTDTI_",",10)=""
D FILE^DIE("EKTS","DGBTFDA","ERRMSG") K DGBTFDA
Q
;
ACTFILE ;
K DIR
I 'ACCT D Q
.W !!
.S MYHELP("DIHELP",1)="Beneficiary Travel Account file (#392.3) is not set up correctly."
.S MYHELP("DIHELP",2)="Please see User Manual for proper setup."
.D MSG^DIALOG("WSH","","","","MYHELP")
.W !!
.S DIR(0)="E"
.D ^DIR
.S DGBTTOUT=-1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGBTSP 16794 printed Sep 23, 2025@19:17:05 Page 2
DGBTSP ;ALB/BLD - BENEFICIARY TRAVEL SPECIAL MODE OF TRANSPORTATION ; 12/18/2011@1000 ; 12/23/2012
+1 ;;1.0;Beneficiary Travel;**20,22,25,39,40**;December 27, 2011;Build 8
+2 ;
+3 ;MUST ENTER AT EN^DGBTSP
+4 QUIT
+5 ;
EN(DGBTSP) ;main entry point from DGBTE
+1 ;
+2 ;TRNSMDE = mode of transportation
+3 ;REMARKS = will only have data if OTHER is chosen from mode of transportation list
+4 NEW TRNSMDE,DGBTINTO,PREAUTH,DGBTACTYPE,MODEOFTRANS,OTHERTRANRMKS,AUTHORIZED,VENDOR,INVOICE,INVDT,OWTRP,TOTALMILES,TOTINVOICE,DGBTFDA
+5 NEW BASERATE,MILEAGEFEE,NOSHOW,WAITTIME,EXTRACREW,SPEQUIP,REMARKS,DGBTINTO,ERRMSG,OTHERTRANSRMKS,ACTTYPE,ERRMSG
+6 ; DGBT*1.0*40 - default DGBTCMTY to "S"
SET DGBTSP=1
SET DGBTCMTY="S"
SET SPCOMPLETE=0
+7 ;type of claim - Mileage or Special Mode Claim
+8 SET DGBTACTYPE=$$GET1^DIQ(392,DGBTDT,56,"I")
+9 ;
+10 ;DGBT*1.0*40 - removing mileage claim option
+11 ;
+12 ;S DIR("A")="Is this a Mileage or Special Mode Claim?",DIR("?")="Enter 'M' for Mileage Claim or RETURN to continue processing Mileage claim or 'S' for Special Mode Claim"
+13 ;S DIR(0)="S^M:MILEAGE;S:SPECIAL MODE^^W $S(X=""M"":""MILEAGE"",X=""S"":""SPECIAL MODE"",1:"""") K:X="" X"
+14 ;S DIR("B")=$S($G(DGBTSP("CLAIM TYPE"))'="":DGBTSP("CLAIM TYPE"),$G(DGBTACTYPE)'="":DGBTACTYPE,1:"M")
+15 ; *40 - only allow special mode claims, replacing with yes/no prompt
+16 KILL DIR
+17 SET DIR(0)="Y"
+18 SET DIR("A")="Do you want to enter a Special Mode Claim"
+19 SET DIR("A",1)="Use the Beneficiary Travel Self-Service System (BTSSS) for Mileage Claims."
+20 SET DIR("B")="Yes"
+21 DO ^DIR
KILL DIR
+22 if $DATA(^DGBT(392,DGBTDTI,"SP"))
SET SPCOMPLETE=1
+23 ; *40 - need to set DUOUT to quit claim process
IF ($DATA(DTOUT))!($DATA(DUOUT))!($GET(Y)=0)
KILL DGBTSP
SET DUOUT=1
SET DGBTSP=$SELECT($DATA(^DGBT(392,DGBTDTI,"SP")):1,1:0)
SET SPCOMPLETE=$SELECT($GET(CHZFLG)=1:1,1:0)
SET DGBTTOUT=-1
QUIT
+24 ; *40 - setting Y to make it compatible with existing code below
IF $GET(Y)=1
SET Y="S"
SET Y(0)="SPECIAL MODE"
+25 SET DGBTSP("CLAIM TYPE")=$PIECE(Y,",",1)
SET DGBTCMTY=$PIECE(Y,",",1)
+26 ;*************
+27 IF +DGBTELL=15
Begin DoDot:1
+28 SET DGBTFDA(392,DGBTDTI_",",56)=$GET(DGBTSP("CLAIM TYPE"))
+29 SET DGBTFDA(392,DGBTDTI_",",3)=$PIECE(VAEL(1),"^",2)
+30 IF +VAEL(3)
SET DGBTFDA(392,DGBTDTI_",",4)=$PIECE(VAEL(3),"^",2)
+31 SET DGBTFDA(392,DGBTDTI_",",41)=$$GET1^DIQ(200,DUZ,.01)
+32 SET DGBTFDA(392,DGBTDTI_",",42)=$$GET1^DIQ(2,DFN,.01)
+33 IF $EXTRACT(DGBTDTI,1,7)=DGBTDT
Begin DoDot:2
+34 SET DGBTFDA(392,DGBTDTI_",",6)=$SELECT(DGBTCMTY="S":$$GET1^DIQ(392.3,6,.01),1:$$GET1^DIQ(392.3,8,.01))
End DoDot:2
+35 DO FILE^DIE("EKTS","DGBTFDA","ERRMSG")
+36 ;*************************
+37 IF '$DATA(ERRMSG)
SET SPCOMPLETE=1
End DoDot:1
+38 IF DGBTSP("CLAIM TYPE")'="S"
Begin DoDot:1
+39 SET DA=DGBTDT
SET DIE="^DGBT(392,"
SET DR="56///"_DGBTCMTY
DO ^DIE
SET %=1
+40 KILL DGBTSP
SET DGBTCMTY="M"
SET DGBTSP=0
SET SPCOMPLETE=0
if $DATA(^DGBT(392,DGBTDT,"SP"))
DO DELSP^DGBTSP1(DGBTDT)
End DoDot:1
+41 QUIT
+42 ;
RESTART(DGBTCMTY) ;
+1 NEW SPACCT,SPACTIEN
+2 SET SPACCT="826 SPECIAL MODE - NON-EMERGEN"
+3 SET (ACCT,SPACTIEN,DGBTQ)=0
+4 ;dbe patch DGBT*1*25 - properly loop through account file
FOR
SET ACCT=$ORDER(^DGBT(392.3,"B",ACCT))
Begin DoDot:1
+5 IF ACCT'["SPECIAL MODE - NON-EMERGEN"
QUIT
+6 SET SPACTIEN=$ORDER(^DGBT(392.3,"B",ACCT,""))
+7 IF $$GET1^DIQ(392.3,SPACTIEN,4,"I")'<DT!($$GET1^DIQ(392.3,SPACTIEN,4)="")
IF $$GET1^DIQ(392.3,SPACTIEN,5,"I")=3
SET DGBTQ=1
+8 ;E S ACCT="" ;dbe patch DGBT*1*25
End DoDot:1
if DGBTQ!($GET(ACCT)="")
QUIT
+9 ;dbe patch DGBT*1*25
IF $GET(ACCT)=""
Begin DoDot:1
+10 DO ACTFILE^DGBTSP
+11 IF 'CHZFLG
SET DGBTTOUT=-1
SET DGBTOLD=0
SET SPCOMPLETE=0
+12 IF '$TEST
SET DUOUT=1
SET SPCOMPLETE=0
End DoDot:1
QUIT
+13 SET $PIECE(^DGBT(392,DGBTDT,0),"^",9)=""
+14 SET DGBTSP("ACCOUNT")=$$GET1^DIQ(392.3,SPACTIEN,.01)
+15 ;
+16 ;mode of special transportation used
+17 WRITE !
+18 SET SPCOMPLETE=0
+19 SET MODEOFTRANS=$$GET1^DIQ(392,DGBTDT,57,"E")
+20 SET DIR("A")="MODE OF TRANSPORTATION: "
SET DIR("?")="This field points to the Beneficiary Travel Mode of Transportation file and indicates the mode of transportation used for this Beneficiary Travel Claim."
+21 SET DIR(0)="PA^392.42:EMZ"
+22 SET MODEOFTRANS=$SELECT($GET(MODEOFTRANS)'="":MODEOFTRANS,1:$GET(DGBTSP("MODE OF TRANS")))
+23 IF MODEOFTRANS'=""
SET DIR("B")=$SELECT($GET(MODEOFTRANS)'="":MODEOFTRANS,1:$GET(DGBTSP("MODE OF TRANS")))
+24 DO ^DIR
SET TRNSMDE=$PIECE($GET(Y(0)),",",1)
KILL DIR
if $DATA(^DGBT(392,DGBTDTI,"SP"))
SET SPCOMPLETE=1
IF ($DATA(DTOUT))!($DATA(DUOUT))
KILL DGBTSP
SET DGBTSP=0
QUIT
+25 SET DGBTSP("MODE OF TRANS")=$PIECE($GET(Y(0)),",",1)
+26 IF TRNSMDE="OTHER"
DO SPRMKS(.DGBTSP)
+27 DO PREAUTH(.DGBTSP)
if $DATA(DUOUT)!$DATA(DTOUT)!(SPCOMPLETE=0)
QUIT
+28 DO VENDOR(.DGBTSP)
if $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+29 DO ADDINFO(.DGBTSP)
if $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+30 QUIT
+31 ;
SPRMKS(DGBTSP) ;will allow user to enter other remarks about special mode transportation
+1 WRITE !
+2 SET OTHERTRANSRMKS=$$GET1^DIQ(392,DGBTDT,69,"I")
+3 SET DIR("A")="SPECIFY OTHER MODE OF TRANSPORTATION"
+4 SET DIR("?")="Enter other information about the type of Special Mode of Transportation. 3-25 characters."
+5 SET DIR(0)="FO^3:25"
+6 IF OTHERTRANSRMKS'=""
SET DIR("B")=$SELECT($GET(OTHERTRANSRMKS)'="":OTHERTRANSRMKS,1:$GET(DGBTSP("OTHER TRANS REMARKS")))
+7 DO ^DIR
KILL DIR
if $DATA(^DGBT(392,DGBTDTI,"SP"))
SET SPCOMPLETE=1
IF ($DATA(DTOUT))!($DATA(DUOUT))
KILL DGBTSP
SET DGBTSP=0
QUIT
+8 SET DGBTSP("OTHER TRANS REMARKS")=Y
+9 QUIT
+10 ;
PREAUTH(DGBTSP) ;this will ask if trip was pre-authorized. If answer is no then ask end user if claim is approved or denied.
+1 ;if end user indicates that authorization has been denied, then the System denies the Claim and issues an Appeal Rights
+2 ;document and prompts the end user for the Vendor. The end user is only allowed to select a Vendor from the list
+3 ;of vendors already in the FMS system.
+4 ;
+5 WRITE !
+6 if $GET(DFN)=""!($GET(DGBTSP)=0)
QUIT
+7 SET PREAUTH=$$GET1^DIQ(392,DGBTDT,70)
+8 SET DIR("A")="WAS TRIP PRE-AUTHORIZED"
+9 SET DIR(0)="Y"
+10 SET DIR("?")="Sorry, enter 'N'o if not Pre-Authorized, 'Y'es if Pre-Authorized"
SET DIR(0)="Y"
+11 IF PREAUTH'=""
SET DIR("B")=$SELECT($GET(PREAUTH)'="":$GET(PREAUTH),1:$SELECT($GET(DGBTSP("PRE-AUTHORIZED"))=1:"YES",1:"NO"))
+12 DO ^DIR
KILL DIR
if $DATA(^DGBT(392,DGBTDTI,"SP"))
SET SPCOMPLETE=1
IF ($DATA(DTOUT))!($DATA(DUOUT))
KILL DGBTSP
SET DGBTSP=0
SET SPCOMPLETE=0
QUIT
+13 SET DGBTSP("PRE-AUTHORIZED")=+Y
+14 SET DGBTSP("PRE-AUTHORIZED")=$GET(Y(0))
+15 IF DGBTSP("PRE-AUTHORIZED")="YES"
KILL DGBTSP("AUTHORIZED")
SET DGBTSP("AUTHORIZED")="YES"
DO CLRLTR^DGBTDLT(0)
+16 IF '+Y
Begin DoDot:1
+17 SET AUTHORIZED=$$GET1^DIQ(392,DGBTDT,85)
+18 SET DIR("A")="IS AUTHORIZATION APPROVED"
+19 SET DIR("?")="Sorry, enter 'N'o if Claim not Authorized, 'Y'es if Claim is Authorized"
SET DIR(0)="Y"
+20 SET DIR(0)="Y"
+21 SET DIR("B")=$SELECT($GET(AUTHORIZED)'="":$GET(AUTHORIZED),1:$SELECT($GET(DGBTSP("AUTHORIZED"))=1:"YES",1:"NO"))
+22 DO ^DIR
KILL DIR
if +Y
SET SPCOMPLETE=1
IF ($DATA(DTOUT))!($DATA(DUOUT))
QUIT
+23 SET DGBTSP("AUTHORIZED")=+Y
+24 SET DGBTSP("AUTHORIZED")=$GET(Y(0))
+25 IF Y(0)="NO"
Begin DoDot:2
+26 IF $GET(DGBTAPPTYP)
WRITE !!,"CLAIM HAS BEEN DENIED AND DENIAL OF BENEFITS LETTER HAS ALREADY BEEN ISSUED"
+27 IF '$GET(DGBTAPPTYP)
WRITE !!,"CLAIM HAS BEEN DENIED AND DENIAL OF BENEFITS LETTER WILL BE ISSUED"
+28 IF '$GET(DGBTAPPTYP)
DO DGBTDR^DGBTDLT
if SPCOMPLETE=0
QUIT
+29 WRITE !!,"PLEASE COMPLETE THE INVOICE INFORMATION."
HANG 1
+30 SET SPCOMPLETE=1
End DoDot:2
QUIT
End DoDot:1
IF ($DATA(DTOUT))!($DATA(DUOUT))!(SPCOMPLETE=0)
SET DGBTSP=0
QUIT
+31 IF '$GET(DGBTAPPTYP)
DO CLRLTR^DGBTDLT(0)
+32 SET SPCOMPLETE=1
+33 QUIT
+34 ;
VENDOR(DGBTSP) ;allows the user to select from a vendor already in the FMS system
+1 ;
+2 WRITE !
+3 if $GET(DFN)=""!($GET(DGBTSP)=0)
QUIT
+4 SET VENDOR=$$GET1^DIQ(392,DGBTDT,71,"E")
+5 SET DIR("A")="SELECT VENDOR: "
+6 SET DIR("?")="Select a Vendor from the list only"
+7 SET DIR(0)="PA^440:EMZ"
+8 SET VENDOR=$SELECT($GET(VENDOR)'="":VENDOR,$GET(DGBTSP("VENDOR"))'="":$GET(DGBTSP("VENDOR")),1:"")
+9 IF VENDOR'=""
SET DIR("B")=$SELECT($GET(VENDOR)'="":VENDOR,1:$GET(DGBTSP("VENDOR")))
+10 DO ^DIR
KILL DIR
if $DATA(^DGBT(392,DGBTDTI,"SP"))
SET SPCOMPLETE=1
IF ($DATA(DTOUT))!($DATA(DUOUT))
KILL DGBTSP
SET DGBTSP=0
SET SPCOMPLETE=0
QUIT
+11 ;dbe patch DGBT*1*22 - modified to use vendor ien
SET DGBTSP("VENDOR")=$PIECE($GET(Y),"^",1)
+12 ;
+13 QUIT
+14 ;
ADDINFO(DGBTSP) ;this will ask additional questions of the end user about the invoice presented by the patient.
+1 ;
+2 if $GET(DFN)=""!($GET(DGBTSP)=0)
QUIT
+3 NEW I
+4 DO INST(.DGBTINST)
+5 ;
+6 ;address information
+7 SET DIR("A")="PLACE OF DEPARTURE [LINE 1]"
+8 SET DIR("?")="ENTER "_"PLACE OF DEPARTURE [LINE 1]. 1 TO 30 CHARACTERS"
+9 SET DIR(0)="FO^1:30"
+10 SET DEPL1=$$GET1^DIQ(392,DGBTDTI,73)
+11 ;*39 - updated to use residential address
SET DIR("B")=$SELECT($GET(DEPL1)'="":$GET(DEPL1),1:$GET(DGBTADDR(1)))
+12 DO ^DIR
KILL DIR
if $DATA(^DGBT(392,DGBTDTI,"SP"))
SET SPCOMPLETE=1
IF $DATA(DTOUT)!($DATA(DUOUT))
SET DGBTSP=0
SET SPCOMPLETE=0
QUIT
+13 SET DGBTSP("PLACE OF DEPARTURE")=Y
+14 ;
+15 SET DIR("A")="PLACE OF DEPARTURE [LINE 2]"
+16 SET DIR("?")="ENTER "_"PLACE OF DEPARTURE [LINE 2]. 1 TO 30 CHARACTERS"
+17 SET DIR(0)="FO^1:30"
+18 SET DEPL2=$$GET1^DIQ(392,DGBTDTI,74)
+19 ;*39 - updated to use residential address
SET DIR("B")=$SELECT($GET(DEPL2)'="":$GET(DEPL2),1:$GET(DGBTADDR(2)))
+20 IF $GET(DIR("B"))=""
KILL DIR("B")
+21 DO ^DIR
KILL DIR
if $DATA(^DGBT(392,DGBTDTI,"SP"))
SET SPCOMPLETE=1
IF $DATA(DTOUT)!($DATA(DUOUT))
SET DGBTSP=0
SET SPCOMPLETE=0
QUIT
+22 SET DGBTSP("PLACE OF DEPARTURE 2")=Y
+23 ;
+24 SET DIR("A")="CITY OF DEPARTURE"
+25 SET DIR("?")="ENTER "_"CITY OF DEPARTURE. 3 TO 30 CHARACTERS"
+26 SET DIR(0)="FO^3:30"
+27 SET DEPCITY=$$GET1^DIQ(392,DGBTDTI,75)
+28 ;*39 - updated to use residential address
SET DIR("B")=$SELECT($GET(DEPCITY)'="":$GET(DEPCITY),1:$GET(DGBTADDR(4)))
+29 DO ^DIR
KILL DIR
if $DATA(^DGBT(392,DGBTDTI,"SP"))
SET SPCOMPLETE=1
IF $DATA(DTOUT)!($DATA(DUOUT))
SET DGBTSP=0
SET SPCOMPLETE=0
QUIT
+30 SET DGBTSP("CITY OF DEPARTURE")=Y
+31 ;
+32 SET DIR("A")="STATE OF DEPARTURE"
+33 SET DIR("?")="ENTER "_"STATE OF DEPARTURE"
+34 SET DIR(0)="P^5:EMZ"
+35 SET DEPST=$$GET1^DIQ(392,DGBTDTI,76)
+36 ;*39 - updated to use residential address
SET DIR("B")=$SELECT($GET(DEPST)'="":$GET(DEPST),1:$PIECE($GET(DGBTADDR(5)),"^",2))
+37 DO ^DIR
KILL DIR
if $DATA(^DGBT(392,DGBTDTI,"SP"))
SET SPCOMPLETE=1
IF $DATA(DTOUT)!($DATA(DUOUT))
SET DGBTSP=0
SET SPCOMPLETE=0
QUIT
+38 SET DGBTSP("STATE OF DEPARTURE")=$PIECE(Y,"^",2)
+39 ;
+40 SET DIR("A")="ZIP CODE/DEPARTURE"
+41 SET DIR("?")="ENTER "_"ZIP CODE/DEPARTURE (5 NUMBERS)"
+42 ;$S(I="STATE OF DEPATURE":"P^5:EMZ",1:"FO^3:30")
SET DIR(0)="FO^5:5"
+43 SET DEPZIP=$$GET1^DIQ(392,DGBTDTI,77)
+44 ;*39 - updated to use residential address
SET DIR("B")=$SELECT($GET(DEPZIP)'="":$GET(DEPZIP),1:$EXTRACT($PIECE(DGBTADDR(6),U),1,5))
+45 DO ^DIR
KILL DIR
if $DATA(^DGBT(392,DGBTDTI,"SP"))
SET SPCOMPLETE=1
IF $DATA(DTOUT)!($DATA(DUOUT))
SET DGBTSP=0
SET SPCOMPLETE=0
QUIT
+46 SET DGBTSP("ZIP CODE/DEPARTURE")=Y
+47 ;
+48 if $GET(DGBTSP)=0
QUIT
+49 ;
+50 ;destination information
+51 WRITE !
+52 ;
+53 SET DIR("A")="DESTINATION [LINE 1]"
+54 SET DIR("?")="ENTER "_"DESTINATION [LINE 1]. 1 TO 30 CHARACTERS"
+55 SET DIR(0)="FO^1:30"
+56 SET DISTL1=$$GET1^DIQ(392,DGBTDTI,78)
+57 SET DIR("B")=$SELECT($GET(DISTL1)'="":DISTL1,1:DGBTINST("DIVISION"))
+58 DO ^DIR
KILL DIR
if $DATA(^DGBT(392,DGBTDTI,"SP"))
SET SPCOMPLETE=1
IF $DATA(DTOUT)!($DATA(DUOUT))
SET DGBTSP=0
SET SPCOMPLETE=0
QUIT
+59 SET DGBTINST("DIVISION")=Y
+60 ;
+61 SET DIR("A")="DESTINATION [LINE 2]"
+62 SET DIR("?")="ENTER "_"DESTINATION [LINE 2]. 1 TO 30 CHARACTERS"
+63 SET DIR(0)="FO^1:30"
+64 SET DISTL2=$$GET1^DIQ(392,DGBTDTI,79)
+65 SET DIR("B")=$SELECT($GET(DISTL2)'="":DISTL2,1:DGBTINST("INST NAME"))
+66 IF $GET(DIR("B"))=""
KILL DIR("B")
+67 DO ^DIR
KILL DIR
if $DATA(^DGBT(392,DGBTDTI,"SP"))
SET SPCOMPLETE=1
IF $DATA(DTOUT)!($DATA(DUOUT))
SET DGBTSP=0
SET SPCOMPLETE=0
QUIT
+68 SET DGBTINST("INST NAME")=Y
+69 ;
+70 SET DIR("A")="DESTINATION [LINE 3]"
+71 SET DIR("?")="ENTER "_"DESTINATION [LINE 3]. 1 TO 30 CHARACTERS"
+72 SET DIR(0)="FO^1:30"
+73 SET DISTL1=$$GET1^DIQ(392,DGBTDTI,80)
+74 SET DIR("B")=$SELECT($GET(DISTL1)'="":DISTL1,1:DGBTINST("ADDRESS1"))
+75 DO ^DIR
KILL DIR
if $DATA(^DGBT(392,DGBTDTI,"SP"))
SET SPCOMPLETE=1
IF $DATA(DTOUT)!($DATA(DUOUT))
SET DGBTSP=0
SET SPCOMPLETE=0
QUIT
+76 SET DGBTINST("ADDRESS1")=Y
+77 ;
+78 SET DIR("A")="CITY"
+79 SET DIR("?")="ENTER "_"CITY OF DESTINATION. 3 TO 30 CHARACTERS"
+80 SET DIR(0)="FO^3:30"
+81 SET DISTCITY=$$GET1^DIQ(392,DGBTDTI,81)
+82 SET DIR("B")=$SELECT($GET(DISTCITY)'="":DISTCITY,1:DGBTINST("CITY"))
+83 DO ^DIR
KILL DIR
if $DATA(^DGBT(392,DGBTDTI,"SP"))
SET SPCOMPLETE=1
IF $DATA(DTOUT)!($DATA(DUOUT))
SET DGBTSP=0
SET SPCOMPLETE=0
QUIT
+84 SET DGBTINST("CITY")=Y
+85 ;
+86 SET DIR("A")="STATE OF DESTINATION"
+87 SET DIR("?")="ENTER "_"STATE OF DESTINATION"
+88 SET DIR(0)="PO^5:EMZ"
+89 SET DISTST=$$GET1^DIQ(392,DGBTDTI,82)
+90 SET DIR("B")=$SELECT($GET(DISTST)'="":DISTST,1:DGBTINST("STATE"))
+91 DO ^DIR
KILL DIR
if $DATA(^DGBT(392,DGBTDTI,"SP"))
SET SPCOMPLETE=1
IF $DATA(DTOUT)!($DATA(DUOUT))
SET DGBTSP=0
SET SPCOMPLETE=0
QUIT
+92 SET DGBTINST("STATE")=$PIECE(Y,"^",2)
+93 ;
+94 SET DIR("A")="ZIP CODE/DESTINATION"
+95 SET DIR("?")="ENTER "_"ZIP CODE/DESTINATION (5 NUMBERS)"
+96 SET DIR(0)="FO^5:5"
+97 SET DISTZIP=$$GET1^DIQ(392,DGBTDTI,83)
+98 SET DIR("B")=$SELECT($GET(DISTZIP)'="":DISTZIP,1:DGBTINST("ZIP CODE"))
+99 DO ^DIR
KILL DIR
if $DATA(^DGBT(392,DGBTDTI,"SP"))
SET SPCOMPLETE=1
IF $DATA(DTOUT)!($DATA(DUOUT))
SET DGBTSP=0
SET SPCOMPLETE=0
QUIT
+100 SET DGBTINST("ZIP CODE")=Y
+101 ;
+102 if $GET(DGBTSP)=0
QUIT
+103 ;invoice information
+104 WRITE !
+105 SET INVOICE=$$GET1^DIQ(392,DGBTDT,58,"I")
+106 SET DIR("A")="INVOICE NUMBER: "
+107 SET DIR("?")="Enter Special Mode invoice number. Should be min 1 max of 30."
+108 SET DIR(0)="FA^1:30"
+109 SET INVOICE=$SELECT($GET(INVOICE)'="":INVOICE,$GET(DGBTSP("INVOICE NUMBER"))'="":$GET(DGBTSP("INVOICE NUMBER")),1:"")
+110 IF INVOICE'=""
SET DIR("B")=$SELECT($GET(INVOICE)'="":INVOICE,1:$GET(DGBTSP("INVOICE NUMBER")))
+111 DO ^DIR
KILL DIR
if $DATA(^DGBT(392,DGBTDTI,"SP"))
SET SPCOMPLETE=1
IF ($DATA(DTOUT))!($DATA(DUOUT))
KILL DGBTSP
SET DGBTSP=0
SET SPCOMPLETE=0
QUIT
+112 SET DGBTSP("INVOICE NUMBER")=Y
+113 ;
+114 WRITE !
+115 SET INVDT=$$GET1^DIQ(392,DGBTDT,59,"E")
+116 SET DIR("A")="INVOICE DATE: "
+117 SET DIR("?")="^D HELP1^DGBTE1A"
+118 SET DIR(0)="DAO^3000101:DT+1:EX"
+119 IF INVDT'=""
SET DIR("B")=$SELECT($GET(INVDT)'="":$GET(INVDT),$GET(DGBTSP("DT INVOICE REC")):$GET(DGBTSP("INVOICE NUMBER")),1:DGBTDTE)
+120 DO ^DIR
KILL DIR
if $DATA(^DGBT(392,DGBTDTI,"SP"))
SET SPCOMPLETE=1
IF ($DATA(DTOUT))!($DATA(DUOUT))
KILL DGBTSP
SET DGBTSP=0
SET SPCOMPLETE=0
QUIT
+121 SET DGBTSP("DT INVOICE REC")=$GET(Y(0))
+122 ;
+123 WRITE !
+124 SET OWRTP=$$GET1^DIQ(392,DGBTDT,67,"E")
+125 SET DIR("A")="ONE WAY/ROUND TRIP:"
+126 SET DIR("?")="Enter 'R' for Round Trip or 'O' for One Way Trip ."
+127 SET DIR(0)="SA^R:ROUND TRIP;O:ONE WAY TRIP"
+128 SET OWRTP=$SELECT($GET(OWRTP)'="":OWRTP,$GET(DGBTSP("RT/ONE WAY")):$GET(DGBTSP("RT/ONE WAY")),1:"")
+129 IF OWRTP'=""
SET DIR("B")=$SELECT($GET(OWRTP)'="":OWRTP,1:$GET(DGBTSP("RT/ONE WAY")))
+130 DO ^DIR
KILL DIR
if $DATA(^DGBT(392,DGBTDTI,"SP"))
SET SPCOMPLETE=1
IF ($DATA(DTOUT))!($DATA(DUOUT))
KILL DGBTSP
SET DGBTSP=0
SET SPCOMPLETE=0
QUIT
+131 SET DGBTSP("RT/ONE WAY")=Y
+132 ;
+133 WRITE !
+134 SET TOTALMILES=$$GET1^DIQ(392,DGBTDT,68,"E")
+135 SET DIR("A")="TOTAL MILES: "
+136 ;dbe patch DGBT*1*25
SET DIR("?")="Type a Number between 1 and 10000, 0 Decimal Digits"
+137 ;dbe patch DGBT*1*25 - reduced mileage maximum to 10,000 from 99,999
SET DIR(0)="NA^1:10000:0"
+138 SET TOTALMILES=$SELECT($GET(TOTALMILES)'="":TOTALMILES,$GET(DGBTSP("TOTAL MILES")):$GET(DGBTSP("TOTAL MILES")),1:"")
+139 IF TOTALMILES'=""
SET DIR("B")=$SELECT($GET(TOTALMILES)'="":TOTALMILES,1:$GET(DGBTSP("TOTAL MILES")))
+140 DO ^DIR
KILL DIR
if $DATA(^DGBT(392,DGBTDTI,"SP"))
SET SPCOMPLETE=1
IF ($DATA(DTOUT))!($DATA(DUOUT))
KILL DGBTSP
SET DGBTSP=0
SET SPCOMPLETE=0
QUIT
+141 SET DGBTSP("TOTAL MILES")=Y
+142 ;
+143 FOR I=1:1
if I>1&($GET(DGBTSP("TOTAL INVOICE"))'="")&($GET(DGBTSP("TOTAL INVOICE"))=$GET(DGBTINTO))
QUIT
DO INVAMT^DGBTSP1
if $GET(DGBTSP)=0
QUIT
IF ($GET(DGBTSP("TOTAL INVOICE"))'="")&($GET(DGBTSP("TOTAL INVOICE"))'=$GET(DGBTINTO))
Begin DoDot:1
+144 WRITE !!,"TOTAL INVOICE DOES NOT EQUAL THE SUM OF THE COMPONENT FEES."
+145 WRITE !,"YOU MUST CORRECT THE CLAIM BEFORE CONTINUING",!
End DoDot:1
+146 ;
+147 if DGBTSP=0
QUIT
+148 ;
+149 WRITE !
+150 SET REMARKS=$$GET1^DIQ(392,DGBTDT,72,"E")
+151 SET DIR("A")="REMARKS: "
+152 SET DIR("?")="Enter other information about the Special Mode of Transportation Invoice. 3-50 characters."
+153 SET DIR(0)="FOA^3:50"
+154 IF REMARKS'=""
SET DIR("B")=$SELECT($GET(REMARKS)'="":REMARKS,1:$GET(DGBTSP("SP MODE OTHER REMARKS")))
+155 DO ^DIR
KILL DIR
if $DATA(^DGBT(392,DGBTDTI,"SP"))
SET SPCOMPLETE=1
IF ($DATA(DTOUT))!($DATA(DUOUT))
KILL DGBTSP
SET DGBTSP=0
SET SPCOMPLETE=0
QUIT
+156 SET DGBTSP("SP MODE OTHER REMARKS")=Y
+157 ;
+158 QUIT
+159 ;
INST(DGBTINST) ;get destination information
+1 ;
+2 NEW FAC,ERROR,FIELDS,TEMP
+3 SET DGBTINST("DIVISION")=$$GET1^DIQ(40.8,DGBTDIVI,.01)
+4 SET DGBTINST("INST NAME")=$$GET1^DIQ(4,DGBTDIVN,.01)
+5 SET DGBTINST("ADDRESS1")=$$GET1^DIQ(4,DGBTDIVN,1.01)
+6 SET DGBTINST("CITY")=$$GET1^DIQ(4,DGBTDIVN,1.03)
+7 SET DGBTINST("STATE")=$$GET1^DIQ(4,DGBTDIVN,.02)
+8 SET DGBTINST("ZIP CODE")=$EXTRACT($$GET1^DIQ(4,DGBTDIVN,1.04),1,5)
+9 ;
+10 QUIT
+11 ;
CLEANUP ;this will clean up the ^DGBT(392,D0) file for nodes "M","D","T" and the 3 and 4 piece of the "A" node
+1 ;
+2 if $GET(DGBTDTI)=""
QUIT
+3 FOR I="M","D","B","C","T"
IF $DATA(DGBTDTI)
KILL ^DGBT(392,DGBTDTI,I)
+4 ;F I=8,9,10 S $P(^DGBT(392,DGBTDTI,0),"^",I)=""
+5 SET DGBTDL("ISSUED")=$SELECT($GET(DGBTDL("ISSUED"))'="":$GET(DGBTDL("ISSUED")),1:"")
+6 SET DGBTDL("ISSUED DATE")=$SELECT($GET(DGBTDL("ISSUED DATE"))'="":$GET(DGBTDL("ISSUED DATE")),1:"")
+7 SET DGBTDL("CLAIM DENIED")=$SELECT($GET(DGBTDL("CLAIM DENIED"))'="":$GET(DGBTDL("CLAIM DENIED")),1:"NO")
+8 SET DGBTDL("DT DENIED")=$SELECT($GET(DGBTDL("DT DENIED"))'="":$GET(DGBTDL("DT DENIED")),1:"")
+9 SET DGBTDL("DENIED REASON")=$SELECT($GET(DGBTDL("DENIED REASON"))'="":$GET(DGBTDL("DENIED REASON")),1:"")
+10 ;
+11 SET DGBTFDA(392,DGBTDTI_",",45)=$GET(DGBTDL("ISSUED"))
+12 SET DGBTFDA(392,DGBTDTI_",",45.1)=$GET(DGBTDL("ISSUED DATE"))
+13 SET DGBTFDA(392,DGBTDTI_",",45.2)=$GET(DGBTDL("CLAIM DENIED"))
+14 SET DGBTFDA(392,DGBTDTI_",",45.3)=$GET(DGBTDL("DT DENIED"))
+15 SET DGBTFDA(392,DGBTDTI_",",45.4)=$GET(DGBTDL("DENIED REASON"))
+16 SET DGBTFDA(392,DGBTDTI_",",8)=""
+17 SET DGBTFDA(392,DGBTDTI_",",9)=""
+18 SET DGBTFDA(392,DGBTDTI_",",10)=""
+19 DO FILE^DIE("EKTS","DGBTFDA","ERRMSG")
KILL DGBTFDA
+20 QUIT
+21 ;
ACTFILE ;
+1 KILL DIR
+2 IF 'ACCT
Begin DoDot:1
+3 WRITE !!
+4 SET MYHELP("DIHELP",1)="Beneficiary Travel Account file (#392.3) is not set up correctly."
+5 SET MYHELP("DIHELP",2)="Please see User Manual for proper setup."
+6 DO MSG^DIALOG("WSH","","","","MYHELP")
+7 WRITE !!
+8 SET DIR(0)="E"
+9 DO ^DIR
+10 SET DGBTTOUT=-1
End DoDot:1
QUIT
+11 QUIT
