DGBTDLT ;UNK/BLD - BENEFICIARY TRAVEL DENIAL LETTER TEMPLATES ; 1/8/24 12:36pm
;;1.0;Beneficiary Travel;**20,33,41**;March 4, 2012;Build 7
;
EN ;entry point for denial letter templates.
;
Q ;DGBT*1*41 Remove functionality
N IEN,CNT,TMP,DGBTINST,COUNTER,DGBTDIVI,DGBTDIVN,QUIT,DGIEN,DGIEN2,DGBTLTR
;
K ^TMP("DGBTDLT",$J)
S QUIT=0
;
W @IOF
S QUIT=0
F D Q:$G(QUIT)
.D MENU(.DGIEN) Q:$G(QUIT) ;this will allow the user to choose which letter to edit.
.D EDIT ;this will bring of the screen editor for denial letter(s)
;
Q
;
;
S DIR("A")="SELECT TEMPLATE TYPE"
S DIR("L",1)="CHOOSE FROM:"
S DIR("L",2)="MILEAGE DENIAL TEMPLATE"
S DIR("L",3)="SPECIAL MODE DENIAL TEMPLATE"
S DIR("?")="ENTER EITHER 'M' FOR MILEAGE DENIAL TEMPLATE OR 'S' FOR SPECIAL MODE DENIAL TEMPLATE"
S DIR(0)="S^M:MILEAGE DENIAL TEMPLATE;S:SPECIAL MODE DENIAL TEMPLATE"
D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S QUIT=1 Q
S DGBTLTR("LETTER TYPE")=$P(Y,",",1)
;
I DGBTLTR("LETTER TYPE")="M" D Q
.S DIR("A")="SELECT WHICH MILEAGE LETTER"
.S DIR("L",1)="CHOOSE FROM: "
.S DIR("L",2)="MILEAGE TEMPLATE PART 1"
.S DIR("L",3)="MILEAGE TEMPLATE PART 2"
.S DIR("?")="PART 1 IS THE TOP HALF OF THE LETTER BEFORE DENIAL REASON. AND PART 2 IS THE BOTTOM HALF OF THE LETTER AFTER THE DENIAL REASON"
.S DIR(0)="S^1:MILEAGE TEMPLATE 1;2:MILEAGE TEMPLATE 2"
.D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S QUIT=1 Q
.S DGIEN=+Y
;
I DGBTLTR("LETTER TYPE")="S" D
.S DIR("A")="SELECT WHICH SPECIAL MODE LETTER"
.S DIR("L",1)="CHOOSE FROM: "
.S DIR("L",2)="SPECIAL MODE TEMPLATE PART 1"
.S DIR("L",3)="SPECIAL MODE TEMPLATE PART 2"
.S DIR("?")="PART 1 IS THE TOP HALF OF THE LETTER BEFORE DENIAL REASON. AND PART 2 IS THE BOTTOM HALF OF THE LETTER AFTER THE DENIAL REASON"
.S DIR(0)="S^1:SPECIAL MODE TEMPLATE 1;2:SPECIAL MODE TEMPLATE 2"
.D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S QUIT=1 Q
.S DGIEN=$S(+Y=1:3,1:4)
;
Q
;
SETUP(DGIEN) ;this will set up ^TMP global for editing
S CNT=0,COUNTER=0
F S CNT=$O(^DGBT(392.6,DGIEN,1,CNT)) Q:'CNT D
.S COUNTER=COUNTER+1
.S ^TMP("DGBTDLT",$J,COUNTER)=^DGBT(392.6,DGIEN,1,CNT,0)
Q
;
EDIT ;this will invoke the screen editor
;
K ^TMP($J,"DGBTDLT"),DWPK,DIC,DIWESUB,DIWETXT
S DWPK=1
S DGIEN2=$S(DGIEN=3!(DGIEN=4):3,1:1)
S DIC="^DGBT(392.6,DGIEN,DGIEN2,"
S DIWESUB="MILEAGE DENIAL LETTER"
S DIWETXT="MILEAGE DENIAL LETTER TEMPLATE PART "_DGIEN
D EN^DIWE
Q
;
;************************************************************************************************************
; THIS WILL PRINT DENIAL LETTERS
;************************************************************************************************************
;
DGBTDR ;will ask for the denial reason
;
N DRIEN,REASON,LETTERS1,LETTERS2,LINENBR,NBR,DGBTDNLTR,DGBTFDA,DGBTSCR,DGBTDR,DGBTISSUED,VADM,PATSEX,PATADD1,PATADD2,PATCITY,PATST,PATZIP,PATNAME
W !
K ^UTILITY($J,"W")
S QUIT=0
;
S SPCOMPLETE=1
;
S DGBTDL("ISSUED")=$$GET1^DIQ(392,DGBTDTI,45,"I")
S DGBTDL("ISSUED DATE")=$$GET1^DIQ(392,DGBTDTI,45.1)
S DGBTDL("CLAIM DENIED")=$$GET1^DIQ(392,DGBTDTI,45.2)
S DGBTDL("DT DENIED")=$$GET1^DIQ(392,DGBTDTI,45.3)
S DGBTDL("DENIED REASON")=$$GET1^DIQ(392,DGBTDTI,45.4)
;
K Y
F D Q:+Y>0!($G(DGBTTOUT)=-1)
.K X,DGBTTOUT S X=""
.S DIC("B")=$$GET1^DIQ(392,DGBTDT,45.4),DIC("A")="Select Denial Reason: "
.S DIC="^DGBT(392.8,",DIC(0)="AEQMZ"
.I DGBTCMTY="M" S DIC("S")="I $P(^(0),1)'[""MEDICAL REVIEW"""
.D ^DIC K DIC I $D(DTOUT)!($D(DUOUT)) S DGBTTOUT=-1,SPCOMPLETE=0 K DTOUT,DUOUT Q
.I Y<0 W !!,"Denial Reason Required. '^' to exit.",! Q
Q:Y<0!($G(DGBTTOUT)=-1)
S DRIEN=+Y
S DGBTDL("DENIED REASON")=$$GET1^DIQ(392.8,DRIEN,.01)
S DGBTDL("CLAIM DENIED")="YES"
S DGBTDL("DT DENIED")=$S(DGBTDL("DT DENIED")="":$$FMTE^XLFDT(DT),1:DGBTDL("DT DENIED"))
;
;
S DIR("B")=$$GET1^DIQ(392,DGBTDT,45)
S DIR(0)="Y^A",DIR("A")="ISSUE DENIAL OF BENEFITS LETTER"
S DIR("?")="ENTER 'YES' OR 'NO'"
D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S DGBTTOUT=-1,SPCOMPLETE=0 K DTOUT,DUOUT Q
;
I +Y=1 S DGBTDL("ISSUED DATE")=$S(DGBTDL("ISSUED DATE")="":$$FMTE^XLFDT(DT),1:DGBTDL("ISSUED DATE")),DGBTDL("ISSUED")="YES"
I +Y'=1 S DGBTDL("ISSUED")="NO" D CLRLTR(1) S QUIT=1 S:$G(DGBTISSUED)=-1 DGBTTOUT=$G(DGBTISSUED),SPCOMPLETE=0 Q
;
S DGBTDNLTR=DGBTDL("ISSUED")
;
W !!
;
W @IOF
S DGBTFDA(392,DGBTDTI_",",45)=DGBTDNLTR
S DGBTFDA(392,DGBTDTI_",",45.1)=$S(DGBTDL("ISSUED DATE")'="":DGBTDL("ISSUED DATE"),1:$$FMTE^XLFDT(DT))
S DGBTFDA(392,DGBTDTI_",",45.2)=1
S DGBTFDA(392,DGBTDTI_",",45.3)=$S(DGBTDL("DT DENIED")'="":DGBTDL("DT DENIED"),1:$$FMTE^XLFDT(DT))
S DGBTFDA(392,DGBTDTI_",",45.4)=$S(DGBTDL("DENIED REASON")'="":DGBTDL("DENIED REASON"),1:$$GET1^DIQ(392.8,DRIEN,.01)) ;Y(0)
K ERRMSG D FILE^DIE("EKTS","DGBTFDA","ERRMSG") K DGBTFDA
I $$GET1^DIQ(392.8,DRIEN,1,,"REASON")
D DEVICE("DENIAL LETTER","LTR^DGBTDLT") I $D(DTOUT)!($D(DUOUT))!($G(SPCOMPLETE)=0) S QUIT=1,DGBTTOUT=-1 Q
I $G(DGBTQ) Q
D LTR
Q
;
LTR ;
;
N NAME,DGBTCDT,DIWL,DIWR
K ^UTILITY($J,"W")
D DIVISN(.DGBTINST) ;this will set up the DGBTINST array containing the current VA location address
D HEADER(.DGBTINST) ;this will print the current VA location information
S QUIT=1
S DIWL=5 ;left margin
S DIWR=75 ;right margin
S DGBTCDT(1)=$P(DGBTDTE,"@",1) ;date entered into file
S NAME=$$GET1^DIQ(200,DUZ,.01),DGBTCDT(2)=$P(NAME,",",2)_" "_$P(NAME,",",1) ;user name
S DGBTCDT(3)=$$GET1^DIQ(200,DUZ,8) ;user title
;
I DGBTCMTY="M" D ;for mileage claims
.I $$GET1^DIQ(392.6,1,1,,"LETTERS1")
.S LINENBR=0
.F S LINENBR=$O(LETTERS1(LINENBR)) Q:'LINENBR D D ^DIWP
..S X=LETTERS1(LINENBR)
.S NBR=0
.F S NBR=$O(REASON(NBR)) Q:'NBR D D ^DIWP
..S X=REASON(NBR)
.I $$GET1^DIQ(392.6,2,1,,"LETTERS2")
.F S LINENBR=$O(LETTERS2(LINENBR)) Q:'LINENBR D D ^DIWP
..S X=LETTERS2(LINENBR) Q:X=""
.D ^DIWW
;
K LETTERS1,LETTERS2
I DGBTCMTY="S" D ;for Special Mode Claims
.I $$GET1^DIQ(392.6,3,3,,"LETTERS1")
.S LINENBR=0
.F S LINENBR=$O(LETTERS1(LINENBR)) Q:'LINENBR D D ^DIWP
..S X=LETTERS1(LINENBR)
.S NBR=0
.F S NBR=$O(REASON(NBR)) Q:'NBR D D ^DIWP
..S X=REASON(NBR)
.I $$GET1^DIQ(392.6,4,3,,"LETTERS2")
.F S LINENBR=$O(LETTERS2(LINENBR)) Q:'LINENBR D D ^DIWP
..S X=LETTERS2(LINENBR) Q:X=""
.D ^DIWW
.S SPCOMPLETE=1
D:'IOST'["C-" ^%ZISC
Q
;
;
I $G(DGBTINST("ORG NAME"))="" D Q
.W !!,"INSTITUTION INFORMATION IS UNAVAILABLE. PLEASE UPDATE USING THE INSTITUTION FILE ENTER/EDIT."
N ORG,ADD1,ADD2,CITY,STATE,ZIP,INSTNAME,LOC,LOC2,DGBTDTFILED
;
S ORG=DGBTINST("ORG NAME")
S INSTNAME=DGBTINST("INST NAME")
S ADD1=DGBTINST("INST ADDRESS 1")
S ADD2=DGBTINST("INST ADDRESS 2")
S CITY=DGBTINST("INST CITY")
S STATE=DGBTINST("INST STATE")
S ZIP=DGBTINST("INST ZIP CODE")
;
D DEM^VADPT
S PATSEX=$P(VADM(5),"^",1),PATSEX=$S(PATSEX="M":"Mr",1:"Ms")_". "
S PATADD1=VAPA(1),PATADD2=VAPA(2)
S PATCITY=VAPA(4)_", ",PATST=$P(VAPA(5),"^",2)_" ",PATZIP=VAPA(6)
S PATNAME=VADM(1),PATNAME=$P(PATNAME,",",2)_" "_$P(PATNAME,",",1)
;
S LOC2=5
S LOC=80-$L(ORG) W !,?LOC/2,ORG
S LOC=80-$L(INSTNAME) W !,?LOC/2,INSTNAME
S LOC=80-$L(ADD1) W !,?LOC/2,ADD1
I $G(ADD2)'="" S LOC=80-$L(ADD2) W !,?LOC/2,ADD2
S CITYSTZIP=CITY_", "_STATE_" "_ZIP
S LOC=80-$L(CITYSTZIP) W !,?LOC/2,CITYSTZIP,!
;S LOC=80-$L(DGBTDTE) W !?LOC,$P(DGBTDTE,"@",1)
S DGBTDTFILED=$$GET1^DIQ(392,DGBTDTI,13,"E")
S DGBTDTFILED=$S(DGBTDTFILED'="":DGBTDTFILED,1:DT)
S DGBTDTFILED=$$FMTE^XLFDT(DGBTDTFILED)
S LOC=80-$L(DGBTDTFILED) W !,?LOC,DGBTDTFILED
W !,?LOC,DGBTINST("FAC NUMBER")
W ?LOC,"/"_$S(DGBTINST("MAIL CODE")'="":DGBTINST("MAIL CODE"),1:"BT"),!
W ?LOC,$E(VADM(1),1)_$E($P(VADM(2),"^",1),6,99)
W !,?LOC2,$G(PATSEX),$G(PATNAME)
W !,?LOC2,$G(PATADD1)
W:$G(PATADD2)'="" !,?LOC2,PATADD2
W !,?LOC2,PATCITY,PATST,PATZIP,!!
;
Q
;
PATIENT ; patient lookup, quit if patient doesn't exist
N VAEL
S DGBTOLD=0 ;PAVEL DGBT*1*20
I $D(DGANS) S DGANS="Q" Q ;bld DGTB*1*20
S DGBTTOUT="",DIC="^DPT(",DIC(0)="AEQMZ",DIC("A")="Select PATIENT: "
W !! D ^DIC K DIC I +Y'>0 Q
; get patient information#, call return patient return variables routine and set whether new claim or not
S DFN=+Y D 6^VADPT,PID^VADPT
S DGBTNEW=$S($D(^DGBT(392,"C",DFN)):0,1:1)
S SPCOMPLETE=0
Q
;
DIVISN(DGBTINST) ; if MED CTR DIV file set up (first record) and record does not exist, write warning, kill variables, and exit
I ($G(DGBTDIVI)'="")&($G(DGBTDIV)'="") D INSTIT(.DGBTINST) Q ; RFE DGBT*1.0*20
S DGBTDIVI=$O(^DG(40.8,0)),DGBTDIV=$P(^DG(40.8,DGBTDIVI,0),U) D INSTIT(.DGBTINST)
Q
;
INSTIT(DGBTINST) ; check for pointer to institution file and for address information on institution
N MAILCODE,INSTADD,INSTNODE
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
;
S INSTNODE=^DIC(4,DGBTDIVN,0)
S INSTADD=^DIC(4,DGBTDIVN,1)
;
S DGBTINST("ORG NAME")="DEPARTMENT OF VETERANS AFFAIRS"
S DGBTINST("INST NAME")=$$GET1^DIQ(4,DGBTDIVN,.01)
S DGBTINST("INST ADDRESS 1")=$$GET1^DIQ(4,DGBTDIVN,1.01)
S DGBTINST("INST ADDRESS 2")=$$GET1^DIQ(4,DGBTDIVN,1.02)
S DGBTINST("INST CITY")=$$GET1^DIQ(4,DGBTDIVN,1.03)
S DGBTINST("INST STATE")=$$GET1^DIQ(4,DGBTDIVN,.02)
S DGBTINST("INST ZIP CODE")=$$GET1^DIQ(4,DGBTDIVN,1.04)
S DGBTINST("FAC NUMBER")=$$GET1^DIQ(40.8,DGBTDIVI,1)
S MAILCODE=$O(^DIC(49,"B","BENEFICIARY TRAVEL",""))
S DGBTINST("MAIL CODE")=$$GET1^DIQ(49,MAILCODE,1.5)
Q
;
DEVICE(RPTNAM,ROUTINE) ;common device call for DGBT reports
;
N %ZIS,ZTSK,ZTRTN,ZTIO,ZTDESC,ZTSAVE,POP,ZTQUEUED
; RPTNAM = NAME OF DGBT REPORT BEING RUN
; ROUTINE = "TAG^ROUTINE"
;
S DGBTQ1=0,DGBTQ=0
S %ZIS="PQM"
D ^%ZIS
I POP S DGBTQ=1,SPCOMPLETE=0 Q
I IOST["C-" Q ;
;.N X I IOM=255,$D(^%ZOSF("RM")) X ^%ZOSF("RM")
;Check for exit
;S DGBTQ=1
I $G(IO("Q")) D S DGBTQ=1
.S ZTRTN=ROUTINE
.S ZTDESC="BT REPORT: "_RPTNAM
.S ZTSAVE("*")=""
.D ^%ZTLOAD
.W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
.D HOME^%ZIS K IO("Q")
U IO
Q
;
DEVICE1(DGBTRPT) ;
N %ZIS,ZTSK,ZTRTN,ZTIO,ZTDESC,ZTSAVE,POP
S %ZIS="QPM"
D ^%ZIS
I POP S DGBTQ=1,SPCOMPLETE=0
I IOST'["C-" S DGBTQ=1 Q
;
;Check for exit
I $G(DGBTQ) Q
;
I $D(IO("Q")) D S DGBTQ=1
. S ZTRTN="LTR^DGBTDLT"
. S ZTDESC="DGBT: "_DGBTRPT
.; S ZTIO=ION
. S ZTSAVE("*")=""
. D ^%ZTLOAD
. W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
. D HOME^%ZIS K IO("Q")
;U IO
Q
;
CLRLTR(DENIED) ;
;
N Y,DGBTFDA,%
K ERRMSG
I $G(DGBTDL("ISSUED"))="" S DGBTDL("ISSUED")=$$GET1^DIQ(392,DGBTDTI,45,"I")
I $G(DGBTDL("CLAIM DENIED"))="" S DGBTDL("CLAIM DENIED")=DENIED
I $G(DGBTDL("DT DENIED"))="" S DGBTDL("DT DENIED")=$$GET1^DIQ(392,DGBTDTI,45.3) S:$G(DGBTDL("DT DENIED"))="" DGBTDL("DT DENIED")=$$FMTE^XLFDT(DT)
I $G(DGBTDL("DENIED REASON"))="" S DGBTDL("DENIED REASON")=$$GET1^DIQ(392,DGBTDTI,45.4)
;
S DGBTFDA(392,DGBTDTI_",",45)="" ;$G(DGBTDL("ISSUED"))
S DGBTFDA(392,DGBTDTI_",",45.1)=""
S DGBTFDA(392,DGBTDTI_",",45.2)="" ;$G(DGBTDL("CLAIM DENIED"))
S Y=$$NOW^XLFDT() D DD^%DT
S DGBTFDA(392,DGBTDTI_",",45.3)="" ;$G(DGBTDL("DT DENIED"))
S DGBTFDA(392,DGBTDTI_",",45.4)="" ;$G(DGBTDL("DENIED REASON"))
D FILE^DIE("EKTS","DGBTFDA","ERRMSG") K DGBTFDA
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGBTDLT 12032 printed Sep 23, 2025@19:16:33 Page 2
DGBTDLT ;UNK/BLD - BENEFICIARY TRAVEL DENIAL LETTER TEMPLATES ; 1/8/24 12:36pm
+1 ;;1.0;Beneficiary Travel;**20,33,41**;March 4, 2012;Build 7
+2 ;
EN ;entry point for denial letter templates.
+1 ;
+2 ;DGBT*1*41 Remove functionality
QUIT
+3 NEW IEN,CNT,TMP,DGBTINST,COUNTER,DGBTDIVI,DGBTDIVN,QUIT,DGIEN,DGIEN2,DGBTLTR
+4 ;
+5 KILL ^TMP("DGBTDLT",$JOB)
+6 SET QUIT=0
+7 ;
+8 WRITE @IOF
+9 SET QUIT=0
+10 FOR
Begin DoDot:1
+11 ;this will allow the user to choose which letter to edit.
DO MENU(.DGIEN)
if $GET(QUIT)
QUIT
+12 ;this will bring of the screen editor for denial letter(s)
DO EDIT
End DoDot:1
if $GET(QUIT)
QUIT
+13 ;
+14 QUIT
+15 ;
+1 ;
+2 SET DIR("A")="SELECT TEMPLATE TYPE"
+3 SET DIR("L",1)="CHOOSE FROM:"
+4 SET DIR("L",2)="MILEAGE DENIAL TEMPLATE"
+5 SET DIR("L",3)="SPECIAL MODE DENIAL TEMPLATE"
+6 SET DIR("?")="ENTER EITHER 'M' FOR MILEAGE DENIAL TEMPLATE OR 'S' FOR SPECIAL MODE DENIAL TEMPLATE"
+7 SET DIR(0)="S^M:MILEAGE DENIAL TEMPLATE;S:SPECIAL MODE DENIAL TEMPLATE"
+8 DO ^DIR
KILL DIR
IF $DATA(DTOUT)!($DATA(DUOUT))
SET QUIT=1
QUIT
+9 SET DGBTLTR("LETTER TYPE")=$PIECE(Y,",",1)
+10 ;
+11 IF DGBTLTR("LETTER TYPE")="M"
Begin DoDot:1
+12 SET DIR("A")="SELECT WHICH MILEAGE LETTER"
+13 SET DIR("L",1)="CHOOSE FROM: "
+14 SET DIR("L",2)="MILEAGE TEMPLATE PART 1"
+15 SET DIR("L",3)="MILEAGE TEMPLATE PART 2"
+16 SET DIR("?")="PART 1 IS THE TOP HALF OF THE LETTER BEFORE DENIAL REASON. AND PART 2 IS THE BOTTOM HALF OF THE LETTER AFTER THE DENIAL REASON"
+17 SET DIR(0)="S^1:MILEAGE TEMPLATE 1;2:MILEAGE TEMPLATE 2"
+18 DO ^DIR
KILL DIR
IF $DATA(DTOUT)!($DATA(DUOUT))
SET QUIT=1
QUIT
+19 SET DGIEN=+Y
End DoDot:1
QUIT
+20 ;
+21 IF DGBTLTR("LETTER TYPE")="S"
Begin DoDot:1
+22 SET DIR("A")="SELECT WHICH SPECIAL MODE LETTER"
+23 SET DIR("L",1)="CHOOSE FROM: "
+24 SET DIR("L",2)="SPECIAL MODE TEMPLATE PART 1"
+25 SET DIR("L",3)="SPECIAL MODE TEMPLATE PART 2"
+26 SET DIR("?")="PART 1 IS THE TOP HALF OF THE LETTER BEFORE DENIAL REASON. AND PART 2 IS THE BOTTOM HALF OF THE LETTER AFTER THE DENIAL REASON"
+27 SET DIR(0)="S^1:SPECIAL MODE TEMPLATE 1;2:SPECIAL MODE TEMPLATE 2"
+28 DO ^DIR
KILL DIR
IF $DATA(DTOUT)!($DATA(DUOUT))
SET QUIT=1
QUIT
+29 SET DGIEN=$SELECT(+Y=1:3,1:4)
End DoDot:1
+30 ;
+31 QUIT
+32 ;
SETUP(DGIEN) ;this will set up ^TMP global for editing
+1 SET CNT=0
SET COUNTER=0
+2 FOR
SET CNT=$ORDER(^DGBT(392.6,DGIEN,1,CNT))
if 'CNT
QUIT
Begin DoDot:1
+3 SET COUNTER=COUNTER+1
+4 SET ^TMP("DGBTDLT",$JOB,COUNTER)=^DGBT(392.6,DGIEN,1,CNT,0)
End DoDot:1
+5 QUIT
+6 ;
EDIT ;this will invoke the screen editor
+1 ;
+2 KILL ^TMP($JOB,"DGBTDLT"),DWPK,DIC,DIWESUB,DIWETXT
+3 SET DWPK=1
+4 SET DGIEN2=$SELECT(DGIEN=3!(DGIEN=4):3,1:1)
+5 SET DIC="^DGBT(392.6,DGIEN,DGIEN2,"
+6 SET DIWESUB="MILEAGE DENIAL LETTER"
+7 SET DIWETXT="MILEAGE DENIAL LETTER TEMPLATE PART "_DGIEN
+8 DO EN^DIWE
+9 QUIT
+10 ;
+11 ;************************************************************************************************************
+12 ; THIS WILL PRINT DENIAL LETTERS
+13 ;************************************************************************************************************
+14 ;
DGBTDR ;will ask for the denial reason
+1 ;
+2 NEW DRIEN,REASON,LETTERS1,LETTERS2,LINENBR,NBR,DGBTDNLTR,DGBTFDA,DGBTSCR,DGBTDR,DGBTISSUED,VADM,PATSEX,PATADD1,PATADD2,PATCITY,PATST,PATZIP,PATNAME
+3 WRITE !
+4 KILL ^UTILITY($JOB,"W")
+5 SET QUIT=0
+6 ;
+7 SET SPCOMPLETE=1
+8 ;
+9 SET DGBTDL("ISSUED")=$$GET1^DIQ(392,DGBTDTI,45,"I")
+10 SET DGBTDL("ISSUED DATE")=$$GET1^DIQ(392,DGBTDTI,45.1)
+11 SET DGBTDL("CLAIM DENIED")=$$GET1^DIQ(392,DGBTDTI,45.2)
+12 SET DGBTDL("DT DENIED")=$$GET1^DIQ(392,DGBTDTI,45.3)
+13 SET DGBTDL("DENIED REASON")=$$GET1^DIQ(392,DGBTDTI,45.4)
+14 ;
+15 KILL Y
+16 FOR
Begin DoDot:1
+17 KILL X,DGBTTOUT
SET X=""
+18 SET DIC("B")=$$GET1^DIQ(392,DGBTDT,45.4)
SET DIC("A")="Select Denial Reason: "
+19 SET DIC="^DGBT(392.8,"
SET DIC(0)="AEQMZ"
+20 IF DGBTCMTY="M"
SET DIC("S")="I $P(^(0),1)'[""MEDICAL REVIEW"""
+21 DO ^DIC
KILL DIC
IF $DATA(DTOUT)!($DATA(DUOUT))
SET DGBTTOUT=-1
SET SPCOMPLETE=0
KILL DTOUT,DUOUT
QUIT
+22 IF Y<0
WRITE !!,"Denial Reason Required. '^' to exit.",!
QUIT
End DoDot:1
if +Y>0!($GET(DGBTTOUT)=-1)
QUIT
+23 if Y<0!($GET(DGBTTOUT)=-1)
QUIT
+24 SET DRIEN=+Y
+25 SET DGBTDL("DENIED REASON")=$$GET1^DIQ(392.8,DRIEN,.01)
+26 SET DGBTDL("CLAIM DENIED")="YES"
+27 SET DGBTDL("DT DENIED")=$SELECT(DGBTDL("DT DENIED")="":$$FMTE^XLFDT(DT),1:DGBTDL("DT DENIED"))
+28 ;
+29 ;
+30 SET DIR("B")=$$GET1^DIQ(392,DGBTDT,45)
+31 SET DIR(0)="Y^A"
SET DIR("A")="ISSUE DENIAL OF BENEFITS LETTER"
+32 SET DIR("?")="ENTER 'YES' OR 'NO'"
+33 DO ^DIR
KILL DIR
IF $DATA(DTOUT)!($DATA(DUOUT))
SET DGBTTOUT=-1
SET SPCOMPLETE=0
KILL DTOUT,DUOUT
QUIT
+34 ;
+35 IF +Y=1
SET DGBTDL("ISSUED DATE")=$SELECT(DGBTDL("ISSUED DATE")="":$$FMTE^XLFDT(DT),1:DGBTDL("ISSUED DATE"))
SET DGBTDL("ISSUED")="YES"
+36 IF +Y'=1
SET DGBTDL("ISSUED")="NO"
DO CLRLTR(1)
SET QUIT=1
if $GET(DGBTISSUED)=-1
SET DGBTTOUT=$GET(DGBTISSUED)
SET SPCOMPLETE=0
QUIT
+37 ;
+38 SET DGBTDNLTR=DGBTDL("ISSUED")
+39 ;
+40 WRITE !!
+41 ;
+42 WRITE @IOF
+43 SET DGBTFDA(392,DGBTDTI_",",45)=DGBTDNLTR
+44 SET DGBTFDA(392,DGBTDTI_",",45.1)=$SELECT(DGBTDL("ISSUED DATE")'="":DGBTDL("ISSUED DATE"),1:$$FMTE^XLFDT(DT))
+45 SET DGBTFDA(392,DGBTDTI_",",45.2)=1
+46 SET DGBTFDA(392,DGBTDTI_",",45.3)=$SELECT(DGBTDL("DT DENIED")'="":DGBTDL("DT DENIED"),1:$$FMTE^XLFDT(DT))
+47 ;Y(0)
SET DGBTFDA(392,DGBTDTI_",",45.4)=$SELECT(DGBTDL("DENIED REASON")'="":DGBTDL("DENIED REASON"),1:$$GET1^DIQ(392.8,DRIEN,.01))
+48 KILL ERRMSG
DO FILE^DIE("EKTS","DGBTFDA","ERRMSG")
KILL DGBTFDA
+49 IF $$GET1^DIQ(392.8,DRIEN,1,,"REASON")
+50 DO DEVICE("DENIAL LETTER","LTR^DGBTDLT")
IF $DATA(DTOUT)!($DATA(DUOUT))!($GET(SPCOMPLETE)=0)
SET QUIT=1
SET DGBTTOUT=-1
QUIT
+51 IF $GET(DGBTQ)
QUIT
+52 DO LTR
+53 QUIT
+54 ;
LTR ;
+1 ;
+2 NEW NAME,DGBTCDT,DIWL,DIWR
+3 KILL ^UTILITY($JOB,"W")
+4 ;this will set up the DGBTINST array containing the current VA location address
DO DIVISN(.DGBTINST)
+5 ;this will print the current VA location information
DO HEADER(.DGBTINST)
+6 SET QUIT=1
+7 ;left margin
SET DIWL=5
+8 ;right margin
SET DIWR=75
+9 ;date entered into file
SET DGBTCDT(1)=$PIECE(DGBTDTE,"@",1)
+10 ;user name
SET NAME=$$GET1^DIQ(200,DUZ,.01)
SET DGBTCDT(2)=$PIECE(NAME,",",2)_" "_$PIECE(NAME,",",1)
+11 ;user title
SET DGBTCDT(3)=$$GET1^DIQ(200,DUZ,8)
+12 ;
+13 ;for mileage claims
IF DGBTCMTY="M"
Begin DoDot:1
+14 IF $$GET1^DIQ(392.6,1,1,,"LETTERS1")
+15 SET LINENBR=0
+16 FOR
SET LINENBR=$ORDER(LETTERS1(LINENBR))
if 'LINENBR
QUIT
Begin DoDot:2
+17 SET X=LETTERS1(LINENBR)
End DoDot:2
DO ^DIWP
+18 SET NBR=0
+19 FOR
SET NBR=$ORDER(REASON(NBR))
if 'NBR
QUIT
Begin DoDot:2
+20 SET X=REASON(NBR)
End DoDot:2
DO ^DIWP
+21 IF $$GET1^DIQ(392.6,2,1,,"LETTERS2")
+22 FOR
SET LINENBR=$ORDER(LETTERS2(LINENBR))
if 'LINENBR
QUIT
Begin DoDot:2
+23 SET X=LETTERS2(LINENBR)
if X=""
QUIT
End DoDot:2
DO ^DIWP
+24 DO ^DIWW
End DoDot:1
+25 ;
+26 KILL LETTERS1,LETTERS2
+27 ;for Special Mode Claims
IF DGBTCMTY="S"
Begin DoDot:1
+28 IF $$GET1^DIQ(392.6,3,3,,"LETTERS1")
+29 SET LINENBR=0
+30 FOR
SET LINENBR=$ORDER(LETTERS1(LINENBR))
if 'LINENBR
QUIT
Begin DoDot:2
+31 SET X=LETTERS1(LINENBR)
End DoDot:2
DO ^DIWP
+32 SET NBR=0
+33 FOR
SET NBR=$ORDER(REASON(NBR))
if 'NBR
QUIT
Begin DoDot:2
+34 SET X=REASON(NBR)
End DoDot:2
DO ^DIWP
+35 IF $$GET1^DIQ(392.6,4,3,,"LETTERS2")
+36 FOR
SET LINENBR=$ORDER(LETTERS2(LINENBR))
if 'LINENBR
QUIT
Begin DoDot:2
+37 SET X=LETTERS2(LINENBR)
if X=""
QUIT
End DoDot:2
DO ^DIWP
+38 DO ^DIWW
+39 SET SPCOMPLETE=1
End DoDot:1
+40 if 'IOST'["C-"
DO ^%ZISC
+41 QUIT
+42 ;
+1 ;
+2 IF $GET(DGBTINST("ORG NAME"))=""
Begin DoDot:1
+3 WRITE !!,"INSTITUTION INFORMATION IS UNAVAILABLE. PLEASE UPDATE USING THE INSTITUTION FILE ENTER/EDIT."
End DoDot:1
QUIT
+4 NEW ORG,ADD1,ADD2,CITY,STATE,ZIP,INSTNAME,LOC,LOC2,DGBTDTFILED
+5 ;
+6 SET ORG=DGBTINST("ORG NAME")
+7 SET INSTNAME=DGBTINST("INST NAME")
+8 SET ADD1=DGBTINST("INST ADDRESS 1")
+9 SET ADD2=DGBTINST("INST ADDRESS 2")
+10 SET CITY=DGBTINST("INST CITY")
+11 SET STATE=DGBTINST("INST STATE")
+12 SET ZIP=DGBTINST("INST ZIP CODE")
+13 ;
+14 DO DEM^VADPT
+15 SET PATSEX=$PIECE(VADM(5),"^",1)
SET PATSEX=$SELECT(PATSEX="M":"Mr",1:"Ms")_". "
+16 SET PATADD1=VAPA(1)
SET PATADD2=VAPA(2)
+17 SET PATCITY=VAPA(4)_", "
SET PATST=$PIECE(VAPA(5),"^",2)_" "
SET PATZIP=VAPA(6)
+18 SET PATNAME=VADM(1)
SET PATNAME=$PIECE(PATNAME,",",2)_" "_$PIECE(PATNAME,",",1)
+19 ;
+20 SET LOC2=5
+21 SET LOC=80-$LENGTH(ORG)
WRITE !,?LOC/2,ORG
+22 SET LOC=80-$LENGTH(INSTNAME)
WRITE !,?LOC/2,INSTNAME
+23 SET LOC=80-$LENGTH(ADD1)
WRITE !,?LOC/2,ADD1
+24 IF $GET(ADD2)'=""
SET LOC=80-$LENGTH(ADD2)
WRITE !,?LOC/2,ADD2
+25 SET CITYSTZIP=CITY_", "_STATE_" "_ZIP
+26 SET LOC=80-$LENGTH(CITYSTZIP)
WRITE !,?LOC/2,CITYSTZIP,!
+27 ;S LOC=80-$L(DGBTDTE) W !?LOC,$P(DGBTDTE,"@",1)
+28 SET DGBTDTFILED=$$GET1^DIQ(392,DGBTDTI,13,"E")
+29 SET DGBTDTFILED=$SELECT(DGBTDTFILED'="":DGBTDTFILED,1:DT)
+30 SET DGBTDTFILED=$$FMTE^XLFDT(DGBTDTFILED)
+31 SET LOC=80-$LENGTH(DGBTDTFILED)
WRITE !,?LOC,DGBTDTFILED
+32 WRITE !,?LOC,DGBTINST("FAC NUMBER")
+33 WRITE ?LOC,"/"_$SELECT(DGBTINST("MAIL CODE")'="":DGBTINST("MAIL CODE"),1:"BT"),!
+34 WRITE ?LOC,$EXTRACT(VADM(1),1)_$EXTRACT($PIECE(VADM(2),"^",1),6,99)
+35 WRITE !,?LOC2,$GET(PATSEX),$GET(PATNAME)
+36 WRITE !,?LOC2,$GET(PATADD1)
+37 if $GET(PATADD2)'=""
WRITE !,?LOC2,PATADD2
+38 WRITE !,?LOC2,PATCITY,PATST,PATZIP,!!
+39 ;
+40 QUIT
+41 ;
PATIENT ; patient lookup, quit if patient doesn't exist
+1 NEW VAEL
+2 ;PAVEL DGBT*1*20
SET DGBTOLD=0
+3 ;bld DGTB*1*20
IF $DATA(DGANS)
SET DGANS="Q"
QUIT
+4 SET DGBTTOUT=""
SET DIC="^DPT("
SET DIC(0)="AEQMZ"
SET DIC("A")="Select PATIENT: "
+5 WRITE !!
DO ^DIC
KILL DIC
IF +Y'>0
QUIT
+6 ; get patient information#, call return patient return variables routine and set whether new claim or not
+7 SET DFN=+Y
DO 6^VADPT
DO PID^VADPT
+8 SET DGBTNEW=$SELECT($DATA(^DGBT(392,"C",DFN)):0,1:1)
+9 SET SPCOMPLETE=0
+10 QUIT
+11 ;
DIVISN(DGBTINST) ; if MED CTR DIV file set up (first record) and record does not exist, write warning, kill variables, and exit
+1 ; RFE DGBT*1.0*20
IF ($GET(DGBTDIVI)'="")&($GET(DGBTDIV)'="")
DO INSTIT(.DGBTINST)
QUIT
+2 SET DGBTDIVI=$ORDER(^DG(40.8,0))
SET DGBTDIV=$PIECE(^DG(40.8,DGBTDIVI,0),U)
DO INSTIT(.DGBTINST)
+3 QUIT
+4 ;
INSTIT(DGBTINST) ; check for pointer to institution file and for address information on institution
+1 NEW MAILCODE,INSTADD,INSTNODE
+2 SET DGBTDIVN=$PIECE(^DG(40.8,DGBTDIVI,0),"^",7)
+3 IF 'DGBTDIVN
WRITE !!,"INSTITUTION HAS NOT BEEN DEFINED FOR ",$PIECE(^(0),"^"),!,"USE THE ADT PARAMETER OPTION TO UPDATE",!
QUIT
+4 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
+5 ;
+6 SET INSTNODE=^DIC(4,DGBTDIVN,0)
+7 SET INSTADD=^DIC(4,DGBTDIVN,1)
+8 ;
+9 SET DGBTINST("ORG NAME")="DEPARTMENT OF VETERANS AFFAIRS"
+10 SET DGBTINST("INST NAME")=$$GET1^DIQ(4,DGBTDIVN,.01)
+11 SET DGBTINST("INST ADDRESS 1")=$$GET1^DIQ(4,DGBTDIVN,1.01)
+12 SET DGBTINST("INST ADDRESS 2")=$$GET1^DIQ(4,DGBTDIVN,1.02)
+13 SET DGBTINST("INST CITY")=$$GET1^DIQ(4,DGBTDIVN,1.03)
+14 SET DGBTINST("INST STATE")=$$GET1^DIQ(4,DGBTDIVN,.02)
+15 SET DGBTINST("INST ZIP CODE")=$$GET1^DIQ(4,DGBTDIVN,1.04)
+16 SET DGBTINST("FAC NUMBER")=$$GET1^DIQ(40.8,DGBTDIVI,1)
+17 SET MAILCODE=$ORDER(^DIC(49,"B","BENEFICIARY TRAVEL",""))
+18 SET DGBTINST("MAIL CODE")=$$GET1^DIQ(49,MAILCODE,1.5)
+19 QUIT
+20 ;
DEVICE(RPTNAM,ROUTINE) ;common device call for DGBT reports
+1 ;
+2 NEW %ZIS,ZTSK,ZTRTN,ZTIO,ZTDESC,ZTSAVE,POP,ZTQUEUED
+3 ; RPTNAM = NAME OF DGBT REPORT BEING RUN
+4 ; ROUTINE = "TAG^ROUTINE"
+5 ;
+6 SET DGBTQ1=0
SET DGBTQ=0
+7 SET %ZIS="PQM"
+8 DO ^%ZIS
+9 IF POP
SET DGBTQ=1
SET SPCOMPLETE=0
QUIT
+10 ;
IF IOST["C-"
QUIT
+11 ;.N X I IOM=255,$D(^%ZOSF("RM")) X ^%ZOSF("RM")
+12 ;Check for exit
+13 ;S DGBTQ=1
+14 IF $GET(IO("Q"))
Begin DoDot:1
+15 SET ZTRTN=ROUTINE
+16 SET ZTDESC="BT REPORT: "_RPTNAM
+17 SET ZTSAVE("*")=""
+18 DO ^%ZTLOAD
+19 WRITE !,$SELECT($DATA(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
+20 DO HOME^%ZIS
KILL IO("Q")
End DoDot:1
SET DGBTQ=1
+21 USE IO
+22 QUIT
+23 ;
DEVICE1(DGBTRPT) ;
+1 NEW %ZIS,ZTSK,ZTRTN,ZTIO,ZTDESC,ZTSAVE,POP
+2 SET %ZIS="QPM"
+3 DO ^%ZIS
+4 IF POP
SET DGBTQ=1
SET SPCOMPLETE=0
+5 IF IOST'["C-"
SET DGBTQ=1
QUIT
+6 ;
+7 ;Check for exit
+8 IF $GET(DGBTQ)
QUIT
+9 ;
+10 IF $DATA(IO("Q"))
Begin DoDot:1
+11 SET ZTRTN="LTR^DGBTDLT"
+12 SET ZTDESC="DGBT: "_DGBTRPT
+13 ; S ZTIO=ION
+14 SET ZTSAVE("*")=""
+15 DO ^%ZTLOAD
+16 WRITE !,$SELECT($DATA(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
+17 DO HOME^%ZIS
KILL IO("Q")
End DoDot:1
SET DGBTQ=1
+18 ;U IO
+19 QUIT
+20 ;
CLRLTR(DENIED) ;
+1 ;
+2 NEW Y,DGBTFDA,%
+3 KILL ERRMSG
+4 IF $GET(DGBTDL("ISSUED"))=""
SET DGBTDL("ISSUED")=$$GET1^DIQ(392,DGBTDTI,45,"I")
+5 IF $GET(DGBTDL("CLAIM DENIED"))=""
SET DGBTDL("CLAIM DENIED")=DENIED
+6 IF $GET(DGBTDL("DT DENIED"))=""
SET DGBTDL("DT DENIED")=$$GET1^DIQ(392,DGBTDTI,45.3)
if $GET(DGBTDL("DT DENIED"))=""
SET DGBTDL("DT DENIED")=$$FMTE^XLFDT(DT)
+7 IF $GET(DGBTDL("DENIED REASON"))=""
SET DGBTDL("DENIED REASON")=$$GET1^DIQ(392,DGBTDTI,45.4)
+8 ;
+9 ;$G(DGBTDL("ISSUED"))
SET DGBTFDA(392,DGBTDTI_",",45)=""
+10 SET DGBTFDA(392,DGBTDTI_",",45.1)=""
+11 ;$G(DGBTDL("CLAIM DENIED"))
SET DGBTFDA(392,DGBTDTI_",",45.2)=""
+12 SET Y=$$NOW^XLFDT()
DO DD^%DT
+13 ;$G(DGBTDL("DT DENIED"))
SET DGBTFDA(392,DGBTDTI_",",45.3)=""
+14 ;$G(DGBTDL("DENIED REASON"))
SET DGBTFDA(392,DGBTDTI_",",45.4)=""
+15 DO FILE^DIE("EKTS","DGBTFDA","ERRMSG")
KILL DGBTFDA
+16 QUIT
