source: FOIAVistA/tag/r/CLINICAL_REMINDERS-PXRM/PXRMDEV.m@ 636

Last change on this file since 636 was 636, checked in by George Lilly, 14 years ago

WorldVistAEHR overlayed on FOIAVistA
File size: 5.0 KB
Line 
1PXRMDEV ; SLC/PKR - This is a driver for testing Clinical Reminders.;05/04/2006
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 ;
4 ;==================================================
5CMOUT ;Do formatted Clinical Maintenance output.
6 N DUE,DUECOL,HIST,LAST,LASTCOL,LNUM,RIEN,RNAME,STATUS,STATCOL,TEMP,TYPE
7 W !!,"Formatted Output:"
8 S RIEN=$O(^TMP("PXRHM",$J,""))
9 S RNAME=$O(^TMP("PXRHM",$J,RIEN,""))
10 S TEMP=$G(^TMP("PXRHM",$J,RIEN,RNAME))
11 S STATUS=$P(TEMP,U,1)
12 S DUE=$$EDATE^PXRMDATE($P(TEMP,U,2))
13 S LAST=$$EDATE^PXRMDATE($P(TEMP,U,3))
14 S STATCOL=41-($L(STATUS)/2)
15 S DUECOL=53-($L(DUE)/2)
16 S LASTCOL=67-($L(LAST)/2)
17 W !!,?36,"--STATUS--",?47,"--DUE DATE--",?61,"--LAST DONE--",!
18 W !,RNAME,?STATCOL,STATUS,?DUECOL,DUE,?LASTCOL,LAST,!
19 S LNUM=0
20 F S LNUM=$O(^TMP("PXRHM",$J,RIEN,RNAME,"TXT",LNUM)) Q:LNUM="" D
21 . W !,^TMP("PXRHM",$J,RIEN,RNAME,"TXT",LNUM)
22 Q
23 ;
24 ;==================================================
25DEB ;Prompt for patient and reminder by name input component.
26 N DATE,DFN,DIC,DIR,DIROUT,DTOUT,DUOUT,PXRMITEM,PXRHM,PXRMTDEB,X,Y
27 S DIC=2,DIC("A")="Select Patient: "
28 S DIC(0)="AEQMZ"
29 D ^DIC
30 I $D(DTOUT)!$D(DUOUT) Q
31 S DFN=+$P(Y,U,1)
32 I DFN=-1 W !,"No patient selected!" Q
33 S DIC=811.9,DIC("A")="Select Reminder: "
34 S DIC("S")="I $P(^PXD(811.9,Y,100),U,4)'[""L"""
35 D ^DIC
36 I $D(DIROUT)!$D(DIRUT) Q
37 I $D(DTOUT)!$D(DUOUT) Q
38 S PXRMITEM=+$P(Y,U,1)
39 I PXRMITEM=-1 W !,"No reminder selected!" Q
40 S DIR(0)="LA"_U_"0"
41 S DIR("A")="Enter component number 0, 1, 5, 10, 11, 12: "
42 D ^DIR
43 I $D(DIROUT)!$D(DIRUT) Q
44 I $D(DTOUT)!$D(DUOUT) Q
45 I X="" S X=5
46 S PXRHM=X
47 S DIR(0)="DA^"_0_"::ETX"
48 S DIR("A")="Enter date for reminder evaluation: "
49 S DIR("B")=$$FMTE^XLFDT($$DT^XLFDT,"D")
50 S DIR("PRE")="S X=$$DCHECK^PXRMDATE(X) K:X=-1 X"
51 W !
52 D ^DIR K DIR
53 I $D(DIROUT)!$D(DIRUT) Q
54 I $D(DTOUT)!$D(DUOUT) Q
55 S DATE=Y
56 I $D(^PXD(811.9,PXRMITEM,20,"E","PXRMD(811.5,")) S PXRMTDEB=$$ASKYN^PXRMEUT("N","Display all term findings","","")
57 D DOREM(DFN,PXRMITEM,PXRHM,DATE)
58 Q
59 ;
60 ;==================================================
61DEV ;Prompt for patient and reminder by name and evaluation date.
62 N DATE,DFN,DIC,DIROUT,DIRUT,DTOUT,DUOUT,PXRMITEM,PXRHM,PXRMTDEB,REF,X,Y
63 S DIC=2,DIC("A")="Select Patient: "
64 S DIC(0)="AEQMZ"
65 D ^DIC
66 I $D(DIROUT)!$D(DIRUT) Q
67 I $D(DTOUT)!$D(DUOUT) Q
68 S DFN=+$P(Y,U,1)
69 S DIC=811.9,DIC("A")="Select Reminder: "
70 S DIC("S")="I $P(^PXD(811.9,Y,100),U,4)'[""L"""
71 D ^DIC
72 I $D(DIROUT)!$D(DIRUT) Q
73 I $D(DTOUT)!$D(DUOUT) Q
74 S PXRMITEM=+$P(Y,U,1)
75 S PXRHM=5
76 S DIR(0)="DA^"_0_"::ETX"
77 S DIR("A")="Enter date for reminder evaluation: "
78 S DIR("B")=$$FMTE^XLFDT($$DT^XLFDT,"D")
79 S DIR("PRE")="S X=$$DCHECK^PXRMDATE(X) K:X=-1 X"
80 W !
81 D ^DIR K DIR
82 I $D(DIROUT)!$D(DIRUT) Q
83 I $D(DTOUT)!$D(DUOUT) Q
84 S DATE=Y
85 I $D(^PXD(811.9,PXRMITEM,20,"E","PXRMD(811.5,")) S PXRMTDEB=$$ASKYN^PXRMEUT("N","Display all term findings","","")
86 D DOREM(DFN,PXRMITEM,PXRHM,DATE)
87 Q
88 ;
89 ;==================================================
90DOREM(DFN,PXRMITEM,PXRMHM,DATE) ;Do the reminder
91 N DEFARR,FIEVAL,FINDING,PXRMDEBG,PXRMID,REF,TFIEVAL
92 ;This is a debugging run so set PXRMDEBG.
93 S PXRMDEBG=1
94 D DEF^PXRMLDR(PXRMITEM,.DEFARR)
95 I +$G(DATE)=0 D EVAL^PXRM(DFN,.DEFARR,PXRHM,1,.FIEVAL)
96 I +$G(DATE)>0 D EVAL^PXRM(DFN,.DEFARR,PXRHM,1,.FIEVAL,DATE)
97 ;
98 W !!,"The elements of the FIEVAL array are:"
99 S REF="FIEVAL"
100 D AWRITE^PXRMUTIL(REF)
101 ;
102 I $G(PXRMTDEB) D
103 . W !!,"Term findings:"
104 . S REF="TFIEVAL"
105 . S FINDING=0
106 . F S FINDING=$O(^TMP("PXRMTDEB",$J,FINDING)) Q:FINDING="" D
107 .. K TFIEVAL M TFIEVAL(FINDING)=^TMP("PXRMTDEB",$J,FINDING)
108 .. W !,"Finding ",FINDING,":"
109 .. D AWRITE^PXRMUTIL(REF)
110 . K ^TMP("PXRMTDEB",$J)
111 ;
112 W !!,"The elements of the ^TMP(PXRMID,$J) array are:"
113 I $D(PXRMID) S REF="^TMP(PXRMID,$J)" D AWRITE^PXRMUTIL(REF) K ^TMP(PXRMID,$J)
114 ;
115 W !!,"The elements of the ^TMP(""PXRHM"",$J) array are:"
116 S REF="^TMP(""PXRHM"",$J)"
117 D AWRITE^PXRMUTIL(REF)
118 ;
119 I $D(^TMP("PXRHM",$J)) D CMOUT
120 I PXRHM=12 D MHVCOUT
121 K ^TMP("PXRM",$J),^TMP("PXRHM",$J),^TMP("PXRMMHVC",$J)
122 Q
123 ;==================================================
124MHVCOUT ;Do formatted MHV combined output.
125 N DUE,DUECOL,HIST,LAST,LASTCOL,LNUM,RIEN,RNAME,STATUS,STATCOL,TEMP,TYPE
126 W !!,"Formatted Output:"
127 S RIEN=$O(^TMP("PXRMMHVC",$J,""))
128 S TEMP=^TMP("PXRMMHVC",$J,RIEN,"STATUS")
129 S STATUS=$P(TEMP,U,1)
130 S DUE=$$EDATE^PXRMDATE($P(TEMP,U,2))
131 S LAST=$$EDATE^PXRMDATE($P(TEMP,U,3))
132 S DUE=$$EDATE^PXRMDATE($P(TEMP,U,2))
133 S LAST=$$EDATE^PXRMDATE($P(TEMP,U,3))
134 S STATCOL=41-($L(STATUS)/2)
135 S DUECOL=53-($L(DUE)/2)
136 S LASTCOL=67-($L(LAST)/2)
137 S RNAME=$P(^PXD(811.9,RIEN,0),U,3)
138 I RNAME="" S RNAME=$P(^PXD(811.9,RIEN,0),U,1)
139 W !!,?36,"--STATUS--",?47,"--DUE DATE--",?61,"--LAST DONE--",!
140 W !,RNAME,?STATCOL,STATUS,?DUECOL,DUE,?LASTCOL,LAST,!
141 W !!,"---------- Detailed Output ----------"
142 S LNUM=0
143 F S LNUM=$O(^TMP("PXRMMHVC",$J,RIEN,"DETAIL",LNUM)) Q:LNUM="" D
144 . W !,^TMP("PXRMMHVC",$J,RIEN,"DETAIL",LNUM)
145 W !!,"---------- Summary Output ----------"
146 S LNUM=0
147 F S LNUM=$O(^TMP("PXRMMHVC",$J,RIEN,"SUMMARY",LNUM)) Q:LNUM="" D
148 . W !,^TMP("PXRMMHVC",$J,RIEN,"SUMMARY",LNUM)
149 Q
150 ;
Note: See TracBrowser for help on using the repository browser.