- 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 Jan 18, 2025@03:47:36 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["~")