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

DGBTDLT1.m

Go to the documentation of this file.
  1. DGBTDLT1 ;UNK/BLD - REPRINT BENEFICIARY TRAVEL DENIAL LETTER ; 1/8/24 12:37pm
  1. ;;1.0;Beneficiary Travel;**20,28,33,41**;September 25, 2001;Build 7
  1. ;
  1. Q
  1. ;************************************************************************************************************
  1. ; THIS WILL PRINT DENIAL LETTERS
  1. ;************************************************************************************************************
  1. ;
  1. REPRINT ;
  1. ;
  1. Q ;DGBT*1*41 Remove functionality
  1. D QUIT
  1. W !
  1. K ^UTILITY($J,"W"),^TMP("DGBT",$J)
  1. S QUIT=0
  1. ;
  1. ;DIVISN ; if MED CTR DIV file set up (first record) and record does not exist, write warning, kill variables, and exit
  1. S X=$G(^DG(40.8,0)) I X="" W !,"WARNING...MEDICAL CENTER DIVISION FILE IS NOT SET UP",!,"USE THE ADT PARAMETER OPTION FILE TO SET UP DIVISION" Q
  1. ; check if multi-divisional center (GL node exists and 2nd piece=1). Do lookup, if it exists-set local variables
  1. S DGBTMD=0 I $D(^DG(43,1,"GL")),$P(^("GL"),U,2) D Q:Y'>0 ;D PATIENT
  1. . S DIC="^DG(40.8,",DIC(0)="AEQMNZ",DIC("A")="Select DIVISION: " W !!
  1. . D ^DIC K DIC Q:Y'>0
  1. . S DGBTDIVI=+Y,DGBTDIV=$P(Y,U,2)
  1. . D INSTIT S DGBTMD=1
  1. ; if not a multi-divisional center, default to institution name
  1. I 'DGBTMD S DGBTDIVI=$O(^DG(40.8,0)),DGBTDIV=$P(^DG(40.8,DGBTDIVI,0),U) D INSTIT
  1. ;
  1. D PATIENT Q:$G(DFN)="" ;I '$D(^DGBT(392,"ADENIED",DFN)) W !!,"THERE ARE NO DENIAL LETTERS TO PRINT FOR: ",VADM(1) K DFN D QUIT Q ;D REPRINT,QUIT Q
  1. D LIST2 I $G(CHZFLG)="" D QUIT Q
  1. S DGBTDLTR=$$GET1^DIQ(392,DGBTDTI,45,"I")
  1. I 'DGBTDLTR D QUIT Q
  1. S DGBTCMTY=$$GET1^DIQ(392,DGBTDTI,56,"I")
  1. D DEVICE^DGBTDLT("DENIAL LETTER","LTR^DGBTDLT1") I $D(DTOUT)!($D(DUOUT)) S QUIT=1 D QUIT Q
  1. I $G(DGBTQ) D QUIT Q
  1. D LTR
  1. D QUIT
  1. Q
  1. ;
  1. LTR ;
  1. ;
  1. N NAME,DGBTCDT,DGBTDR,DIWL,DIWR
  1. K ^UTILITY($J,"W")
  1. S DGBTDR=$$GET1^DIQ(392,DGBTDTI,45.4,"I")
  1. I $$GET1^DIQ(392.8,DGBTDR,1,,"REASON")
  1. D DIVISN(.DGBTINST) ;this will set up the DGBTINST array containing the current VA location address
  1. ;D DEVICE("DENIAL LETTER") I $D(DTOUT)!($D(DUOUT)) S QUIT=1 Q
  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) ;invoice date
  1. S NAME=$$GET1^DIQ(392,DGBTDTI,12),DGBTCDT(2)=$P(NAME,",",2)_" "_$P(NAME,",",1) ;user name *28 modified to use who entered into the file (#12) field
  1. S DGBTCDT(3)=$$GET1^DIQ(200,$$GET1^DIQ(392,DGBTDTI,12,"I"),8) ;user title *28 modified to use who entered into the file (#12) field
  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,KETTERS2
  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. D:'IOST'["C-" ^%ZISC
  1. Q
  1. ;
  1. PATIENT ; patient lookup, quit if patient doesn't exist
  1. N VAEL
  1. S DGBTTOUT="",DIC="^DPT(",DIC(0)="AEQMZ",DIC("A")="Select PATIENT: "
  1. W !! D ^DIC K DIC I +Y'>0 K DFN 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. Q
  1. ;
  1. LIST2 ; find all previous claims, get total count in DGBTC and put those claims in utility file
  1. N X1,YY,DGBTCDT,DGBTC,CNT
  1. S (CNTR,DGBTCH,DGBTCH1,DGBTCDT)=0
  1. S DGBTC=""
  1. I $D(^DGBT(392,"ADENIED",DFN))'>1 W !!?10,"There are no entries on file for this patient",! S Y1=-1 D QUIT Q
  1. ;
  1. F I=1:1 S DGBTC=$O(^DGBT(392,"ADENIED",DFN,DGBTC),-1) Q:'DGBTC D
  1. .S Y=DGBTC D DD^%DT
  1. .S CNTR=$G(CNTR)+1
  1. .S DGBTARY(CNTR,DGBTC)=Y ;K DGBTARY(DGBTC)
  1. ;
  1. LIST3 ; list claims (in external format) from temporary global, 5 at a time. Loop thru list until selection made.
  1. S (CNTR,DGBTCH)=""
  1. S DGBTC=""
  1. W !
  1. F S CNTR=$O(DGBTARY(CNTR)) Q:'CNTR D Q:$G(CHZFLG)!$G(DTOUT)!$G(DUOUT)
  1. .F S DGBTC=$O(DGBTARY(CNTR,DGBTC)) Q:DGBTC="" D Q:$G(CHZFLG)
  1. ..W !?5,CNTR,".",?10,DGBTARY(CNTR,DGBTC) I CNTR#5=0!($O(DGBTARY(CNTR))="") D CHOZ I $D(DUOUT)!$D(DTOUT)!(Y>0) Q
  1. I '$D(DTOUT)&Y="" D LIST3 Q
  1. S DGBTDTI=$O(DGBTARY(CNTR,"")),DGBTDTE=DGBTARY(CNTR,DGBTDTI)
  1. K DIR
  1. Q
  1. ;
  1. CHOZ ; select from the displayed past claims dates for claim to be edited.
  1. N DGBTCH1,CHOICE
  1. S CHOICE=1
  1. W !! S (Y1,Y)=0,DGBTCH1=I,DIR(0)="FO^1:5",DIR("A")="Select CLAIM"
  1. S DIR("A",1)="Type '^' to exit date list, or <RETURN> to display more dates"
  1. S DIR("?")="Entering a '^' will exit the Past CLAIM list, entering <RETURN> will continue to scroll through past dates.",DIR("?",1)="Select a Past CLAIM date by number."
  1. D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S Y1=-1 Q
  1. I Y="",$O(DGBTARY(CNTR))'="" Q
  1. I X<CHOICE!(X>DGBTCH1)!(X'=+X) W !?25,*7,"INVALID ENTRY!" D CHOZ Q ; value must be between 1 and last displayed number
  1. S CHZFLG=Y,DGBTDTI=$O(DGBTARY(Y,""))
  1. S CNTR=$G(Y)
  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. S DGBTDIVI=$$GET1^DIQ(392,DGBTDTI,11,"I"),DGBTDIV=$$GET1^DIQ(40.8,DGBTDIVI,.01) ; RFE DGBT*1.0*20
  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. ;
  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. DEVICE(DGBTRPT) N %ZIS,ZTSK,ZTRTN,ZTIO,ZTDESC,ZTSAVE,POP
  1. S %ZIS="QM"
  1. D ^%ZIS
  1. I POP S DGBTQ=1
  1. ;
  1. ;Check for exit
  1. I $G(DGBTQ) Q
  1. ;
  1. S DGBTSCR=$S($E($G(IOST),1,2)="C-":1,1:0)
  1. I $D(IO("Q")) D S DGBTQ=1
  1. . S ZTRTN="RUN^DGBTBORP0(DGBTEXCEL,DGBTRPT,DGBTSMDET)"
  1. . S ZTIO=ION
  1. . S ZTSAVE("*")=""
  1. . S ZTDESC="DGBT REPORT: "_DGBTRPT
  1. . D ^%ZTLOAD
  1. . W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
  1. . D HOME^%ZIS
  1. U IO
  1. Q
  1. ;
  1. QUIT ;will kill all local variables used by this routine
  1. ;
  1. K DFN,DGBTNEW,VACNTRY,VADAT,VADM,VAERR,VAPA,Y,Z,J,DGBTINST,DGBTNEW,DGBTTOUT,DGBTDLTR,DGBTDIVN,DGBTDIVI,DGBTDIV,DGBTCMTY,DGTCH1,DGBTCH,DGBTC,DGBTMD
  1. K ^TMP("DGBT",$J),DFN,CITYSTZIP,CHZFLG,C,QUIT
  1. K X1,YY,DGBTCHK,^TMP("DGBT",$J),^TMP("DGBTARA",$J)
  1. K DRIEN,REASON,LETTERS1,LETTERS2,LINENBR,NBR,DGBTDNLTR,DGBTFDA,DGBTSCR,DGBTDR,DGBTISSUED,VADM,PATSEX,PATADD1,PATADD2,PATCITY,PATST,PATZIP,PATNAME
  1. K CNTR,DFN,DGBTARY,DGBTCH,DGBTCH1,DGBTDTE,DGBTDTI,DGBTNEW,DGBTTOUT,DGBTARY,VA,VACNTRY,VAPA,DUOUT,DTOUT,DGBTQ,DGBTQ1
  1. Q