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

DGOTHMG2.m

Go to the documentation of this file.
  1. DGOTHMG2 ;SHRPE/YMG - OTH Management actions (cont.) ;04/30/19
  1. ;;5.3;Registration;**952,977**;Aug 13, 1993;Build 177
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. Q
  1. AP ; add 90 day period
  1. ;
  1. ; DSPMODE, DGIEN33 and DGDFN are defined in ^DGOTHMGT
  1. ;
  1. N CRDTM,DAYS,DGFAC,DGFRES,DGIEN365,DGIEN90,DGUSR,DTDIFF,DTSTR90,DTSTR365,EDT365,EDT90,MAXDT,MINDT,NUM365,NUM90,PNDREQ,OTHDATA,PNDSTR
  1. N REQTYPE,SDT90,STARTDT,STOP,SUBDT,Z
  1. D FULL^VALM1,CLEAR^VALM1
  1. S VALMBCK="R"
  1. ; check security key
  1. I '$$CHKKEY^DGOTHMG1("DG OTH ADD PERIOD") D Q
  1. .W !!,"You need DG OTH ADD PERIOD security key in order to use this action!"
  1. .D ASKCONT
  1. .Q
  1. D HEADER(DGDFN) ; display header
  1. 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
  1. W !!,"365 Day Period: ",$S(NUM365>0:NUM365,1:"None")
  1. W !," 90 Day Period: ",$S(NUM90>0:NUM90,1:"None")
  1. S DTSTR90=$$GET90DT^DGOTHUT1(DGIEN33,$P(Z,U,2),$P(Z,U,4)) ; get dates for the last 90 day period
  1. S SDT90=$P(DTSTR90,U),EDT90=$P(DTSTR90,U,2),DAYS=$P(DTSTR90,U,3)
  1. I SDT90>0 D
  1. .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")
  1. .W " and end",$S(EDT90<DT:"ed on "_$$FMTE^XLFDT(EDT90),EDT90>DT:"s on "_$$FMTE^XLFDT(EDT90),1:"s today")
  1. .S DTSTR365=$$GET365DT^DGOTHUT1(DGIEN33,DGIEN365),EDT365=$P(DTSTR365,U,2)
  1. .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")
  1. .Q
  1. W !!,"Days Remaining: ",$S(SDT90>0:DAYS,1:"N/A")
  1. ; don't allow new 90 day period if there's already one that starts in the future
  1. I SDT90>DT D Q
  1. .W !!,"Latest 90 day period starts in the future (on ",$$FMTE^XLFDT(SDT90),")"
  1. .W !,"Authorizing another 90 day period is not allowed!"
  1. .D ASKCONT
  1. .Q
  1. ; display message if current 90 day period is greater than 2 (last 90 day period is greater than 1)
  1. I NUM90>1 W !!,"Patient has been authorized for 180 days or more of care",!
  1. ; get current user and facility
  1. S DGUSR=$$UP^XLFSTR($$NAME^XUSER(DUZ,"F")),DGFAC=$P($$SITE^VASITE(),U)
  1. ; check for existing pending request
  1. S PNDSTR=$$GETPEND^DGOTHUT1(DGDFN),PNDREQ=$P(PNDSTR,U)
  1. I PNDREQ=-1 D DISPERR($P(PNDSTR,U,2)) Q
  1. I PNDREQ D
  1. .W !!,"Existing pending request:"
  1. .W !," Request submitted on ",$$FMTE^XLFDT($P(PNDSTR,U,2)),"; response not yet received.",!
  1. .Q
  1. ; get record creation date / time
  1. S CRDTM=$S(PNDREQ:$P(PNDSTR,U,6),1:$$NOW^XLFDT())
  1. ; prompt for authorization approval
  1. S REQTYPE=$$ASKAUAP() I REQTYPE="" Q
  1. ; if approved request
  1. I REQTYPE="Y" D Q
  1. .; calculate date range for the start date
  1. .; earliest date allowed is the end date of the last 90 day period + 1 or today's date
  1. .; with DG OTH MGR key earliest date can be up to 15 days in the past
  1. .; 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
  1. .S DTDIFF=$$FMDIFF^XLFDT(DT,EDT90,1)
  1. .S MINDT=$S(DTDIFF'>0:$$FMADD^XLFDT(EDT90,1),1:DT)
  1. .S MAXDT=$$FMADD^XLFDT(MINDT,15)
  1. .; allow past date with DG OTH MGR key
  1. .I DTDIFF>0,$$CHKKEY^DGOTHMG1("DG OTH MGR") S MINDT=$S(DTDIFF>15:$$FMADD^XLFDT(DT,-15),1:$$FMADD^XLFDT(EDT90,1))
  1. .; prompt for period start date
  1. .S STARTDT=$$ASKSTDT(MINDT,MAXDT) I STARTDT'>0 Q
  1. .S $P(OTHDATA,U,6)=STARTDT
  1. .; put current user and facility into OTHDATA
  1. .S $P(OTHDATA,U,7)=DGUSR
  1. .S $P(OTHDATA,U,8)=DGFAC
  1. .; find out which 365 day period we're going to use
  1. .S $P(OTHDATA,U)=$S($$FMDIFF^XLFDT(STARTDT,$P(DTSTR365,U,2))>0:NUM365+1,1:NUM365)
  1. .; find out which 90 day period we're going to use
  1. .S $P(OTHDATA,U,2)=$S($P(OTHDATA,U)=NUM365:NUM90+1,1:1)
  1. .; put record creation timestamp into OTHDATA
  1. .S $P(OTHDATA,U,9)=CRDTM
  1. .I $P(OTHDATA,U,2)>1 S STOP=0 D I STOP Q
  1. ..; not the 1st 90 day period, display auth. prompts
  1. ..; prompt for Date request submitted
  1. ..S SUBDT=$$ASKREQDT(DT,$S($P(PNDSTR,U):$P(PNDSTR,U,2),1:"")) I SUBDT'>0 S STOP=1 Q
  1. ..S $P(OTHDATA,U,3)=SUBDT
  1. ..; prompt for authorized by
  1. ..S Z=$$ASKAUBY() I Z="" S STOP=1 Q
  1. ..S $P(OTHDATA,U,4)=Z
  1. ..; prompt for authorization received date
  1. ..S Z=$$ASKAURDT(DT) I Z'>0 S STOP=1 Q
  1. ..S $P(OTHDATA,U,5)=Z
  1. ..Q
  1. .; file data
  1. .S DGFRES=$$FILAUTH^DGOTHUT1(DGDFN,OTHDATA)
  1. .I '+DGFRES D DISPERR($P(DGFRES,U,2))
  1. .I +DGFRES D
  1. ..W !!,"The patient has been authorized for an additional 90 day period"
  1. ..W !,"with the starting date of ",$$FMTE^XLFDT($P(OTHDATA,U,6))
  1. ..D ASKCONT
  1. ..S DSPMODE=0 ; switch view to approved requests
  1. ..; clear existing pending request, if it exists
  1. ..I PNDREQ D CLRPND(DGDFN)
  1. ..K VALMDDF M VALMDDF=DGSVDDF("A") D CHGCAP^VALM("LINE","Line") ; use CHGCAP^VALM to reload VALMDDF array
  1. ..D BLD^DGOTHMGT(DSPMODE) ; rebuild list
  1. ..D BLDHDR^DGOTHMGT(DSPMODE) ; rebuild header
  1. ..; Callpoint to queue an entry in File #301.5 that will trigger
  1. ..; Enrollment Full Data Transmission (ORF/ORU~ZO7) HL7 message.
  1. ..D EVENT^IVMPLOG(DGDFN)
  1. ..Q
  1. .Q
  1. ; prompt for Date request submitted (applies to both pending and denied requests)
  1. S SUBDT=$$ASKREQDT(DT,$S($P(PNDSTR,U):$P(PNDSTR,U,2),1:"")) I SUBDT'>0 Q
  1. ; if pending request
  1. I REQTYPE="P" D Q
  1. .S $P(OTHDATA,U)=1
  1. .S $P(OTHDATA,U,2)=SUBDT
  1. .S $P(OTHDATA,U,3)=DGUSR
  1. .S $P(OTHDATA,U,4)=DGFAC
  1. .S $P(OTHDATA,U,5)=CRDTM
  1. .; file data
  1. .S DGFRES=$$FILPEND^DGOTHUT1(DGDFN,OTHDATA)
  1. .I '+DGFRES D DISPERR($P(DGFRES,U,2))
  1. .I +DGFRES D
  1. ..W !!,$$CJ^XLFSTR("Pending authorization request filed successfully.",80) D ASKCONT
  1. ..D BLDHDR^DGOTHMGT(DSPMODE) ; rebuild header
  1. ..; Callpoint to queue an entry in File #301.5 that will trigger
  1. ..; Enrollment Full Data Transmission (ORF/ORU~ZO7) HL7 message.
  1. ..D EVENT^IVMPLOG(DGDFN)
  1. ..Q
  1. .Q
  1. ; denied request (REQTYPE="N") if we got here
  1. S Z=$$ASKAUCMT() I Z="" Q
  1. S $P(OTHDATA,U,1)=SUBDT
  1. S $P(OTHDATA,U,2)=Z
  1. S $P(OTHDATA,U,3)=DGUSR
  1. S $P(OTHDATA,U,4)=DGFAC
  1. S $P(OTHDATA,U,5)=CRDTM
  1. S DGFRES=$$FILDEN^DGOTHUT1(DGDFN,OTHDATA)
  1. I '+DGFRES D DISPERR($P(DGFRES,U,2))
  1. I +DGFRES D
  1. .W !!,$$CJ^XLFSTR("Denied authorization request filed successfully.",80) D ASKCONT
  1. .S DSPMODE=1 ; switch view to denied requests
  1. .; clear existing pending request, if it exists
  1. .I PNDREQ D CLRPND(DGDFN)
  1. .K VALMDDF M VALMDDF=DGSVDDF("D") D CHGCAP^VALM("LINE","Line") ; use CHGCAP^VALM to reload VALMDDF array
  1. .D BLD^DGOTHMGT(DSPMODE) ; rebuild list
  1. .D BLDHDR^DGOTHMGT(DSPMODE) ; rebuild header
  1. .; Callpoint to queue an entry in File #301.5 that will trigger
  1. .; Enrollment Full Data Transmission (ORF/ORU~ZO7) HL7 message.
  1. .D EVENT^IVMPLOG(DGDFN)
  1. .Q
  1. Q
  1. ;
  1. CLRPND(DGDFN) ; clear existing pending request
  1. ;
  1. ; DGDFN - patient's DFN
  1. ;
  1. N DGRES
  1. S DGFRES=$$FILPEND^DGOTHUT1(DGDFN,"0^^^^^^")
  1. I '+DGFRES D DISPERR($P(DGFRES,U,2)) Q
  1. W !!,"Existing pending request has been removed.",!
  1. Q
  1. ;
  1. ASKCONT ; display "press <Enter> to continue" prompt
  1. N Z
  1. W !!,$$CJ^XLFSTR("Press <Enter> to continue.",80)
  1. R !,Z:DTIME
  1. Q
  1. ;
  1. N DDASH,DGNAME,DGDOB,VADM
  1. D DEM^VADPT ;get patient demographics
  1. S DGNAME=VADM(1),DGDOB=$P(VADM(3),U,2)
  1. W ?24,"START ADDITIONAL 90-DAY PERIOD"
  1. W !,"Patient Name: ",DGNAME,?60,"DOB: ",DGDOB
  1. S $P(DDASH,"=",81)="" W !,DDASH,! ;write dash lines
  1. Q
  1. ;
  1. DISPERR(DGERR) ; display error message
  1. ;
  1. ; DGERR - message to display
  1. ;
  1. W !!,"Error while filing OTH data:",!,DGERR
  1. D ASKCONT
  1. Q
  1. ;
  1. ASKREQDT(MAXDT,DEFDT) ; prompt for date request submitted
  1. ;
  1. ; MAXDT = latest allowed date (required)
  1. ; DEFDT = default date
  1. ;
  1. ; returns date in internal FM format or 0 on user exit
  1. ;
  1. N DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
  1. S DIR(0)="D^:"_MAXDT_":EX"
  1. S DIR("A")="Date request submitted"
  1. I +$G(DEFDT)>0 S DIR("B")=$$FMTE^XLFDT(DEFDT)
  1. S DIR("?",1)="Enter the date authorization request was submitted."
  1. S DIR("?",2)="No future date allowed."
  1. S DIR("?")="Latest allowed date is "_$$FMTE^XLFDT(MAXDT)
  1. D ^DIR
  1. I $D(DTOUT)!$D(DUOUT) Q 0
  1. Q +Y
  1. ;
  1. ASKAUAP() ; prompt for authorization approved
  1. ;
  1. ; returns "Y" for approved, "N" for not approved, "P" for pending, or "" on user exit
  1. ;
  1. N DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
  1. S DIR(0)="SA^Y:Yes;N:No;P:Pending"
  1. S DIR("A")="Authorization approved (Y/N/P): "
  1. S DIR("?",1)="Select 'Y' if request has been approved."
  1. S DIR("?",2)=" Also select 'Y' if 1st 90 day period of additional 365 day period"
  1. S DIR("?",3)=" (approval not required)."
  1. S DIR("?",4)="Select 'N' if request has been denied."
  1. S DIR("?")="Select 'P' if request is still pending."
  1. D ^DIR
  1. I $D(DTOUT)!$D(DUOUT) Q ""
  1. Q Y
  1. ;
  1. ASKAUCMT() ; prompt for authorization comment
  1. ;
  1. ; returns entered comment or "" on user exit
  1. ;
  1. N DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
  1. S DIR(0)="FA^1:60^K:$$CHRCHK^DGOTHMG2(X) X"
  1. S DIR("A")="Authorization comment: "
  1. S DIR("?",1)="Free text comment, 1 to 60 characters in length."
  1. S DIR("?")="Characters '|', '^', '&', '\', and '~' are not allowed."
  1. D ^DIR
  1. I $D(DTOUT)!$D(DUOUT) Q ""
  1. Q Y
  1. ;
  1. ASKAUBY() ; prompt for authorized by
  1. ;
  1. ; returns name of the user selected or "" on user exit
  1. ;
  1. N DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
  1. S DIR(0)="FA^1:60^K:$$CHRCHK^DGOTHMG2(X) X"
  1. S DIR("A")="Authorized by: "
  1. S DIR("?",1)="Free text name, 1 to 60 characters in length."
  1. S DIR("?")="Characters '|', '^', '&', '\', and '~' are not allowed."
  1. D ^DIR
  1. I $D(DTOUT)!$D(DUOUT) Q ""
  1. Q Y
  1. ;
  1. ASKAURDT(MAXDT) ; prompt for authorization received date
  1. ;
  1. ; MAXDT = latest allowed date (required)
  1. ;
  1. ; returns date in internal FM format or 0 on user exit
  1. ;
  1. N DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
  1. S DIR(0)="D^:"_MAXDT_":EX"
  1. S DIR("A")="Authorization received date"
  1. S DIR("?",1)="Enter the date authorization was received."
  1. S DIR("?",2)="No future date allowed."
  1. S DIR("?")="Latest allowed date is "_$$FMTE^XLFDT(MAXDT)
  1. D ^DIR
  1. I $D(DTOUT)!$D(DUOUT) Q 0
  1. Q +Y
  1. ;
  1. ASKSTDT(MINDT,MAXDT) ; prompt for period start date
  1. ;
  1. ; MINDT = earliest allowed date (required)
  1. ; MAXDT = latest allowed date (required)
  1. ;
  1. ; returns date in internal FM format or 0 on user exit
  1. ;
  1. N DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
  1. N MAXDTE,MINDTE
  1. ; get min and max dates in external format
  1. S MINDTE=$$FMTE^XLFDT(MINDT),MAXDTE=$$FMTE^XLFDT(MAXDT)
  1. S DIR(0)="DA^"_MINDT_":"_MAXDT_":EX"
  1. ;S DIR("A")="Additional period start date ("_MINDTE_" - "_MAXDTE_"): "
  1. S DIR("A")="Additional period start date: "
  1. S DIR("?",1)="Enter the start date of this 90 day period."
  1. S DIR("?",2)="Entering past dates requires DG OTH MGR security key."
  1. S DIR("?",3)="Earliest allowed date is "_MINDTE_"."
  1. S DIR("?")="Latest allowed date is "_MAXDTE
  1. D ^DIR
  1. I $D(DTOUT)!$D(DUOUT) Q 0
  1. Q +Y
  1. ;
  1. CHRCHK(STR) ; check if give string contains one of the characters '|', '^', '&', '\', '~'
  1. ;
  1. ; STR - string to check
  1. ;
  1. ; returns 1 if one of those characters is found in the string, 0 otherwise
  1. ;
  1. Q STR["|"!(STR["^")!(STR["&")!(STR["\")!(STR["~")