- 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 Feb 18, 2025@23:07:29 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