PXRMOUTD ; SLC/PKR - Reminder output driver. ;04/21/2022
;;2.0;CLINICAL REMINDERS;**4,17,47,65**;Feb 04, 2005;Build 438
;
;===================================================
DUE(PXRMITEM,DEFARR,DUE,DUEDATE,RESDATE,FREQ,CRSTATUS,FIEVAL) ;Create the due information.
N LDATE,LDATEF,REFUSED,TEMP,TXT
;
I RESDATE["E" S LDATEF=+RESDATE_U_"E"
I RESDATE["X" D
. S LDATEF=+RESDATE_U_"X"
. S LDATE=0
E S LDATE=+RESDATE
I (+RESDATE)'>0 S LDATEF="unknown"
I '$D(LDATEF) S LDATEF=LDATE
;
;A reminder frequency of 0Y is a special case that means never show as
;applicable.
I (FREQ="0Y") D Q
. S ^TMP("PXRHM",$J,PXRMITEM,PXRMRNAM)="N/A"_U_U_LDATEF
;
;A reminder frequency of 99Y means do once in a lifetime. In this
;case display null for the due date.
I (LDATE>0)&(FREQ="99Y") D Q
. S ^TMP("PXRHM",$J,PXRMITEM,PXRMRNAM)="DONE"_U_""_U_LDATEF
;
I (CRSTATUS="CONTRA")!(CRSTATUS="REFUSED") D Q
. N CRDUEDATE,DISPLAYDATE
. D CRDUEDATE^PXRMDATE(CRSTATUS,.CRDUEDATE,.DEFARR,.FIEVAL)
. I CRDUEDATE="" S DISPLAYDATE="NEVER"
. E S DISPLAYDATE=$$MAX^XLFMTH(CRDUEDATE,DUEDATE)
. S ^TMP("PXRHM",$J,PXRMITEM,PXRMRNAM)=CRSTATUS_U_DISPLAYDATE_U_LDATEF
;
S ^TMP("PXRHM",$J,PXRMITEM,PXRMRNAM)=DUE_U_DUEDATE_U_LDATEF
Q
;
;===================================================
IGNNA(PXRMITEM,NOOUTPUT) ;The reminder is N/A, determine if there is
;no Clinical Maintenance output.
S NOOUTPUT=1
;Get the IGNORE ON N/A information.
N IGNORE
S IGNORE=$P(DEFARR(0),U,8)
;
;If the reminder is N/A and the ignore wildcard is set we are done.
I ($D(^TMP(PXRMPID,$J,PXRMITEM,"N/A")))&(IGNORE["*") Q
;
;Look for specific ignore codes.
I ($D(^TMP(PXRMPID,$J,PXRMITEM,"N/A","AGE")))&(IGNORE["A") Q
I ($D(^TMP(PXRMPID,$J,PXRMITEM,"N/A","INACTIVE")))&(IGNORE["I") Q
I $D(^TMP(PXRMPID,$J,PXRMITEM,"N/A","INACTIVE")) D Q
. S ^TMP("PXRHM",$J,PXRMITEM,PXRMRNAM)=""
. S ^TMP("PXRHM",$J,PXRMITEM,PXRMRNAM,"TXT",1)=^TMP(PXRMPID,$J,PXRMITEM,"N/A","INACTIVE")
I ($D(^TMP(PXRMPID,$J,PXRMITEM,"N/A","RACE")))&(IGNORE["R") Q
I ($D(^TMP(PXRMPID,$J,PXRMITEM,"N/A","SEX")))&(IGNORE["S") Q
;If we got to here there are no ignore codes so return the N/A
;information and turn the output on.
S NOOUTPUT=0
Q
;
;===================================================
OUTPUT(OUTTYPE,DEFARR,PXRMPDEM,PCLOGIC,RESLOGIC,DUE,DUEDATE,RESDATE,FREQ,CRSTATUS,FIEVAL) ;
;Produce the final output.
N NTXT S NTXT=0
;Check for a fatal error.
I $$FERROR^PXRMOUTU(.NTXT) S ^TMP("PXRHM",$J,PXRMITEM,PXRMRNAM)="ERROR" Q
;See if any warnings need to be issued.
D WARN^PXRMOUTU(PXRMITEM,.PXRMPDEM)
;
;Temporarily set CMB=CM
I OUTTYPE=4 S OUTTYPE=5
;
;If the component is CR (Reminders Due) and the reminder is not due
;we are done.
I (OUTTYPE=0)&(DUE'["DUE") K ^TMP("PXRHM",$J) Q
;
;If the reminder is N/A do the N/A part for the summary and maintenance
;components.
N NOOUTPUT
S NOOUTPUT=0
I 'PCLOGIC D
.;IGNORE ON N/A applies only to the Clinical Maintenance component.
. I OUTTYPE=5 D IGNNA(PXRMITEM,.NOOUTPUT)
. I 'NOOUTPUT D NAOUTPUT(PXRMITEM,RESDATE)
I NOOUTPUT Q
;
;If the reminder is applicable produce the due information.
I PCLOGIC D DUE(PXRMITEM,.DEFARR,DUE,DUEDATE,RESDATE,FREQ,CRSTATUS,.FIEVAL)
;
;Proudce the various output types
;Clinical maintenance output.
I OUTTYPE=5 D CM^PXRMOUTC(.DEFARR,.PXRMPDEM,PCLOGIC,RESLOGIC,RESDATE,.FIEVAL,OUTTYPE)
;Order check output.
I OUTTYPE=55 D CM^PXRMOUTC(.DEFARR,.PXRMPDEM,PCLOGIC,RESLOGIC,RESDATE,.FIEVAL,OUTTYPE)
;MyHealtheVet summary.
I OUTTYPE=10 D MHVS^PXRMOUTM(.DEFARR,.PXRMPDEM,PCLOGIC,RESLOGIC,RESDATE,.FIEVAL,1)
;MyHealtheVet detailed.
I OUTTYPE=11 D MHVD^PXRMOUTM(.DEFARR,.PXRMPDEM,PCLOGIC,RESLOGIC,RESDATE,CRSTATUS,.FIEVAL,1)
;MyHealtheVet combined.
I OUTTYPE=12 D MHVC^PXRMOUTM(.DEFARR,.PXRMPDEM,PCLOGIC,RESLOGIC,RESDATE,CRSTATUS,.FIEVAL)
;
;If there is any information stored in ^TMP("PXRHM") Health Summary
;will not display it unless ^TMP("PXRHM",$J,PXRMITEM,PXRMRNAM) has
;data in it.
I '$D(PXRMITEM)!'$D(PXRMRNAM) Q
I $D(^TMP("PXRHM",$J,PXRMITEM,PXRMRNAM))=10 S ^TMP("PXRHM",$J,PXRMITEM,PXRMRNAM)=" "
Q
;
;===================================================
NAOUTPUT(PXRMITEM,RESDATE) ;Prepare the N/A output.
N DDATE
I RESDATE["E" S DDATE=+RESDATE_U_"E"
I RESDATE["X" S DDATE=+RESDATE_U_"X"
I '$D(DDATE) S DDATE=+RESDATE
I DDATE=0 S DDATE=""
S ^TMP("PXRHM",$J,PXRMITEM,PXRMRNAM)="N/A"_U_U_DDATE
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMOUTD 4513 printed Oct 16, 2024@17:47:49 Page 2
PXRMOUTD ; SLC/PKR - Reminder output driver. ;04/21/2022
+1 ;;2.0;CLINICAL REMINDERS;**4,17,47,65**;Feb 04, 2005;Build 438
+2 ;
+3 ;===================================================
DUE(PXRMITEM,DEFARR,DUE,DUEDATE,RESDATE,FREQ,CRSTATUS,FIEVAL) ;Create the due information.
+1 NEW LDATE,LDATEF,REFUSED,TEMP,TXT
+2 ;
+3 IF RESDATE["E"
SET LDATEF=+RESDATE_U_"E"
+4 IF RESDATE["X"
Begin DoDot:1
+5 SET LDATEF=+RESDATE_U_"X"
+6 SET LDATE=0
End DoDot:1
+7 IF '$TEST
SET LDATE=+RESDATE
+8 IF (+RESDATE)'>0
SET LDATEF="unknown"
+9 IF '$DATA(LDATEF)
SET LDATEF=LDATE
+10 ;
+11 ;A reminder frequency of 0Y is a special case that means never show as
+12 ;applicable.
+13 IF (FREQ="0Y")
Begin DoDot:1
+14 SET ^TMP("PXRHM",$JOB,PXRMITEM,PXRMRNAM)="N/A"_U_U_LDATEF
End DoDot:1
QUIT
+15 ;
+16 ;A reminder frequency of 99Y means do once in a lifetime. In this
+17 ;case display null for the due date.
+18 IF (LDATE>0)&(FREQ="99Y")
Begin DoDot:1
+19 SET ^TMP("PXRHM",$JOB,PXRMITEM,PXRMRNAM)="DONE"_U_""_U_LDATEF
End DoDot:1
QUIT
+20 ;
+21 IF (CRSTATUS="CONTRA")!(CRSTATUS="REFUSED")
Begin DoDot:1
+22 NEW CRDUEDATE,DISPLAYDATE
+23 DO CRDUEDATE^PXRMDATE(CRSTATUS,.CRDUEDATE,.DEFARR,.FIEVAL)
+24 IF CRDUEDATE=""
SET DISPLAYDATE="NEVER"
+25 IF '$TEST
SET DISPLAYDATE=$$MAX^XLFMTH(CRDUEDATE,DUEDATE)
+26 SET ^TMP("PXRHM",$JOB,PXRMITEM,PXRMRNAM)=CRSTATUS_U_DISPLAYDATE_U_LDATEF
End DoDot:1
QUIT
+27 ;
+28 SET ^TMP("PXRHM",$JOB,PXRMITEM,PXRMRNAM)=DUE_U_DUEDATE_U_LDATEF
+29 QUIT
+30 ;
+31 ;===================================================
IGNNA(PXRMITEM,NOOUTPUT) ;The reminder is N/A, determine if there is
+1 ;no Clinical Maintenance output.
+2 SET NOOUTPUT=1
+3 ;Get the IGNORE ON N/A information.
+4 NEW IGNORE
+5 SET IGNORE=$PIECE(DEFARR(0),U,8)
+6 ;
+7 ;If the reminder is N/A and the ignore wildcard is set we are done.
+8 IF ($DATA(^TMP(PXRMPID,$JOB,PXRMITEM,"N/A")))&(IGNORE["*")
QUIT
+9 ;
+10 ;Look for specific ignore codes.
+11 IF ($DATA(^TMP(PXRMPID,$JOB,PXRMITEM,"N/A","AGE")))&(IGNORE["A")
QUIT
+12 IF ($DATA(^TMP(PXRMPID,$JOB,PXRMITEM,"N/A","INACTIVE")))&(IGNORE["I")
QUIT
+13 IF $DATA(^TMP(PXRMPID,$JOB,PXRMITEM,"N/A","INACTIVE"))
Begin DoDot:1
+14 SET ^TMP("PXRHM",$JOB,PXRMITEM,PXRMRNAM)=""
+15 SET ^TMP("PXRHM",$JOB,PXRMITEM,PXRMRNAM,"TXT",1)=^TMP(PXRMPID,$JOB,PXRMITEM,"N/A","INACTIVE")
End DoDot:1
QUIT
+16 IF ($DATA(^TMP(PXRMPID,$JOB,PXRMITEM,"N/A","RACE")))&(IGNORE["R")
QUIT
+17 IF ($DATA(^TMP(PXRMPID,$JOB,PXRMITEM,"N/A","SEX")))&(IGNORE["S")
QUIT
+18 ;If we got to here there are no ignore codes so return the N/A
+19 ;information and turn the output on.
+20 SET NOOUTPUT=0
+21 QUIT
+22 ;
+23 ;===================================================
OUTPUT(OUTTYPE,DEFARR,PXRMPDEM,PCLOGIC,RESLOGIC,DUE,DUEDATE,RESDATE,FREQ,CRSTATUS,FIEVAL) ;
+1 ;Produce the final output.
+2 NEW NTXT
SET NTXT=0
+3 ;Check for a fatal error.
+4 IF $$FERROR^PXRMOUTU(.NTXT)
SET ^TMP("PXRHM",$JOB,PXRMITEM,PXRMRNAM)="ERROR"
QUIT
+5 ;See if any warnings need to be issued.
+6 DO WARN^PXRMOUTU(PXRMITEM,.PXRMPDEM)
+7 ;
+8 ;Temporarily set CMB=CM
+9 IF OUTTYPE=4
SET OUTTYPE=5
+10 ;
+11 ;If the component is CR (Reminders Due) and the reminder is not due
+12 ;we are done.
+13 IF (OUTTYPE=0)&(DUE'["DUE")
KILL ^TMP("PXRHM",$JOB)
QUIT
+14 ;
+15 ;If the reminder is N/A do the N/A part for the summary and maintenance
+16 ;components.
+17 NEW NOOUTPUT
+18 SET NOOUTPUT=0
+19 IF 'PCLOGIC
Begin DoDot:1
+20 ;IGNORE ON N/A applies only to the Clinical Maintenance component.
+21 IF OUTTYPE=5
DO IGNNA(PXRMITEM,.NOOUTPUT)
+22 IF 'NOOUTPUT
DO NAOUTPUT(PXRMITEM,RESDATE)
End DoDot:1
+23 IF NOOUTPUT
QUIT
+24 ;
+25 ;If the reminder is applicable produce the due information.
+26 IF PCLOGIC
DO DUE(PXRMITEM,.DEFARR,DUE,DUEDATE,RESDATE,FREQ,CRSTATUS,.FIEVAL)
+27 ;
+28 ;Proudce the various output types
+29 ;Clinical maintenance output.
+30 IF OUTTYPE=5
DO CM^PXRMOUTC(.DEFARR,.PXRMPDEM,PCLOGIC,RESLOGIC,RESDATE,.FIEVAL,OUTTYPE)
+31 ;Order check output.
+32 IF OUTTYPE=55
DO CM^PXRMOUTC(.DEFARR,.PXRMPDEM,PCLOGIC,RESLOGIC,RESDATE,.FIEVAL,OUTTYPE)
+33 ;MyHealtheVet summary.
+34 IF OUTTYPE=10
DO MHVS^PXRMOUTM(.DEFARR,.PXRMPDEM,PCLOGIC,RESLOGIC,RESDATE,.FIEVAL,1)
+35 ;MyHealtheVet detailed.
+36 IF OUTTYPE=11
DO MHVD^PXRMOUTM(.DEFARR,.PXRMPDEM,PCLOGIC,RESLOGIC,RESDATE,CRSTATUS,.FIEVAL,1)
+37 ;MyHealtheVet combined.
+38 IF OUTTYPE=12
DO MHVC^PXRMOUTM(.DEFARR,.PXRMPDEM,PCLOGIC,RESLOGIC,RESDATE,CRSTATUS,.FIEVAL)
+39 ;
+40 ;If there is any information stored in ^TMP("PXRHM") Health Summary
+41 ;will not display it unless ^TMP("PXRHM",$J,PXRMITEM,PXRMRNAM) has
+42 ;data in it.
+43 IF '$DATA(PXRMITEM)!'$DATA(PXRMRNAM)
QUIT
+44 IF $DATA(^TMP("PXRHM",$JOB,PXRMITEM,PXRMRNAM))=10
SET ^TMP("PXRHM",$JOB,PXRMITEM,PXRMRNAM)=" "
+45 QUIT
+46 ;
+47 ;===================================================
NAOUTPUT(PXRMITEM,RESDATE) ;Prepare the N/A output.
+1 NEW DDATE
+2 IF RESDATE["E"
SET DDATE=+RESDATE_U_"E"
+3 IF RESDATE["X"
SET DDATE=+RESDATE_U_"X"
+4 IF '$DATA(DDATE)
SET DDATE=+RESDATE
+5 IF DDATE=0
SET DDATE=""
+6 SET ^TMP("PXRHM",$JOB,PXRMITEM,PXRMRNAM)="N/A"_U_U_DDATE
+7 QUIT
+8 ;
