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

DGBTDW.m

Go to the documentation of this file.
  1. DGBTDW ;ALB/RFE - DEDUCTIBLE WAIVER SETUP/MAIN ENTRY CALLUP; 01/19/12
  1. ;;1.0;Beneficiary Travel;**20**;November 11, 2011;Build 185
  1. Q
  1. EN ; Entry point
  1. N %,%H,%I,%Y,ANS,C,DELRAY,DFN,DGBTDTI,DGBTDW,DGBTFDA,DGBTFDA1,DGBTIENS,DGBTNEW,DGBTOK,DGBTTOUT,DGENR,DGRETV,DISPLAY,DTSUB,ERRMSG,PENSION,THISYR,I,X,Y
  1. N VAEL,VAERR,DELETRAY,DGBTERR
  1. D CLEAN^DILF
  1. F D ENTRQ Q:'$D(DFN)
  1. D QUIT
  1. Q
  1. ENTRQ ; Keep prompting until we don't get a DFN
  1. D PATIENT Q:'$D(DFN)
  1. K VAEL D ELIG^VADPT ;
  1. I '+VAEL(1) W !!,"Eligibility is missing from registration and is required to continue.",*7 D QUIT Q
  1. S DGBTNEW='$D(^DGBT(392.7,"C",DFN))
  1. D DATE
  1. I ($D(DIRUT))!($D(DUOUT))!($D(DIROUT))!($D(DTOUT))!(Y=-1)!('$D(DGBTDTI)) D QUIT Q
  1. W !
  1. S DGBTNEW='$D(^DGBT(392.7,"C",DFN,DGBTDTI))
  1. S (DGBTOK,DISPLAY)=0
  1. S DGBTOK=1
  1. I 'DGBTNEW D OLDREQ
  1. I DISPLAY D DISPLAY,QUIT Q
  1. I 'DGBTOK D QUIT Q
  1. I 'DGBTNEW W !,$$GET1^DIQ(2,DFN,.01)," ",DGBTDW("REQDT")
  1. D AUTH
  1. I 'DGBTOK D QUIT Q
  1. D GRANT
  1. I 'DGBTOK D QUIT Q
  1. D APPDT
  1. I 'DGBTOK D QUIT Q
  1. D RMRK
  1. I 'DGBTOK D QUIT Q
  1. W !,"NAME: ",$$GET1^DIQ(2,DFN,.01)," DEDUCTIBLE WAIVER REQUEST DATE: ",DGBTDW("REQDT")
  1. W !,$S(DGBTDW("AUTH")="YES":"GRANT",1:"DENI"),"ED BY: ",$$GET1^DIQ(200,DGBTDW("GRANT"),.01)," ON DATE: ",DGBTDW("APPDT")
  1. ;
  1. I '$$YESNO^DGBTUTL("Complete waiver request") W !,"Not completed" D QUIT Q ;changed by bld
  1. ;
  1. D UPDATE
  1. D QUIT
  1. Q
  1. PATIENT ;
  1. K DIC,DFN
  1. S DGBTTOUT="",DIC="^DPT(",DIC(0)="AEQMZ",DIC("A")="Select PATIENT: "
  1. W !! D ^DIC K DIC Q:Y'>0
  1. S (DFN,DGBTDW("NAME"))=+Y
  1. S PENSION=$$PENSION
  1. Q
  1. PENSION() ;
  1. N HIT,VAEL,VAERR
  1. D ELIG^VADPT
  1. I $P(VAEL(1),"^",2)["PENSION" Q 1
  1. I $P(VAEL(1),"^",2)="AID & ATTENDANCE" Q 1
  1. I $P(VAEL(1),"^",2)="HOUSEBOUND" Q 1
  1. S (HIT,I)=""
  1. F S I=$O(VAEL(1,I)) Q:I="" D Q:HIT
  1. .I VAEL(1,I)["PENSION" S HIT=1 Q
  1. .I $P(VAEL(1,I),"^",2)="AID & ATTENDANCE" S HIT=1 Q
  1. .I $P(VAEL(1,I),"^",2)="HOUSEBOUND" S HIT=1
  1. Q HIT
  1. UPDATE ;
  1. K ERRMSG
  1. I DGBTNEW D
  1. .S DGBTFDA(392.7,"+1,",.01)=DGBTDW("REQDT")
  1. .S DGBTFDA(392.7,"+1,",3)=DGBTDW("AUTH")
  1. .S DGBTFDA(392.7,"+1,",5)=DGBTDW("APPDT")
  1. .I $G(DGBTDW("REMARK"))'="" S DGBTFDA(392.7,"+1,",7)=DGBTDW("REMARK")
  1. .S DGBTFDA(392.7,"+1,",9)=$$FMTE^XLFDT(DT)
  1. .D UPDATE^DIE("E","DGBTFDA",,"ERRMSG")
  1. .I $D(ERRMSG) Q
  1. .;
  1. .S DGBTFDA1(392.7,DGBTDTI_",",2)=DGBTDW("NAME")
  1. .S DGBTFDA1(392.7,DGBTDTI_",",4)=DGBTDW("GRANT")
  1. .S DGBTFDA1(392.7,DGBTDTI_",",6)=DUZ
  1. .S DGBTFDA1(392.7,DGBTDTI_",",8)=$$EXP
  1. .D FILE^DIE("S","DGBTFDA1","ERRMSG")
  1. ;
  1. I '$G(DGBTNEW) D
  1. .S DGBTFDA(392.7,DGBTDTI_",",3)=DGBTDW("AUTH")
  1. .S DGBTFDA(392.7,DGBTDTI_",",5)=DGBTDW("APPDT")
  1. .I $G(DGBTDW("REMARK"))'="" S DGBTFDA(392.7,DGBTDTI_",",7)=DGBTDW("REMARK")
  1. .S DGBTFDA(392.7,DGBTDTI_",",9)=$$FMTE^XLFDT(DT)
  1. .D FILE^DIE("E","DGBTFDA","ERRMSG")
  1. .I $D(ERRMSG) Q
  1. .S DGBTFDA(392.7,DGBTDTI_",",4)=DGBTDW("GRANT")
  1. .S DGBTFDA(392.7,DGBTDTI_",",6)=DUZ
  1. .S DGBTFDA(392.7,DGBTDTI_",",8)=$$EXP
  1. .D FILE^DIE(,"DGBTFDA","ERRMSG")
  1. I '$D(ERRMSG) D FILDLT Q
  1. F I=1:1 Q:'$D(ERRMSG("DIERR","1","TEXT",I)) W !,ERRMSG("DIERR",1,"TEXT",I)
  1. Q
  1. FILDLT ;
  1. Q:'$D(DELETRAY)
  1. S I=$O(DELETRAY("")) Q:I=""
  1. K ERR
  1. S DGBTFDA(392.7,I_",",97)=DELETRAY(I,"DATE")
  1. S DGBTFDA(392.7,I_",",98)=DELETRAY(I,"DUZ")
  1. S DGBTFDA(392.7,I_",",99)=DELETRAY(I,"REMARK")
  1. D FILE^DIE(,"DGBTFDA","ERR")
  1. Q
  1. DATE ;
  1. Q:$$PENSDT
  1. K DGBTDTI,DELETRAY
  1. N PASTDT,PASTYR,DEL
  1. D DEL
  1. I 'DGBTNEW N DGBTC D OLD S:'DGBTC DGBTNEW=1
  1. F D DATE1 Q:DONE
  1. K DONE
  1. Q
  1. DATE1 ;
  1. S DONE=1
  1. K DIR
  1. I 'DGBTNEW S DIR("A",2)="Enter 'P' for past requests"
  1. S (DIR("A",1),DIR("A",3))="",DIR("A")="DEDUCTIBLE WAIVER REQUEST DATE AND TIME",DIR("?")="^D DHELP^DGBTDW"
  1. S DIR(0)="F",DIR("B")="NOW" D ^DIR K DIR
  1. I ($D(DIRUT))!($D(DUOUT)) Q
  1. S %DT="EXR",DTSUB=$S($$UP^XLFSTR(Y)="P":"PASTRQ",1:"OTHR") D @DTSUB K DTSUB,%DT
  1. Q
  1. ; Date-requested subroutines
  1. OTHR ; date/time entry for manually entered date
  1. S %DT(0)="-NOW" D ^%DT I Y<0 S DONE=0 Q
  1. I Y<$$FMADD^XLFDT(DT,-30) W !,"Date cannot precede ",$$FMTE^XLFDT($$FMADD^XLFDT(DT,-30)) S DONE=0 Q
  1. I $D(DEL($E(Y,1,3))),('$D(PASTYR($E(Y,1,3)))) D I 'ANS S Y=-1 Q
  1. .S THISYR=DEL($E(Y,1,3))
  1. .W !,"Request already on file and has been deleted on ",$$UP^XLFSTR($$FMTE^XLFDT(THISYR)),!
  1. .N RQDT S RQDT=Y
  1. .S ANS=$$YESNO^DGBTUTL("Do you wish to enter a new manual waiver request")
  1. .S Y=RQDT
  1. .I ($D(DIRUT))!($D(DIROUT))!($D(DTOUT))!($D(DUOUT)) S ANS=0
  1. I $D(PASTYR($E(Y,1,3))),'$D(^DGBT(392.7,"C",DFN,Y)) N RQDT D DELETE S Y=RQDT I 'ANS Q
  1. I ($D(DIRUT))!($D(DIROUT))!($D(DTOUT))!($D(DUOUT)) Q
  1. I $D(^DGBT(392.7,"C",DFN,Y)) S (DGBTDTI,DGBTIENS)=Y,DGBTDW("REQDT")=$$FMTE^XLFDT(DGBTDTI) Q
  1. S DGBTDTI=$$LOCKNEW(Y,0) I DGBTDTI=-1 W !,"Please enter another date/time" K DGBTDTI Q
  1. S DGBTDW("REQDT")=$$FMTE^XLFDT(DGBTDTI)
  1. Q
  1. LOCKNEW(DGBTDTI,DONE) ;
  1. F D Q:DONE
  1. .L +^DGBT(392.7,DGBTDTI):1
  1. .I ($T),('$D(^DGBT(392.7,DGBTDTI))) S DONE=1 Q
  1. .L S DGBTDTI=DGBTDTI+.000001
  1. .I ($L(DGBTDTI)=13),$E(DGBTDTI,13)=6 S DONE=1,DGBTDTI=-1 Q
  1. .I $E(DGBTDTI,13,14)>59 S DONE=1,DGBTDTI=-1 Q
  1. Q DGBTDTI
  1. PASTRQ ;
  1. I DGBTNEW W !,"No past dates on file, please enter a valid date/time" S DONE=0 Q
  1. N DGBTCH
  1. S DGBTCH=1
  1. F D LIST Q:DONE1
  1. K DONE1
  1. I ('$D(DTOUT)),(Y'>0) S DONE=0
  1. Q
  1. DELETE ;
  1. S RQDT=Y
  1. W !!,"Request already on file for this year: "
  1. S THISYR=PASTYR($E(Y,1,3))
  1. W $$UP^XLFSTR($$FMTE^XLFDT(THISYR)),!
  1. D
  1. .N X,Y
  1. .S ANS=$$YESNO^DGBTUTL("Do you wish to delete the request for "_$$UP^XLFSTR($$FMTE^XLFDT(THISYR)))
  1. I ($D(DIRUT))!($D(DIROUT))!($D(DTOUT))!($D(DUOUT)) Q
  1. I 'ANS S Y=THISYR Q
  1. D
  1. .N X,Y
  1. .S ANS=$$YESNO^DGBTUTL("Are you sure you wish to delete this request?")
  1. I ($D(DIRUT))!($D(DIROUT))!($D(DTOUT))!($D(DUOUT)) Q
  1. I 'ANS S Y=THISYR Q
  1. S DELETRAY(THISYR,"DATE")=DT
  1. S DELETRAY(THISYR,"DUZ")=DUZ
  1. F D Q:DONE
  1. .S DONE=1
  1. .N X,Y
  1. .K DIR S DIR("A")="Enter reason for deletion",DIR(0)="FO^1:100" D ^DIR K DIR
  1. .I ($D(DUOUT))!($D(DIROUT))!($D(DTOUT)) Q
  1. .S ANS=$TR(Y,U," ")
  1. .I $L($TR(ANS," ",""))=0 S DONE=0
  1. I ($D(DUOUT))!($D(DIROUT))!($D(DTOUT)) K DELETRAY Q
  1. S DELETRAY(THISYR,"REMARK")=ANS
  1. S ANS=$$YESNO^DGBTUTL("Do you wish to enter a deductible waiver request for "_$$UP^XLFSTR($$FMTE^XLFDT(Y)))
  1. I ($D(DIRUT))!($D(DIROUT))!($D(DTOUT))!($D(DUOUT)) Q
  1. I ANS Q
  1. D FILDLT K DELETRAY
  1. Q
  1. OLD ; Previously entered waiver request dates
  1. S DGBTC=0,I=""
  1. F S I=$O(^DGBT(392.7,"C",DFN,I),-1) Q:'I D
  1. .Q:$$GET1^DIQ(392.7,I,97,"I") ;deleted
  1. .S DGBTC=DGBTC+1
  1. .S PASTYR($E(I,1,3))=I
  1. .S PASTDT(DGBTC)=$$FMTE^XLFDT(I)_"^"_I
  1. Q
  1. DEL ; Deleted waivers on file
  1. S I=""
  1. F S I=$O(^DGBT(392.7,"C",DFN,I),-1) Q:'I D
  1. .Q:'$$GET1^DIQ(392.7,I,97,"I") ;deleted
  1. .S DEL($E(I,1,3))=I
  1. Q
  1. LIST ;
  1. S DONE1=1
  1. F I=DGBTCH:1:DGBTC W !?5,I,". ",$P(PASTDT(I),"^") I (I#5=0)!(I=DGBTC) D Q:($D(DTOUT))!($D(DIRUT))!(Y>0)
  1. .N DONE
  1. .F D CHOZ Q:DONE
  1. I ('$D(DTOUT))&(Y="")&(I=DGBTC) S Y=-1 Q
  1. S:('$D(DTOUT))&(Y="") DONE1=0,DGBTCH=I+1 Q
  1. I Y=-1 Q
  1. Q
  1. DHELP ;
  1. S %DT="EXR" D ^%DT K %DT
  1. W ! I 'DGBTNEW W !,"If there is more than one waiver request, select by number to edit."
  1. W !,"You cannot enter a future date/time."
  1. W !,"The date you enter cannot precede ",$$FMTE^XLFDT($$FMADD^XLFDT(DT,-30)),"."
  1. Q
  1. PENSDT() ;
  1. I 'PENSION Q 0
  1. S DGBTDTI=$O(^DGBT(392.7,"C",DFN,""),-1) I 'DGBTDTI Q 0
  1. I $$GET1^DIQ(392.7,DGBTDTI,8)'="PENSION" Q 0
  1. S (DGBTIENS,Y)=DGBTDTI,DGBTDW("REQDT")=$$FMTE^XLFDT(DGBTDTI)
  1. W !,$$UP^XLFSTR(DGBTDW("REQDT"))
  1. Q 1
  1. CHOZ ; select from the displayed past claims dates for claim to be edited.
  1. S DONE=1
  1. K DIR
  1. W !! S Y=0,DIR(0)="FO^1:5",DIR("A")="Select DEDUCTIBLE WAIVER REQUEST"
  1. I I<DGBTC S DIR("A",1)="Type '^' to exit date list, or <RETURN> to display more dates"
  1. I I=DGBTC S DIR("A",1)="Type <RETURN> or '^' to exit date list"
  1. S DIR("?")="Entering a '^' will exit the Past REQUEST list, entering <RETURN> will continue to scroll through past dates.",DIR("?",1)="Select a Past CLAIM date by number, or enter 'T' for TODAY."
  1. D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S Y=-1 Q
  1. Q:Y=""
  1. I (X<1)!(X>I)!(X'=+X) W !?25,*7,"INVALID ENTRY" S DONE=0 Q
  1. S (DGBTDTI,DGBTIENS)=$P(PASTDT(Y),"^",2),DGBTDW("REQDT")=$P(PASTDT(Y),"^") W !,$$GET1^DIQ(392.7,DGBTDTI,2)," ",$$GET1^DIQ(392.7,DGBTDTI,.01)
  1. Q
  1. AUTH ; Deductible waiver authorized Y/N
  1. I PENSION W !,"DEDUCTIBLE WAIVER AUTHORIZED YES" S DGBTDW("AUTH")="YES" Q
  1. K DIR
  1. S DIR("A")="DEDUCTIBLE WAIVER AUTHORIZED Y/N",DIR(0)="Y"
  1. S DIR("B")=$S(DGBTNEW:"YES",1:$$GET1^DIQ(392.7,DGBTIENS,3))
  1. D ^DIR K DIR
  1. I ($D(DTOUT))!($D(DIRUT)) S DGBTOK=0 Q
  1. S DGBTDW("AUTH")=Y(0)
  1. Q
  1. RMRK ; Remarks
  1. K DGBTDW("REMARK"),DIR
  1. S DIR("A")="DEDUCTIBLE WAIVER REMARKS"
  1. I 'DGBTNEW S DIR("B")=$$GET1^DIQ(392.7,DGBTIENS,7)
  1. S DIR(0)="FO^1:235"
  1. D ^DIR K DIR
  1. I (Y=""),('$D(DTOUT)) Q
  1. I ($E(Y,1)="^")!($D(DIRUT))!($D(DTOUT)) S DGBTOK=0 D QUIT Q
  1. S DGBTDW("REMARK")=Y
  1. Q
  1. APPDT ; Waiver Approval Date
  1. F D Q:DONE
  1. .S DONE=1
  1. .K DIR
  1. .S DIR("A")=$S(DGBTDW("AUTH")="YES":"WAIVER APPROVAL DATE: ",1:"WAIVER DENIAL DATE: ")
  1. .S DIR(0)="DA^2991231:NOW:EX",DIR("B")=$S(DGBTNEW:"TODAY",1:$$GET1^DIQ(392.7,DGBTIENS,5)) D ^DIR K DIR
  1. .I ($D(DIRUT))!($D(DIROUT)) Q
  1. .I Y<$P(DGBTDTI,".") W !,"Cannot be before request date" S DONE=0 Q
  1. K DONE
  1. I ($D(DIRUT))!($D(DIROUT))!(Y=-1) S DGBTOK=0 Q
  1. S DGBTDW("APPDT")=Y(0)
  1. Q
  1. GRANT ; Waiver granted by:
  1. K DIC
  1. F D Q:DONE
  1. .S DONE=1
  1. .S DIC="^VA(200,",DIC(0)="AEQMZ",DIC("A")=$S(DGBTDW("AUTH")="YES":"DEDUCTIBLE WAIVER GRANTED BY: ",1:"DEDUCTIBLE WAIVER DENIED BY: ")
  1. .I 'DGBTNEW S DIC("B")=$$GET1^DIQ(392.7,DGBTIENS,4)
  1. .D ^DIC K DIC
  1. .I ($D(DTOUT))!($D(DUOUT)) Q
  1. .I +Y<0 S DONE=0
  1. K DONE
  1. I ($D(DTOUT))!($D(DUOUT))!(+Y'>0) S DGBTOK=0 Q
  1. S DGBTDW("GRANT")=+Y
  1. Q
  1. EXP() ; Expiration date
  1. I PENSION Q "PENSION"
  1. I $G(DGBTDW("AUTH"))'="YES" Q ""
  1. N DGBTINCA,EXPDT
  1. D GA^DGBTUTL(DFN,"DGBTINCA",DGBTDTI)
  1. S EXPDT=$$EXPDT
  1. I EXPDT<DGBTDTI Q $E(DGBTDTI,1,3)_1231 ;BLD changed exp to expdt
  1. N DGARRAY,DGBTDATA,DGBTRET,DGMTST,DGMTYPT1,FIELDS,FILE,FLAGS,INCOM,LOWINC,MTDATA,MTIEN,MTT,NETINC,THRESHLD
  1. I +$$LI^DGBTUTL(DFN,DGBTDTI,$$DEP^VAFMON(DFN,DGBTDTI),,DGBTINCA) Q EXPDT ;
  1. Q $E(DGBTDTI,1,3)_1231 ;BLD add $g around DGBTDW("APPR")
  1. EXPDT() ;
  1. I +$G(DGBTINCA) Q $P(DGBTINCA,U,5)
  1. N TESTDATE
  1. S TESTDATE=$P($$LST^DGMTCOU1(DFN,DGBTDTI,3),"^",2)
  1. I +TESTDATE=0 Q 0
  1. Q ($E(TESTDATE,1,3)+1)_$E(TESTDATE,4,7)
  1. OLDREQ ;
  1. K DIR
  1. ;I $$EDITOLD S DIR("A")="<E>dit Request, <D>isplay Request, or <Q>uit ",DIR(0)="SA^Q:Quit;E:Edit;D:Display"
  1. ;E S DIR("A")="<D>isplay Request, or <Q>uit ",DIR(0)="SA^Q:Quit;D:Display"
  1. I $$EDITOLD S DIR("A")="<E>dit Request, <D>isplay Request, <DEL>ete Request, or <Q>uit ",DIR(0)="SA^Q:Quit;E:Edit;D:Display;DEL:Delete"
  1. E S DIR("A")="<D>isplay Request, <DEL>ete Request, or <Q>uit ",DIR(0)="SA^Q:Quit;D:Display;DEL:Delete"
  1. S DIR("B")="Quit"
  1. D ^DIR K DIR
  1. ;S X=$E($$UP^XLFSTR(X),1)
  1. S X=$$UP^XLFSTR(X)
  1. I ($E(X,1)="Q")!($D(DIRUT))!($D(DUOUT)) S DGBTOK=0 Q
  1. I $E(X,1,3)="DEL" D Q
  1. .I $G(DGBTIENS)="" S DGBTIENS=$G(PASTYR($E(Y,1,3)))
  1. .I DGBTIENS="" Q
  1. .S DELETRAY(DGBTIENS,"DATE")=DT
  1. .S DELETRAY(DGBTIENS,"DUZ")=DUZ
  1. .F D Q:DONE
  1. ..S DONE=1
  1. ..N X,Y
  1. ..K DIR S DIR("A")="Enter reason for deletion",DIR(0)="FO^1:100" D ^DIR K DIR
  1. ..I ($D(DUOUT))!($D(DIROUT))!($D(DTOUT)) Q
  1. ..S ANS=$TR(Y,U," ")
  1. ..I $L($TR(ANS," ",""))=0 S DONE=0
  1. .I ($D(DUOUT))!($D(DIROUT))!($D(DTOUT)) K DELETRAY Q
  1. .S DELETRAY(DGBTIENS,"REMARK")=ANS
  1. .I ($D(DIRUT))!($D(DIROUT))!($D(DTOUT))!($D(DUOUT)) Q
  1. .D FILDLT K DELETRAY
  1. .S DGBTOK=0
  1. S DGBTOK=1
  1. I $E(X,1)="D" S DISPLAY=1
  1. Q
  1. EDITOLD() ;
  1. N EXPDT
  1. S EXPDT=$$GET1^DIQ(392.7,DGBTIENS_",",8,"I")
  1. I EXPDT="PENSION" Q 1
  1. Q EXPDT'<DT
  1. DISPLAY ;
  1. I $G(DGBTIENS)="" S DGBTIENS=$G(PASTYR($E(Y,1,3)))
  1. I DGBTIENS="" Q
  1. N AUTH,DENYDT
  1. S AUTH=$$GET1^DIQ(392.7,DGBTIENS,3)
  1. W !,"PATIENT: ",$$GET1^DIQ(392.7,DGBTIENS,2)
  1. W !,"DEDUCTIBLE WAIVER REQUEST DATE: ",$$GET1^DIQ(392.7,DGBTIENS,.01)
  1. W !,"DEDUCTIBLE WAIVER AUTHORIZED?: ",AUTH
  1. W !,"DEDUCTIBLE WAIVER "
  1. W $S(AUTH="YES":"GRANT",1:"DENI"),"ED BY: ",$$GET1^DIQ(392.7,DGBTIENS,4)
  1. W !,"DEDUCTIBLE WAIVER "
  1. W $S(AUTH="YES":"APPROV",1:"DENI"),"AL DATE: ",$$GET1^DIQ(392.7,DGBTIENS,5)
  1. W !,"DEDUCTIBLE WAIVER ENTERED BY: ",$$GET1^DIQ(392.7,DGBTIENS,6)
  1. W !,"DEDUCTIBLE WAIVER ENTRY DATE: ",$$GET1^DIQ(392.7,DGBTIENS,9)
  1. W !,"DEDUCTIBLE WAIVER EXPIRATION DATE: "
  1. S I=$$GET1^DIQ(392.7,DGBTIENS,8)
  1. W $S(I?7N:$$UP^XLFSTR($$FMTE^XLFDT(I)),1:I)
  1. W !,"DEDUCTIBLE WAIVER REMARKS: ",$$GET1^DIQ(392.7,DGBTIENS,7)
  1. S DENYDT=$$GET1^DIQ(392.7,DGBTIENS,97)
  1. I DENYDT'="" W !,"DEDUCTIBLE WAIVER DELETION DATE: ",DENYDT
  1. D CLEAN^DILF
  1. Q
  1. QUIT ;
  1. D CLEAN^DILF
  1. L
  1. Q