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

DGBTDLT.m

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