- 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 Jan 18, 2025@02:41:48 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