Routine: PXRMOUTD

PXRMOUTD ; SLC/PKR - Reminder output driver. ;10/20/2009

 ;;2.0;CLINICAL REMINDERS;**4,17**;Feb 04, 2005;Build 102

 ;===================================================

DUE(PXRMITEM,DUE,DUEDATE,RESDATE,FREQ,FIEVAL) ;Create the due information.

 N LDATE,LDATEF,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

 ;Immunizations may be marked as contraindicated. If that is the case

 ;they are never due.

 I $G(FIEVAL("CONTRAINDICATED"))=1 D  Q

 . S ^TMP("PXRHM",$J,PXRMITEM,PXRMRNAM)="NEVER"_U_DUEDATE_U_LDATEF

 ;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

 S ^TMP("PXRHM",$J,PXRMITEM,PXRMRNAM)=DUE_U_DUEDATE_U_LDATEF

 ;===================================================

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

 ;===================================================

OUTPUT(OUTTYPE,DEFARR,PXRMPDEM,PCLOGIC,RESLOGIC,DUE,DUEDATE,RESDATE,FREQ,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") 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,DUE,DUEDATE,RESDATE,FREQ,.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,.FIEVAL,1)

 ;MyHealtheVet detailed.

 I OUTTYPE=12 D MHVC^PXRMOUTM(.DEFARR,.PXRMPDEM,PCLOGIC,RESLOGIC,RESDATE,.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)=" "

 ;===================================================

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

PXRMOUTD  ; SLC/PKR - Reminder output driver. ;10/20/2009

 +1       ;;2.0;CLINICAL REMINDERS;**4,17**;Feb 04, 2005;Build 102

 +2       ;

 +3       ;===================================================

DUE(PXRMITEM,DUE,DUEDATE,RESDATE,FREQ,FIEVAL) ;Create the due information.

 +1        NEW LDATE,LDATEF,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      ;Immunizations may be marked as contraindicated. If that is the case

 +12      ;they are never due.

 +13       IF $GET(FIEVAL("CONTRAINDICATED"))=1

               Begin DoDot:1

 +14               SET ^TMP("PXRHM",$JOB,PXRMITEM,PXRMRNAM)="NEVER"_U_DUEDATE_U_LDATEF

               End DoDot:1

               QUIT

 +15      ;

 +16      ;A reminder frequency of 0Y is a special case that means never show as

 +17      ;applicable.

 +18       IF (FREQ="0Y")

               Begin DoDot:1

 +19               SET ^TMP("PXRHM",$JOB,PXRMITEM,PXRMRNAM)="N/A"_U_U_LDATEF

               End DoDot:1

               QUIT

 +20      ;

 +21      ;A reminder frequency of 99Y means do once in a lifetime. In this

 +22      ;case display null for the due date.

 +23       IF (LDATE>0)&(FREQ="99Y")

               Begin DoDot:1

 +24               SET ^TMP("PXRHM",$JOB,PXRMITEM,PXRMRNAM)="DONE"_U_""_U_LDATEF

               End DoDot:1

               QUIT

 +25      ;

 +26       SET ^TMP("PXRHM",$JOB,PXRMITEM,PXRMRNAM)=DUE_U_DUEDATE_U_LDATEF

 +27       QUIT

 +28      ;

 +29      ;===================================================

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,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")

               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,DUE,DUEDATE,RESDATE,FREQ,.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,.FIEVAL,1)

 +37      ;MyHealtheVet detailed.

 +38       IF OUTTYPE=12

               DO MHVC^PXRMOUTM(.DEFARR,.PXRMPDEM,PCLOGIC,RESLOGIC,RESDATE,.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       ;

PXRMOUTD.m