source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMOUTD.m@ 794

Last change on this file since 794 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.0 KB
Line 
1PXRMOUTD ; SLC/PKR - Reminder output driver. ;08/02/2005
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 ;
4 ;===================================================
5DUE(PXRMITEM,DUE,DUEDATE,RESDATE,FREQ,FIEVAL) ;Create the due information.
6 N LDATE,LDATEF,TEMP,TXT
7 ;
8 I RESDATE["E" S LDATEF=+RESDATE_U_"E"
9 I RESDATE["X" D
10 . S LDATEF=+RESDATE_U_"X"
11 . S LDATE=0
12 E S LDATE=+RESDATE
13 I (+RESDATE)'>0 S LDATEF="unknown"
14 I '$D(LDATEF) S LDATEF=LDATE
15 ;
16 ;Immunizations may be marked as contraindicated. If that is the case
17 ;they are never due.
18 I $G(FIEVAL("CONTRAINDICATED"))=1 D Q
19 . S ^TMP("PXRHM",$J,PXRMITEM,PXRMRNAM)="NEVER"_U_DUEDATE_U_LDATEF
20 ;
21 ;A reminder frequency of 0Y is a special case that means never show as
22 ;applicable.
23 I (FREQ="0Y") D Q
24 . S ^TMP("PXRHM",$J,PXRMITEM,PXRMRNAM)="N/A"_U_U_LDATEF
25 ;
26 ;A reminder frequency of 99Y means do once in a lifetime. In this
27 ;case display null for the due date.
28 I (LDATE>0)&(FREQ="99Y") D Q
29 . S ^TMP("PXRHM",$J,PXRMITEM,PXRMRNAM)="DONE"_U_""_U_LDATEF
30 ;
31 S ^TMP("PXRHM",$J,PXRMITEM,PXRMRNAM)=DUE_U_DUEDATE_U_LDATEF
32 Q
33 ;
34 ;===================================================
35IGNNA(PXRMITEM,NOOUTPUT) ;The reminder is N/A, determine if there is
36 ;no Clinical Maintenance output.
37 S NOOUTPUT=1
38 ;Get the IGNORE ON N/A information.
39 N IGNORE
40 S IGNORE=$P(DEFARR(0),U,8)
41 ;
42 ;If the reminder is N/A and the ignore wildcard is set we are done.
43 I ($D(^TMP(PXRMPID,$J,PXRMITEM,"N/A")))&(IGNORE["*") Q
44 ;
45 ;Look for specific ignore codes.
46 I ($D(^TMP(PXRMPID,$J,PXRMITEM,"N/A","AGE")))&(IGNORE["A") Q
47 I ($D(^TMP(PXRMPID,$J,PXRMITEM,"N/A","INACTIVE")))&(IGNORE["I") Q
48 I $D(^TMP(PXRMPID,$J,PXRMITEM,"N/A","INACTIVE")) D Q
49 . S ^TMP("PXRHM",$J,PXRMITEM,PXRMRNAM)=""
50 . S ^TMP("PXRHM",$J,PXRMITEM,PXRMRNAM,"TXT",1)=^TMP(PXRMPID,$J,PXRMITEM,"N/A","INACTIVE")
51 I ($D(^TMP(PXRMPID,$J,PXRMITEM,"N/A","RACE")))&(IGNORE["R") Q
52 I ($D(^TMP(PXRMPID,$J,PXRMITEM,"N/A","SEX")))&(IGNORE["S") Q
53 ;If we got to here there are no ignore codes so return the N/A
54 ;information and turn the output on.
55 S NOOUTPUT=0
56 Q
57 ;
58 ;===================================================
59OUTPUT(OUTTYPE,DEFARR,PXRMPDEM,PCLOGIC,RESLOGIC,DUE,DUEDATE,RESDATE,FREQ,FIEVAL) ;
60 ;Produce the final output.
61 N NTXT S NTXT=0
62 ;Check for a fatal error.
63 I $$FERROR^PXRMOUTU(.NTXT) S ^TMP("PXRHM",$J,PXRMITEM,PXRMRNAM)="ERROR" Q
64 ;See if any warnings need to be issued.
65 D WARN^PXRMOUTU(PXRMITEM,.PXRMPDEM)
66 ;
67 ;Temporarily set CMB=CM
68 I OUTTYPE=4 S OUTTYPE=5
69 ;
70 ;If the component is CR (Reminders Due) and the reminder is not due
71 ;we are done.
72 I (OUTTYPE=0)&(DUE'["DUE") Q
73 ;
74 ;If the reminder is N/A do the N/A part for the summary and maintenance
75 ;components.
76 N NOOUTPUT
77 S NOOUTPUT=0
78 I 'PCLOGIC D
79 .;IGNORE ON N/A applies only to the Clinical Maintenance component.
80 .;This is the line causing the difference.
81 . I OUTTYPE=5 D IGNNA(PXRMITEM,.NOOUTPUT)
82 . I 'NOOUTPUT D NAOUTPUT(PXRMITEM,RESDATE)
83 I NOOUTPUT Q
84 ;
85 ;If the reminder is applicable produce the due information.
86 I PCLOGIC D DUE(PXRMITEM,DUE,DUEDATE,RESDATE,FREQ,.FIEVAL)
87 ;
88 ;Proudce the various output types
89 ;Clinical maintenance output.
90 I OUTTYPE=5 D CM^PXRMOUTC(.DEFARR,.PXRMPDEM,PCLOGIC,RESLOGIC,RESDATE,.FIEVAL)
91 ;MyHealtheVet summary.
92 I OUTTYPE=10 D MHVS^PXRMOUTM(.DEFARR,.PXRMPDEM,PCLOGIC,RESLOGIC,RESDATE,.FIEVAL,1)
93 ;MyHealtheVet detailed.
94 I OUTTYPE=11 D MHVD^PXRMOUTM(.DEFARR,.PXRMPDEM,PCLOGIC,RESLOGIC,RESDATE,.FIEVAL,1)
95 ;MyHealtheVet detailed.
96 I OUTTYPE=12 D MHVC^PXRMOUTM(.DEFARR,.PXRMPDEM,PCLOGIC,RESLOGIC,RESDATE,.FIEVAL)
97 ;
98 ;If there is any information stored in ^TMP("PXRHM") Health Summary
99 ;will not display it unless ^TMP("PXRHM",$J,PXRMITEM,PXRMRNAM) has
100 ;data in it.
101 I '$D(PXRMITEM)!'$D(PXRMRNAM) Q
102 I $D(^TMP("PXRHM",$J,PXRMITEM,PXRMRNAM))=10 S ^TMP("PXRHM",$J,PXRMITEM,PXRMRNAM)=" "
103 Q
104 ;
105 ;===================================================
106NAOUTPUT(PXRMITEM,RESDATE) ;Prepare the N/A output.
107 N DDATE
108 I RESDATE["E" S DDATE=+RESDATE_U_"E"
109 I RESDATE["X" S DDATE=+RESDATE_U_"X"
110 I '$D(DDATE) S DDATE=+RESDATE
111 I DDATE=0 S DDATE=""
112 S ^TMP("PXRHM",$J,PXRMITEM,PXRMRNAM)="N/A"_U_U_DDATE
113 Q
114 ;
Note: See TracBrowser for help on using the repository browser.