source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWOD.m@ 808

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

initial load of WorldVistAEHR
File size: 8.9 KB
Line 
1ORWOD ; SLC/GSS - Utility for Order Dialogs ; 7/24/07 9:55am
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;DEC 17, 1997;Build 242
3 ;
4 ; DBIA 5133: reading ^PXRMD file #801.41
5 ;
6 Q
7 ;
8INSTALL ;Entry point for running as post-install in OR*3*243
9 D MAIN
10 Q
11 ;
12ATWILL ;Entry point for ORDER MENU MANAGEMENT menu - ORCM MGMT opt MR
13 W !,"Compiling Med Quick Order check report..."
14 D MAIN
15 W !,"...QO check report compiled and mailed to ",$P(^VA(200,DUZ,0),U)
16 Q
17 ;
18MAIN ;Main calls for QO Reports
19 N ANCSTR,I,PSJNOPC,XMDUN,XMSUB
20 D NTRY
21 ; ANCSTR=ancestors, i.e., QO being used on a menu/Reminder Dialogs
22 F ANCSTR="Y","N" D
23 . D MAILSU
24 . D SEND(XMSUB,DUZ)
25 D CLEANUP
26 Q
27 ;
28ANCSTR ;Determine QO usage - called by XSET and MM
29 S ANCSTR="N"
30 I $O(^ORD(101.41,"AD",ODIENXT,0))!($D(^TMP("OR",$J,"RD",ODIENXT))=0) S ANCSTR="Y"
31 Q
32 ;
33XSET ;Set QO record for display
34 D ANCSTR
35 S RC=ODIENXT_U_$P(REC,U)_U_$P(REC,U,2)_U_$G(ODATYPE)_U_$G(ODAROUTE)_U_$G(ODASCHD)_U_$G(ODARATE)_U_$G(ODALIMIT)
36 Q
37 ;
38NTRY ;Entry point for compiling report
39 N AFIND,DIEN,DOSE,DSPLGRP,DSPLGPTR,GETXT,HIT,NODE3,ODALIMIT,ODARATE,ODAROUTE,ODASCHD,ODATYPE,ODIEN,ODIENXT,ORDIALOG,PTEXT,PTYPE,RC,REC,TYPE,XSET
40 K ^TMP("OR",$J)
41 S (DSPLGRP,DSPLGPTR,ODIEN,ODIENXT,TYPE)=""
42 S XSET="S RC=ODIENXT_U_$P(REC,U)_U_$P(REC,U,2)_U_$G(ODATYPE)_U_$G(ODAROUTE)_U_$G(ODASCHD)_U_$G(ODARATE)_U_$G(ODALIMIT)"
43 S DOSE=+$O(^ORD(101.41,"B","OR GTX INSTRUCTIONS",0)) ;use for MM tag
44 ;
45 ; Order Dialogs Structure, Menus - original code by Anthony Puleo
46 ; Reminder Dialog Type: (PTYPE) E=Dialog Element, G=Dialog Group
47 F PTYPE="G","E" S DIEN="" D
48 . F S DIEN=$O(^PXRMD(801.41,"TYPE",PTYPE,DIEN)) Q:DIEN'>0 D ;DBIA 5133
49 .. ; PTEXT is 'FINDING ITEM' where 101.41 refers to ^ORD(101.41)
50 .. ; Example: ^PXRMD(801.41,2515,1)="^^3^^51;ORD(101.41,"
51 .. S PTEXT=$P($G(^PXRMD(801.41,DIEN,1)),U,5),AFIND=""
52 .. I PTEXT[101.41 S ^TMP("OR",$J,"RD",$P(PTEXT,";"))=DIEN
53 .. F S AFIND=$O(^PXRMD(801.41,DIEN,3,"B",AFIND)) Q:AFIND="" D
54 ... I AFIND[101.41 S ^TMP("OR",$J,"RD",$P(AFIND,";"))=DIEN
55 ;
56 ; find IEN for the 'PSJI OR PAT FLUID OE' entry in Order Dialog File
57 S ODIEN=$O(^ORD(101.41,"AB","PSJI OR PAT FLUID OE",0))
58 ;
59 ; loop through the Display Group File, file # 100.98 and store all
60 ; Display Group entries that have a pointer to 'PSJI OR PAT FLUID OE'
61 ; in field # 4 or Default Dialog field
62 F S DSPLGRP=$O(^ORD(100.98,DSPLGRP)) Q:DSPLGRP'?1N.N D
63 . I ODIEN=$P($G(^ORD(100.98,DSPLGRP,0)),U,4) S ^TMP("OR",$J,"DG",DSPLGRP)=ODIEN
64 ;
65 ; loop though Order Dialog file in order to
66 ; find each entry that is an IV Quick Order. Do this by checking
67 ; field #4 or TYPE field for a 'Q' and then check field #5 or
68 ; DISPLAY GROUP field for a pointer to one of the display groups found
69 ; above. If both conditions are true then continue to next step,
70 ; if not, continue looping.
71 F S ODIENXT=$O(^ORD(101.41,ODIENXT)) Q:ODIENXT'?1N.N D
72 . D MM
73 . S TYPE=$P($G(^ORD(101.41,ODIENXT,0)),U,4) Q:TYPE'="Q"
74 . S DSPLGPTR=$P($G(^ORD(101.41,ODIENXT,0)),U,5) Q:$G(DSPLGPTR)="" ;no display group pointer in QO
75 . Q:'$G(^TMP("OR",$J,"DG",DSPLGPTR)) ;no such display group in compiled data
76 . S REC=^ORD(101.41,ODIENXT,0)
77 . ;
78 . K ORDIALOG
79 . ; call GETQDLG^ORCD to build the Order dialog array (ORDIALOG())
80 . D GETQDLG^ORCD(ODIENXT) S (HIT)=0
81 . ;
82 . ;ZW ORDIALOG("B") ;ORDIALOG() listing
83 . ; set variables for 'TYPE' (IV TYPE), 'ROUTE', 'SCHEDULE', 'RATE', 'LIMITATION'
84 . F I=1:1:5 S @($P("ODATYPE,ODAROUTE,ODASCHD,ODARATE,ODALIMIT",",",I))=$G(ORDIALOG($P($G(ORDIALOG("B",$P("TYPE,ROUTE,SCHEDULE,INFUSION RATE,LIMITATION",",",I))),U,2),1))
85 . ;
86 . ; Quick Orders to be displayed to end user in First List Message follow:
87 . ;
88 . ; IV TYPE is null or ROUTE is null
89 . I (ODATYPE=""!(ODAROUTE="")) D XSET S ^TMP("OR",$J,"QO",ANCSTR,$P(REC,U),1,1,0)=RC,HIT=1
90 . ;
91 . ; IV TYPE is 'I' and SCHEDULE is null
92 . I ODATYPE="I"&(ODASCHD="") D XSET S ^TMP("OR",$J,"QO",ANCSTR,$P(REC,U),2,1,0)=RC,HIT=1
93 . ;
94 . ; IV TYPE is not 'C' or null or RATE is not 1-4#.1#, integer or '@'
95 . I ODATYPE="C"!(ODATYPE="") D
96 .. Q:ODARATE["@"
97 .. Q:ODARATE?1.4N!(ODARATE?1.4N1".".1N) ;integers alone OK
98 .. S GETXT=$$GETXT(ODARATE," ml/hr")
99 .. Q:GETXT?1.4N!(GETXT?1.4N1".".1N) ;# ml/hr & #.# ml/hr Rate OK
100 .. D XSET S ^TMP("OR",$J,"QO",ANCSTR,$P(REC,U),3,1,0)=RC,HIT=1
101 . ;
102 . ; IV TYPE is 'I' but RATE not an integer minute or hour or null
103 . I ODATYPE="I"&(ODARATE'?1.N)&(ODARATE'="") D ;integer alone OK
104 .. S GETXT=$$GETXT(ODARATE," Minutes| Hours")
105 .. Q:GETXT?1.3N ;integer # Minutes & # Hours Rate OK
106 .. D XSET S ^TMP("OR",$J,"QO",ANCSTR,$P(REC,U),4,1,0)=RC,HIT=1
107 . ;
108 . ; IV LIMIT or Duration (LIMITATION) was not integer or null
109 . I ODALIMIT'?.N,ODALIMIT'="" D
110 .. Q:ODALIMIT?1.2N1"D"!(ODALIMIT?1.3N1"H")!(ODALIMIT?1.4N1"ML")!(ODALIMIT?1.4N1" ML")!(ODALIMIT?1.2N1"L")!(ODALIMIT?1.4N1"CC")!(ODALIMIT?1.4N1" CC") ;#D, #H, #ML, #L, #CC Limit OK
111 .. Q:ODALIMIT?1.2N1"d"!(ODALIMIT?1.3N1"h")!(ODALIMIT?1.4N1"ml")!(ODALIMIT?1.4n1" ml")!(ODALIMIT?1.2N1"l")!(ODALIMIT?1.4N1"cc")!(ODALIMIT?1.4N1" cc") ;#d, #h, #ml, #l, #cc Limit OK
112 .. Q:ODALIMIT?1"for "1.2N1" days" ;for # days OK
113 .. Q:ODALIMIT?1.5N1"DOSES"!(ODALIMIT?1"for a total of "1.5N1" doses") ;for a total of # doses OK
114 .. Q:ODALIMIT?1"with total volume "1.2N1"L"!(ODALIMIT?1"with total volume "1.4N1"ml")
115 .. Q:ODALIMIT?1"for "1.2N1" hours"
116 .. D XSET S ^TMP("OR",$J,"QO",ANCSTR,$P(REC,U),5,1,0)=RC,HIT=1
117 . ;
118 . ; Go get next Order Dialog entry if no potential problems
119 . I 'HIT Q
120 . ;
121 . ; If the Quick Order is in First List message then check
122 . ; the Order Dialog file #101.41, field #58 or AUTO-ACCEPT QUICK ORDER
123 . ; field. If field #58 is set to 'Y'es then set the field to 'N'o and
124 . ; then display this Quick Order in the Second List.
125 . I +$P($G(^ORD(101.41,ODIENXT,5)),U,8) D
126 .. S $P(^ORD(101.41,ODIENXT,5),U,8)="" ;uncommented, sets AUTO-ACCEPT QUICK ORDER field
127 .. D XSET S ^TMP("OR",$J,"QO",ANCSTR,$P(REC,U),7,1,0)=RC
128 Q
129 ;
130GETXT(LOOKIN,SUFFIX) ;Return text occuring prior to suffix
131 ; e.g. LOOKIN="INFUSE OVER 30 MINUTES",SUFFIX=" MINUTES" returns '30'
132 N I,ISUFFIX,RSTRG,RTXT,STRG
133 S I=0,RTXT=""
134 F S I=I+1,ISUFFIX=$P(SUFFIX,"|",I) Q:ISUFFIX="" D:$F(LOOKIN,ISUFFIX) Q:$G(RTXT)'=""
135 . S RSTRG=$RE($E(LOOKIN,1,$F(LOOKIN,ISUFFIX)-$L(ISUFFIX)-1))
136 . S RTXT=$P(RSTRG," ")
137 Q $RE(RTXT)
138 ;
139MM ;Looks for 'MM' in Order Dialog / original code logic by James Hartin
140 N ANCSTR,MMREC,NEXT,NODE3,PROMPT,VALUE
141 S NEXT=1,VALUE=""
142 F S NEXT=$O(^ORD(101.41,ODIENXT,6,NEXT)) Q:NEXT'?1N.N D
143 . S VALUE=$G(^ORD(101.41,ODIENXT,6,NEXT,1)),PROMPT=+$P($G(^(0)),U,2)
144 . S MMREC=^ORD(101.41,ODIENXT,0)
145 . ; ODIEN^NAME^DISPLAY TEXT^VALUE
146 . I PROMPT=DOSE,(VALUE["MM ") D
147 .. D ANCSTR
148 .. S ^TMP("OR",$J,"QO",ANCSTR,$P(MMREC,U),6,1,0)=ODIENXT_U_$P(MMREC,U)_U_$P(MMREC,U,2)_U_VALUE
149 Q
150 ;
151MAILSU ;Set-up MAILMAN variables and format ^TMP("OR",$J,"MAIL")
152 N DASH,DISPNAME,HDRLINE,LEGEND,LEGENDS,NEXT,NUM,NXTLINE,ODIENXT,ODQONAME,ORLEGEND,OROUT,QONAM,QOTOT,QORECORD,SPC
153 K ^TMP("OR",$J,"MAIL")
154 ;
155 ;Title of emails
156 S:ANCSTR="Y" XMSUB="MED QUICK ORDERS W/ ANCESTORS: "
157 S:ANCSTR="N" XMSUB="MED QUICK ORDERS W/O ANCESTORS: "
158 S XMSUB=XMSUB_$$HTE^XLFDT($H)
159 ;
160 ;Group 1/A="IV TYPE IS NULL OR ROUTE IS NULL"
161 ;Group 2/B="IV TYPE IS 'I' AND SCHEDULE IS NULL"
162 ;Group 3/C="IV TYPE IS NOT 'C' OR NULL OR RATE IS NOT 1-4#.1#, INTERGER OR '@'"
163 ;Group 4/D="IV TYPE IS 'I' BUT RATE NOT AN INTEGER MINUTE OR HOUR"
164 ;Group 5/E="IV LIMIT OR DURATION (LIMITATION) WAS NOT NULL OR INTEGER"
165 ;Group 6/F="ORDER DIALOGS WITH 'MM' IN THE DISPLAY TEXT"
166 ;Group 7/G="AUTO-ACCEPT QUICK ORDER WAS 'Y'es, NOW SET TO 'N'o"
167 ;
168 D NTRY^ORWOD1
169 S ODQONAME="@",SPC=" ",QOTOT=0
170 F S ODQONAME=$O(^TMP("OR",$J,"QO",ANCSTR,ODQONAME)) Q:ODQONAME="" D
171 . S (LEGENDS,ORLEGEND,QORECORD)=""
172 . F S ORLEGEND=$O(^TMP("OR",$J,"QO",ANCSTR,ODQONAME,ORLEGEND)) D Q:ORLEGEND=""
173 .. I ORLEGEND'="" S LEGENDS=LEGENDS_$C(ORLEGEND+64) S:$G(QORECORD)="" QORECORD=^TMP("OR",$J,"QO",ANCSTR,ODQONAME,ORLEGEND,1,0) Q
174 .. S NXTLINE=NXTLINE+1,QONAM=$P(QORECORD,U,2),DISPNAME=$P(QORECORD,U,3) S:DISPNAME="" DISPNAME=SPC
175 .. S OROUT=$J($P(QORECORD,U,1),5)_" "_$E(QONAM,1,30)_$E(SPC,1,30-$L(QONAM))_" "_$E(DISPNAME,1,30)_$E(SPC,1,30-$L(DISPNAME))_" "_$J(LEGENDS,6)
176 .. S ^TMP("OR",$J,"MAIL",NXTLINE,0)=OROUT,QOTOT=QOTOT+1
177 S NXTLINE=NXTLINE+1,^TMP("OR",$J,"MAIL",NXTLINE,0)=""
178 S NXTLINE=NXTLINE+1,^TMP("OR",$J,"MAIL",NXTLINE,0)=QOTOT_" = Med Quick Orders"
179 Q
180 ;
181SEND(XMSUB,USER) ;Send a MailMan message to USER
182 ; The text of the message is located in ^TMP("OR",$J,"MAIL",LineNumbers0-n)
183 ; The subject is the string XMSUB.
184 N MGIEN,MGROUP,NL,REF,XMDUZ,XMY,XMZ
185 ;
186 ;Make sure the subject does not exceed 64 characters.
187 S XMSUB=$E(XMSUB,1,64)
188 ;Make the sender the Postmaster.
189 S XMDUZ=0.5
190 ;
191RETRY ;Get the message number.
192 D XMZ^XMA2
193 I XMZ<1 G RETRY
194 ;
195 ;Load the message
196 M ^XMB(3.9,XMZ,2)=^TMP("OR",$J,"MAIL")
197 S NL=$O(^XMB(3.9,XMZ,2,""),-1)
198 S ^XMB(3.9,XMZ,2,0)="^3.92^"_+NL_U_+NL_U_DT
199 ;
200 ;Send message to USER
201 I $G(USER)'="" S XMY(DUZ)="" D ENT1^XMD Q
202 W !,"Error: No USER defined..message not sent!"
203 Q
204 ;
205CLEANUP ; Clean-up
206 K ^TMP("OR",$J)
207 Q
Note: See TracBrowser for help on using the repository browser.