source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMDEV.m@ 1697

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

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