DGOTHMG2 ;SHRPE/YMG - OTH Management actions (cont.) ;04/30/19
;;5.3;Registration;**952,977**;Aug 13, 1993;Build 177
;;Per VA Directive 6402, this routine should not be modified.
;
Q
AP ; add 90 day period
;
; DSPMODE, DGIEN33 and DGDFN are defined in ^DGOTHMGT
;
N CRDTM,DAYS,DGFAC,DGFRES,DGIEN365,DGIEN90,DGUSR,DTDIFF,DTSTR90,DTSTR365,EDT365,EDT90,MAXDT,MINDT,NUM365,NUM90,PNDREQ,OTHDATA,PNDSTR
N REQTYPE,SDT90,STARTDT,STOP,SUBDT,Z
D FULL^VALM1,CLEAR^VALM1
S VALMBCK="R"
; check security key
I '$$CHKKEY^DGOTHMG1("DG OTH ADD PERIOD") D Q
.W !!,"You need DG OTH ADD PERIOD security key in order to use this action!"
.D ASKCONT
.Q
D HEADER(DGDFN) ; display header
S Z=$$LASTPRD^DGOTHUT1(DGIEN33),NUM365=$P(Z,U),DGIEN365=$P(Z,U,2),NUM90=$P(Z,U,3),DGIEN90=$P(Z,U,4) ; get data for the last 90 day period
W !!,"365 Day Period: ",$S(NUM365>0:NUM365,1:"None")
W !," 90 Day Period: ",$S(NUM90>0:NUM90,1:"None")
S DTSTR90=$$GET90DT^DGOTHUT1(DGIEN33,$P(Z,U,2),$P(Z,U,4)) ; get dates for the last 90 day period
S SDT90=$P(DTSTR90,U),EDT90=$P(DTSTR90,U,2),DAYS=$P(DTSTR90,U,3)
I SDT90>0 D
.W !!,"The most recent 90 day period start",$S(SDT90<DT:"ed on "_$$FMTE^XLFDT(SDT90),SDT90>DT:"s on "_$$FMTE^XLFDT(SDT90),1:"s today")
.W " and end",$S(EDT90<DT:"ed on "_$$FMTE^XLFDT(EDT90),EDT90>DT:"s on "_$$FMTE^XLFDT(EDT90),1:"s today")
.S DTSTR365=$$GET365DT^DGOTHUT1(DGIEN33,DGIEN365),EDT365=$P(DTSTR365,U,2)
.W !,"The most recent 365 day period end",$S(EDT365<DT:"ed on "_$$FMTE^XLFDT(EDT365),EDT365>DT:"s on "_$$FMTE^XLFDT(EDT365),1:"s today")
.Q
W !!,"Days Remaining: ",$S(SDT90>0:DAYS,1:"N/A")
; don't allow new 90 day period if there's already one that starts in the future
I SDT90>DT D Q
.W !!,"Latest 90 day period starts in the future (on ",$$FMTE^XLFDT(SDT90),")"
.W !,"Authorizing another 90 day period is not allowed!"
.D ASKCONT
.Q
; display message if current 90 day period is greater than 2 (last 90 day period is greater than 1)
I NUM90>1 W !!,"Patient has been authorized for 180 days or more of care",!
; get current user and facility
S DGUSR=$$UP^XLFSTR($$NAME^XUSER(DUZ,"F")),DGFAC=$P($$SITE^VASITE(),U)
; check for existing pending request
S PNDSTR=$$GETPEND^DGOTHUT1(DGDFN),PNDREQ=$P(PNDSTR,U)
I PNDREQ=-1 D DISPERR($P(PNDSTR,U,2)) Q
I PNDREQ D
.W !!,"Existing pending request:"
.W !," Request submitted on ",$$FMTE^XLFDT($P(PNDSTR,U,2)),"; response not yet received.",!
.Q
; get record creation date / time
S CRDTM=$S(PNDREQ:$P(PNDSTR,U,6),1:$$NOW^XLFDT())
; prompt for authorization approval
S REQTYPE=$$ASKAUAP() I REQTYPE="" Q
; if approved request
I REQTYPE="Y" D Q
.; calculate date range for the start date
.; earliest date allowed is the end date of the last 90 day period + 1 or today's date
.; with DG OTH MGR key earliest date can be up to 15 days in the past
.; latest date allowed is the earliest date + 15 days if earliest date is in the future, or today's date + 15 days if earliest date is in the past
.S DTDIFF=$$FMDIFF^XLFDT(DT,EDT90,1)
.S MINDT=$S(DTDIFF'>0:$$FMADD^XLFDT(EDT90,1),1:DT)
.S MAXDT=$$FMADD^XLFDT(MINDT,15)
.; allow past date with DG OTH MGR key
.I DTDIFF>0,$$CHKKEY^DGOTHMG1("DG OTH MGR") S MINDT=$S(DTDIFF>15:$$FMADD^XLFDT(DT,-15),1:$$FMADD^XLFDT(EDT90,1))
.; prompt for period start date
.S STARTDT=$$ASKSTDT(MINDT,MAXDT) I STARTDT'>0 Q
.S $P(OTHDATA,U,6)=STARTDT
.; put current user and facility into OTHDATA
.S $P(OTHDATA,U,7)=DGUSR
.S $P(OTHDATA,U,8)=DGFAC
.; find out which 365 day period we're going to use
.S $P(OTHDATA,U)=$S($$FMDIFF^XLFDT(STARTDT,$P(DTSTR365,U,2))>0:NUM365+1,1:NUM365)
.; find out which 90 day period we're going to use
.S $P(OTHDATA,U,2)=$S($P(OTHDATA,U)=NUM365:NUM90+1,1:1)
.; put record creation timestamp into OTHDATA
.S $P(OTHDATA,U,9)=CRDTM
.I $P(OTHDATA,U,2)>1 S STOP=0 D I STOP Q
..; not the 1st 90 day period, display auth. prompts
..; prompt for Date request submitted
..S SUBDT=$$ASKREQDT(DT,$S($P(PNDSTR,U):$P(PNDSTR,U,2),1:"")) I SUBDT'>0 S STOP=1 Q
..S $P(OTHDATA,U,3)=SUBDT
..; prompt for authorized by
..S Z=$$ASKAUBY() I Z="" S STOP=1 Q
..S $P(OTHDATA,U,4)=Z
..; prompt for authorization received date
..S Z=$$ASKAURDT(DT) I Z'>0 S STOP=1 Q
..S $P(OTHDATA,U,5)=Z
..Q
.; file data
.S DGFRES=$$FILAUTH^DGOTHUT1(DGDFN,OTHDATA)
.I '+DGFRES D DISPERR($P(DGFRES,U,2))
.I +DGFRES D
..W !!,"The patient has been authorized for an additional 90 day period"
..W !,"with the starting date of ",$$FMTE^XLFDT($P(OTHDATA,U,6))
..D ASKCONT
..S DSPMODE=0 ; switch view to approved requests
..; clear existing pending request, if it exists
..I PNDREQ D CLRPND(DGDFN)
..K VALMDDF M VALMDDF=DGSVDDF("A") D CHGCAP^VALM("LINE","Line") ; use CHGCAP^VALM to reload VALMDDF array
..D BLD^DGOTHMGT(DSPMODE) ; rebuild list
..D BLDHDR^DGOTHMGT(DSPMODE) ; rebuild header
..; Callpoint to queue an entry in File #301.5 that will trigger
..; Enrollment Full Data Transmission (ORF/ORU~ZO7) HL7 message.
..D EVENT^IVMPLOG(DGDFN)
..Q
.Q
; prompt for Date request submitted (applies to both pending and denied requests)
S SUBDT=$$ASKREQDT(DT,$S($P(PNDSTR,U):$P(PNDSTR,U,2),1:"")) I SUBDT'>0 Q
; if pending request
I REQTYPE="P" D Q
.S $P(OTHDATA,U)=1
.S $P(OTHDATA,U,2)=SUBDT
.S $P(OTHDATA,U,3)=DGUSR
.S $P(OTHDATA,U,4)=DGFAC
.S $P(OTHDATA,U,5)=CRDTM
.; file data
.S DGFRES=$$FILPEND^DGOTHUT1(DGDFN,OTHDATA)
.I '+DGFRES D DISPERR($P(DGFRES,U,2))
.I +DGFRES D
..W !!,$$CJ^XLFSTR("Pending authorization request filed successfully.",80) D ASKCONT
..D BLDHDR^DGOTHMGT(DSPMODE) ; rebuild header
..; Callpoint to queue an entry in File #301.5 that will trigger
..; Enrollment Full Data Transmission (ORF/ORU~ZO7) HL7 message.
..D EVENT^IVMPLOG(DGDFN)
..Q
.Q
; denied request (REQTYPE="N") if we got here
S Z=$$ASKAUCMT() I Z="" Q
S $P(OTHDATA,U,1)=SUBDT
S $P(OTHDATA,U,2)=Z
S $P(OTHDATA,U,3)=DGUSR
S $P(OTHDATA,U,4)=DGFAC
S $P(OTHDATA,U,5)=CRDTM
S DGFRES=$$FILDEN^DGOTHUT1(DGDFN,OTHDATA)
I '+DGFRES D DISPERR($P(DGFRES,U,2))
I +DGFRES D
.W !!,$$CJ^XLFSTR("Denied authorization request filed successfully.",80) D ASKCONT
.S DSPMODE=1 ; switch view to denied requests
.; clear existing pending request, if it exists
.I PNDREQ D CLRPND(DGDFN)
.K VALMDDF M VALMDDF=DGSVDDF("D") D CHGCAP^VALM("LINE","Line") ; use CHGCAP^VALM to reload VALMDDF array
.D BLD^DGOTHMGT(DSPMODE) ; rebuild list
.D BLDHDR^DGOTHMGT(DSPMODE) ; rebuild header
.; Callpoint to queue an entry in File #301.5 that will trigger
.; Enrollment Full Data Transmission (ORF/ORU~ZO7) HL7 message.
.D EVENT^IVMPLOG(DGDFN)
.Q
Q
;
CLRPND(DGDFN) ; clear existing pending request
;
; DGDFN - patient's DFN
;
N DGRES
S DGFRES=$$FILPEND^DGOTHUT1(DGDFN,"0^^^^^^")
I '+DGFRES D DISPERR($P(DGFRES,U,2)) Q
W !!,"Existing pending request has been removed.",!
Q
;
ASKCONT ; display "press <Enter> to continue" prompt
N Z
W !!,$$CJ^XLFSTR("Press <Enter> to continue.",80)
R !,Z:DTIME
Q
;
N DDASH,DGNAME,DGDOB,VADM
D DEM^VADPT ;get patient demographics
S DGNAME=VADM(1),DGDOB=$P(VADM(3),U,2)
W ?24,"START ADDITIONAL 90-DAY PERIOD"
W !,"Patient Name: ",DGNAME,?60,"DOB: ",DGDOB
S $P(DDASH,"=",81)="" W !,DDASH,! ;write dash lines
Q
;
DISPERR(DGERR) ; display error message
;
; DGERR - message to display
;
W !!,"Error while filing OTH data:",!,DGERR
D ASKCONT
Q
;
ASKREQDT(MAXDT,DEFDT) ; prompt for date request submitted
;
; MAXDT = latest allowed date (required)
; DEFDT = default date
;
; returns date in internal FM format or 0 on user exit
;
N DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
S DIR(0)="D^:"_MAXDT_":EX"
S DIR("A")="Date request submitted"
I +$G(DEFDT)>0 S DIR("B")=$$FMTE^XLFDT(DEFDT)
S DIR("?",1)="Enter the date authorization request was submitted."
S DIR("?",2)="No future date allowed."
S DIR("?")="Latest allowed date is "_$$FMTE^XLFDT(MAXDT)
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q 0
Q +Y
;
ASKAUAP() ; prompt for authorization approved
;
; returns "Y" for approved, "N" for not approved, "P" for pending, or "" on user exit
;
N DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
S DIR(0)="SA^Y:Yes;N:No;P:Pending"
S DIR("A")="Authorization approved (Y/N/P): "
S DIR("?",1)="Select 'Y' if request has been approved."
S DIR("?",2)=" Also select 'Y' if 1st 90 day period of additional 365 day period"
S DIR("?",3)=" (approval not required)."
S DIR("?",4)="Select 'N' if request has been denied."
S DIR("?")="Select 'P' if request is still pending."
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q ""
Q Y
;
ASKAUCMT() ; prompt for authorization comment
;
; returns entered comment or "" on user exit
;
N DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
S DIR(0)="FA^1:60^K:$$CHRCHK^DGOTHMG2(X) X"
S DIR("A")="Authorization comment: "
S DIR("?",1)="Free text comment, 1 to 60 characters in length."
S DIR("?")="Characters '|', '^', '&', '\', and '~' are not allowed."
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q ""
Q Y
;
ASKAUBY() ; prompt for authorized by
;
; returns name of the user selected or "" on user exit
;
N DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
S DIR(0)="FA^1:60^K:$$CHRCHK^DGOTHMG2(X) X"
S DIR("A")="Authorized by: "
S DIR("?",1)="Free text name, 1 to 60 characters in length."
S DIR("?")="Characters '|', '^', '&', '\', and '~' are not allowed."
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q ""
Q Y
;
ASKAURDT(MAXDT) ; prompt for authorization received date
;
; MAXDT = latest allowed date (required)
;
; returns date in internal FM format or 0 on user exit
;
N DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
S DIR(0)="D^:"_MAXDT_":EX"
S DIR("A")="Authorization received date"
S DIR("?",1)="Enter the date authorization was received."
S DIR("?",2)="No future date allowed."
S DIR("?")="Latest allowed date is "_$$FMTE^XLFDT(MAXDT)
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q 0
Q +Y
;
ASKSTDT(MINDT,MAXDT) ; prompt for period start date
;
; MINDT = earliest allowed date (required)
; MAXDT = latest allowed date (required)
;
; returns date in internal FM format or 0 on user exit
;
N DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
N MAXDTE,MINDTE
; get min and max dates in external format
S MINDTE=$$FMTE^XLFDT(MINDT),MAXDTE=$$FMTE^XLFDT(MAXDT)
S DIR(0)="DA^"_MINDT_":"_MAXDT_":EX"
;S DIR("A")="Additional period start date ("_MINDTE_" - "_MAXDTE_"): "
S DIR("A")="Additional period start date: "
S DIR("?",1)="Enter the start date of this 90 day period."
S DIR("?",2)="Entering past dates requires DG OTH MGR security key."
S DIR("?",3)="Earliest allowed date is "_MINDTE_"."
S DIR("?")="Latest allowed date is "_MAXDTE
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q 0
Q +Y
;
CHRCHK(STR) ; check if give string contains one of the characters '|', '^', '&', '\', '~'
;
; STR - string to check
;
; returns 1 if one of those characters is found in the string, 0 otherwise
;
Q STR["|"!(STR["^")!(STR["&")!(STR["\")!(STR["~")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGOTHMG2 11065 printed Sep 23, 2025@20:22:47 Page 2
DGOTHMG2 ;SHRPE/YMG - OTH Management actions (cont.) ;04/30/19
+1 ;;5.3;Registration;**952,977**;Aug 13, 1993;Build 177
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
AP ; add 90 day period
+1 ;
+2 ; DSPMODE, DGIEN33 and DGDFN are defined in ^DGOTHMGT
+3 ;
+4 NEW CRDTM,DAYS,DGFAC,DGFRES,DGIEN365,DGIEN90,DGUSR,DTDIFF,DTSTR90,DTSTR365,EDT365,EDT90,MAXDT,MINDT,NUM365,NUM90,PNDREQ,OTHDATA,PNDSTR
+5 NEW REQTYPE,SDT90,STARTDT,STOP,SUBDT,Z
+6 DO FULL^VALM1
DO CLEAR^VALM1
+7 SET VALMBCK="R"
+8 ; check security key
+9 IF '$$CHKKEY^DGOTHMG1("DG OTH ADD PERIOD")
Begin DoDot:1
+10 WRITE !!,"You need DG OTH ADD PERIOD security key in order to use this action!"
+11 DO ASKCONT
+12 QUIT
End DoDot:1
QUIT
+13 ; display header
DO HEADER(DGDFN)
+14 ; get data for the last 90 day period
SET Z=$$LASTPRD^DGOTHUT1(DGIEN33)
SET NUM365=$PIECE(Z,U)
SET DGIEN365=$PIECE(Z,U,2)
SET NUM90=$PIECE(Z,U,3)
SET DGIEN90=$PIECE(Z,U,4)
+15 WRITE !!,"365 Day Period: ",$SELECT(NUM365>0:NUM365,1:"None")
+16 WRITE !," 90 Day Period: ",$SELECT(NUM90>0:NUM90,1:"None")
+17 ; get dates for the last 90 day period
SET DTSTR90=$$GET90DT^DGOTHUT1(DGIEN33,$PIECE(Z,U,2),$PIECE(Z,U,4))
+18 SET SDT90=$PIECE(DTSTR90,U)
SET EDT90=$PIECE(DTSTR90,U,2)
SET DAYS=$PIECE(DTSTR90,U,3)
+19 IF SDT90>0
Begin DoDot:1
+20 WRITE !!,"The most recent 90 day period start",$SELECT(SDT90<DT:"ed on "_$$FMTE^XLFDT(SDT90),SDT90>DT:"s on "_$$FMTE^XLFDT(SDT90),1:"s today")
+21 WRITE " and end",$SELECT(EDT90<DT:"ed on "_$$FMTE^XLFDT(EDT90),EDT90>DT:"s on "_$$FMTE^XLFDT(EDT90),1:"s today")
+22 SET DTSTR365=$$GET365DT^DGOTHUT1(DGIEN33,DGIEN365)
SET EDT365=$PIECE(DTSTR365,U,2)
+23 WRITE !,"The most recent 365 day period end",$SELECT(EDT365<DT:"ed on "_$$FMTE^XLFDT(EDT365),EDT365>DT:"s on "_$$FMTE^XLFDT(EDT365),1:"s today")
+24 QUIT
End DoDot:1
+25 WRITE !!,"Days Remaining: ",$SELECT(SDT90>0:DAYS,1:"N/A")
+26 ; don't allow new 90 day period if there's already one that starts in the future
+27 IF SDT90>DT
Begin DoDot:1
+28 WRITE !!,"Latest 90 day period starts in the future (on ",$$FMTE^XLFDT(SDT90),")"
+29 WRITE !,"Authorizing another 90 day period is not allowed!"
+30 DO ASKCONT
+31 QUIT
End DoDot:1
QUIT
+32 ; display message if current 90 day period is greater than 2 (last 90 day period is greater than 1)
+33 IF NUM90>1
WRITE !!,"Patient has been authorized for 180 days or more of care",!
+34 ; get current user and facility
+35 SET DGUSR=$$UP^XLFSTR($$NAME^XUSER(DUZ,"F"))
SET DGFAC=$PIECE($$SITE^VASITE(),U)
+36 ; check for existing pending request
+37 SET PNDSTR=$$GETPEND^DGOTHUT1(DGDFN)
SET PNDREQ=$PIECE(PNDSTR,U)
+38 IF PNDREQ=-1
DO DISPERR($PIECE(PNDSTR,U,2))
QUIT
+39 IF PNDREQ
Begin DoDot:1
+40 WRITE !!,"Existing pending request:"
+41 WRITE !," Request submitted on ",$$FMTE^XLFDT($PIECE(PNDSTR,U,2)),"; response not yet received.",!
+42 QUIT
End DoDot:1
+43 ; get record creation date / time
+44 SET CRDTM=$SELECT(PNDREQ:$PIECE(PNDSTR,U,6),1:$$NOW^XLFDT())
+45 ; prompt for authorization approval
+46 SET REQTYPE=$$ASKAUAP()
IF REQTYPE=""
QUIT
+47 ; if approved request
+48 IF REQTYPE="Y"
Begin DoDot:1
+49 ; calculate date range for the start date
+50 ; earliest date allowed is the end date of the last 90 day period + 1 or today's date
+51 ; with DG OTH MGR key earliest date can be up to 15 days in the past
+52 ; latest date allowed is the earliest date + 15 days if earliest date is in the future, or today's date + 15 days if earliest date is in the past
+53 SET DTDIFF=$$FMDIFF^XLFDT(DT,EDT90,1)
+54 SET MINDT=$SELECT(DTDIFF'>0:$$FMADD^XLFDT(EDT90,1),1:DT)
+55 SET MAXDT=$$FMADD^XLFDT(MINDT,15)
+56 ; allow past date with DG OTH MGR key
+57 IF DTDIFF>0
IF $$CHKKEY^DGOTHMG1("DG OTH MGR")
SET MINDT=$SELECT(DTDIFF>15:$$FMADD^XLFDT(DT,-15),1:$$FMADD^XLFDT(EDT90,1))
+58 ; prompt for period start date
+59 SET STARTDT=$$ASKSTDT(MINDT,MAXDT)
IF STARTDT'>0
QUIT
+60 SET $PIECE(OTHDATA,U,6)=STARTDT
+61 ; put current user and facility into OTHDATA
+62 SET $PIECE(OTHDATA,U,7)=DGUSR
+63 SET $PIECE(OTHDATA,U,8)=DGFAC
+64 ; find out which 365 day period we're going to use
+65 SET $PIECE(OTHDATA,U)=$SELECT($$FMDIFF^XLFDT(STARTDT,$PIECE(DTSTR365,U,2))>0:NUM365+1,1:NUM365)
+66 ; find out which 90 day period we're going to use
+67 SET $PIECE(OTHDATA,U,2)=$SELECT($PIECE(OTHDATA,U)=NUM365:NUM90+1,1:1)
+68 ; put record creation timestamp into OTHDATA
+69 SET $PIECE(OTHDATA,U,9)=CRDTM
+70 IF $PIECE(OTHDATA,U,2)>1
SET STOP=0
Begin DoDot:2
+71 ; not the 1st 90 day period, display auth. prompts
+72 ; prompt for Date request submitted
+73 SET SUBDT=$$ASKREQDT(DT,$SELECT($PIECE(PNDSTR,U):$PIECE(PNDSTR,U,2),1:""))
IF SUBDT'>0
SET STOP=1
QUIT
+74 SET $PIECE(OTHDATA,U,3)=SUBDT
+75 ; prompt for authorized by
+76 SET Z=$$ASKAUBY()
IF Z=""
SET STOP=1
QUIT
+77 SET $PIECE(OTHDATA,U,4)=Z
+78 ; prompt for authorization received date
+79 SET Z=$$ASKAURDT(DT)
IF Z'>0
SET STOP=1
QUIT
+80 SET $PIECE(OTHDATA,U,5)=Z
+81 QUIT
End DoDot:2
IF STOP
QUIT
+82 ; file data
+83 SET DGFRES=$$FILAUTH^DGOTHUT1(DGDFN,OTHDATA)
+84 IF '+DGFRES
DO DISPERR($PIECE(DGFRES,U,2))
+85 IF +DGFRES
Begin DoDot:2
+86 WRITE !!,"The patient has been authorized for an additional 90 day period"
+87 WRITE !,"with the starting date of ",$$FMTE^XLFDT($PIECE(OTHDATA,U,6))
+88 DO ASKCONT
+89 ; switch view to approved requests
SET DSPMODE=0
+90 ; clear existing pending request, if it exists
+91 IF PNDREQ
DO CLRPND(DGDFN)
+92 ; use CHGCAP^VALM to reload VALMDDF array
KILL VALMDDF
MERGE VALMDDF=DGSVDDF("A")
DO CHGCAP^VALM("LINE","Line")
+93 ; rebuild list
DO BLD^DGOTHMGT(DSPMODE)
+94 ; rebuild header
DO BLDHDR^DGOTHMGT(DSPMODE)
+95 ; Callpoint to queue an entry in File #301.5 that will trigger
+96 ; Enrollment Full Data Transmission (ORF/ORU~ZO7) HL7 message.
+97 DO EVENT^IVMPLOG(DGDFN)
+98 QUIT
End DoDot:2
+99 QUIT
End DoDot:1
QUIT
+100 ; prompt for Date request submitted (applies to both pending and denied requests)
+101 SET SUBDT=$$ASKREQDT(DT,$SELECT($PIECE(PNDSTR,U):$PIECE(PNDSTR,U,2),1:""))
IF SUBDT'>0
QUIT
+102 ; if pending request
+103 IF REQTYPE="P"
Begin DoDot:1
+104 SET $PIECE(OTHDATA,U)=1
+105 SET $PIECE(OTHDATA,U,2)=SUBDT
+106 SET $PIECE(OTHDATA,U,3)=DGUSR
+107 SET $PIECE(OTHDATA,U,4)=DGFAC
+108 SET $PIECE(OTHDATA,U,5)=CRDTM
+109 ; file data
+110 SET DGFRES=$$FILPEND^DGOTHUT1(DGDFN,OTHDATA)
+111 IF '+DGFRES
DO DISPERR($PIECE(DGFRES,U,2))
+112 IF +DGFRES
Begin DoDot:2
+113 WRITE !!,$$CJ^XLFSTR("Pending authorization request filed successfully.",80)
DO ASKCONT
+114 ; rebuild header
DO BLDHDR^DGOTHMGT(DSPMODE)
+115 ; Callpoint to queue an entry in File #301.5 that will trigger
+116 ; Enrollment Full Data Transmission (ORF/ORU~ZO7) HL7 message.
+117 DO EVENT^IVMPLOG(DGDFN)
+118 QUIT
End DoDot:2
+119 QUIT
End DoDot:1
QUIT
+120 ; denied request (REQTYPE="N") if we got here
+121 SET Z=$$ASKAUCMT()
IF Z=""
QUIT
+122 SET $PIECE(OTHDATA,U,1)=SUBDT
+123 SET $PIECE(OTHDATA,U,2)=Z
+124 SET $PIECE(OTHDATA,U,3)=DGUSR
+125 SET $PIECE(OTHDATA,U,4)=DGFAC
+126 SET $PIECE(OTHDATA,U,5)=CRDTM
+127 SET DGFRES=$$FILDEN^DGOTHUT1(DGDFN,OTHDATA)
+128 IF '+DGFRES
DO DISPERR($PIECE(DGFRES,U,2))
+129 IF +DGFRES
Begin DoDot:1
+130 WRITE !!,$$CJ^XLFSTR("Denied authorization request filed successfully.",80)
DO ASKCONT
+131 ; switch view to denied requests
SET DSPMODE=1
+132 ; clear existing pending request, if it exists
+133 IF PNDREQ
DO CLRPND(DGDFN)
+134 ; use CHGCAP^VALM to reload VALMDDF array
KILL VALMDDF
MERGE VALMDDF=DGSVDDF("D")
DO CHGCAP^VALM("LINE","Line")
+135 ; rebuild list
DO BLD^DGOTHMGT(DSPMODE)
+136 ; rebuild header
DO BLDHDR^DGOTHMGT(DSPMODE)
+137 ; Callpoint to queue an entry in File #301.5 that will trigger
+138 ; Enrollment Full Data Transmission (ORF/ORU~ZO7) HL7 message.
+139 DO EVENT^IVMPLOG(DGDFN)
+140 QUIT
End DoDot:1
+141 QUIT
+142 ;
CLRPND(DGDFN) ; clear existing pending request
+1 ;
+2 ; DGDFN - patient's DFN
+3 ;
+4 NEW DGRES
+5 SET DGFRES=$$FILPEND^DGOTHUT1(DGDFN,"0^^^^^^")
+6 IF '+DGFRES
DO DISPERR($PIECE(DGFRES,U,2))
QUIT
+7 WRITE !!,"Existing pending request has been removed.",!
+8 QUIT
+9 ;
ASKCONT ; display "press <Enter> to continue" prompt
+1 NEW Z
+2 WRITE !!,$$CJ^XLFSTR("Press <Enter> to continue.",80)
+3 READ !,Z:DTIME
+4 QUIT
+5 ;
+1 NEW DDASH,DGNAME,DGDOB,VADM
+2 ;get patient demographics
DO DEM^VADPT
+3 SET DGNAME=VADM(1)
SET DGDOB=$PIECE(VADM(3),U,2)
+4 WRITE ?24,"START ADDITIONAL 90-DAY PERIOD"
+5 WRITE !,"Patient Name: ",DGNAME,?60,"DOB: ",DGDOB
+6 ;write dash lines
SET $PIECE(DDASH,"=",81)=""
WRITE !,DDASH,!
+7 QUIT
+8 ;
DISPERR(DGERR) ; display error message
+1 ;
+2 ; DGERR - message to display
+3 ;
+4 WRITE !!,"Error while filing OTH data:",!,DGERR
+5 DO ASKCONT
+6 QUIT
+7 ;
ASKREQDT(MAXDT,DEFDT) ; prompt for date request submitted
+1 ;
+2 ; MAXDT = latest allowed date (required)
+3 ; DEFDT = default date
+4 ;
+5 ; returns date in internal FM format or 0 on user exit
+6 ;
+7 NEW DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
+8 SET DIR(0)="D^:"_MAXDT_":EX"
+9 SET DIR("A")="Date request submitted"
+10 IF +$GET(DEFDT)>0
SET DIR("B")=$$FMTE^XLFDT(DEFDT)
+11 SET DIR("?",1)="Enter the date authorization request was submitted."
+12 SET DIR("?",2)="No future date allowed."
+13 SET DIR("?")="Latest allowed date is "_$$FMTE^XLFDT(MAXDT)
+14 DO ^DIR
+15 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT 0
+16 QUIT +Y
+17 ;
ASKAUAP() ; prompt for authorization approved
+1 ;
+2 ; returns "Y" for approved, "N" for not approved, "P" for pending, or "" on user exit
+3 ;
+4 NEW DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
+5 SET DIR(0)="SA^Y:Yes;N:No;P:Pending"
+6 SET DIR("A")="Authorization approved (Y/N/P): "
+7 SET DIR("?",1)="Select 'Y' if request has been approved."
+8 SET DIR("?",2)=" Also select 'Y' if 1st 90 day period of additional 365 day period"
+9 SET DIR("?",3)=" (approval not required)."
+10 SET DIR("?",4)="Select 'N' if request has been denied."
+11 SET DIR("?")="Select 'P' if request is still pending."
+12 DO ^DIR
+13 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT ""
+14 QUIT Y
+15 ;
ASKAUCMT() ; prompt for authorization comment
+1 ;
+2 ; returns entered comment or "" on user exit
+3 ;
+4 NEW DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
+5 SET DIR(0)="FA^1:60^K:$$CHRCHK^DGOTHMG2(X) X"
+6 SET DIR("A")="Authorization comment: "
+7 SET DIR("?",1)="Free text comment, 1 to 60 characters in length."
+8 SET DIR("?")="Characters '|', '^', '&', '\', and '~' are not allowed."
+9 DO ^DIR
+10 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT ""
+11 QUIT Y
+12 ;
ASKAUBY() ; prompt for authorized by
+1 ;
+2 ; returns name of the user selected or "" on user exit
+3 ;
+4 NEW DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
+5 SET DIR(0)="FA^1:60^K:$$CHRCHK^DGOTHMG2(X) X"
+6 SET DIR("A")="Authorized by: "
+7 SET DIR("?",1)="Free text name, 1 to 60 characters in length."
+8 SET DIR("?")="Characters '|', '^', '&', '\', and '~' are not allowed."
+9 DO ^DIR
+10 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT ""
+11 QUIT Y
+12 ;
ASKAURDT(MAXDT) ; prompt for authorization received date
+1 ;
+2 ; MAXDT = latest allowed date (required)
+3 ;
+4 ; returns date in internal FM format or 0 on user exit
+5 ;
+6 NEW DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
+7 SET DIR(0)="D^:"_MAXDT_":EX"
+8 SET DIR("A")="Authorization received date"
+9 SET DIR("?",1)="Enter the date authorization was received."
+10 SET DIR("?",2)="No future date allowed."
+11 SET DIR("?")="Latest allowed date is "_$$FMTE^XLFDT(MAXDT)
+12 DO ^DIR
+13 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT 0
+14 QUIT +Y
+15 ;
ASKSTDT(MINDT,MAXDT) ; prompt for period start date
+1 ;
+2 ; MINDT = earliest allowed date (required)
+3 ; MAXDT = latest allowed date (required)
+4 ;
+5 ; returns date in internal FM format or 0 on user exit
+6 ;
+7 NEW DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
+8 NEW MAXDTE,MINDTE
+9 ; get min and max dates in external format
+10 SET MINDTE=$$FMTE^XLFDT(MINDT)
SET MAXDTE=$$FMTE^XLFDT(MAXDT)
+11 SET DIR(0)="DA^"_MINDT_":"_MAXDT_":EX"
+12 ;S DIR("A")="Additional period start date ("_MINDTE_" - "_MAXDTE_"): "
+13 SET DIR("A")="Additional period start date: "
+14 SET DIR("?",1)="Enter the start date of this 90 day period."
+15 SET DIR("?",2)="Entering past dates requires DG OTH MGR security key."
+16 SET DIR("?",3)="Earliest allowed date is "_MINDTE_"."
+17 SET DIR("?")="Latest allowed date is "_MAXDTE
+18 DO ^DIR
+19 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT 0
+20 QUIT +Y
+21 ;
CHRCHK(STR) ; check if give string contains one of the characters '|', '^', '&', '\', '~'
+1 ;
+2 ; STR - string to check
+3 ;
+4 ; returns 1 if one of those characters is found in the string, 0 otherwise
+5 ;
+6 QUIT STR["|"!(STR["^")!(STR["&")!(STR["\")!(STR["~")
