source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMINQ.m@ 846

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

initial load of WorldVistAEHR
File size: 4.9 KB
RevLine 
[613]1PXRMINQ ; SLC/PKR/PJH - Clinical Reminder inquiry routines. ;03/17/2005
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 ;
4 ;====================================================
5DISP(DIC,FLDS) ;Display detail.
6 N L
7 S L=0
8 D EN1^DIP
9 Q
10 ;
11 ;====================================================
12HEADER(TEXT) ;Display Header (see DHD variable).
13 N TEMP,TEXTLEN,TEXTUND
14 S TEXTUND=$TR($J("",IOM)," ","-")
15 S TEMP=NOW_" Page "_DC
16 S TEXTLEN=$L(TEMP)
17 W TEXT
18 W ?(IOM-TEXTLEN),TEMP
19 W !,TEXTUND,!!
20 Q
21 ;
22 ;====================================================
23LOCLIST ;Do location list inquiry.
24 N BY,DC,DHD,FLDS,FR,IENN,NOW,PXRMEDOK,PXRMFVPL,PXRMROOT,TO
25 S PXRMEDOK=1
26 S FLDS="[PXRM LOCATION LIST INQUIRY]"
27 S IENN=0
28 S PXRMROOT="^PXRMD(810.9,"
29 F Q:IENN=-1 D
30 . S IENN=$$SELECT(PXRMROOT,"Select LOCATION LIST: ","")
31 . I IENN=-1 Q
32 . D SET(IENN,"REMINDER LOCATION LIST INQUIRY")
33 . D DISP(PXRMROOT,FLDS)
34 Q
35 ;
36 ;====================================================
37REM ;Do reminder inquiry.
38 N BY,DC,DHD,FLDS,FR,IENN,NOW,PXRMFVPL,PXRMROOT,TO
39 ;Build the finding variable pointer information.
40 D BLDRLIST^PXRMVPTR(811.902,.01,.PXRMFVPL)
41 S FLDS="[PXRM DEFINITION INQUIRY]"
42 S IENN=0
43 S PXRMROOT="^PXD(811.9,"
44 F Q:IENN=-1 D
45 . S IENN=$$SELECT(PXRMROOT,"Select Reminder Definition: ","")
46 . I IENN=-1 Q
47 . D SET(IENN,"REMINDER DEFINITION INQUIRY")
48 . D DISP(PXRMROOT,FLDS)
49 Q
50 ;
51 ;====================================================
52REMVAR(VAR,IEN) ;Do reminder inquiry for reminder IEN, return formatted
53 ;output in VAR. VAR can be either a local variable or a global.
54 ;If it is a local it is indexed for the broker. If it is a global
55 ;it should be passed in closed form i.e., ^TMP("PXRMTEST",$J).
56 ;It will be returned formatted for ListMan i.e.,
57 ;^TMP("PXRMTEST",$J,N,0).
58 N %ZIS,BY,DC,DHD,DONE,FF,FILENAME,FILESPEC,FLDS,FR,GBL,HFNAME
59 N IND,IOP,NOW,PATH,PXRMFVPL,PXRMROOT,SUCCESS,TO,UNIQN
60 ;Build the finding variable pointer information.
61 D BLDRLIST^PXRMVPTR(811.902,.01,.PXRMFVPL)
62 S FLDS="[PXRM DEFINITION INQUIRY]"
63 S PXRMROOT="^PXD(811.9,"
64 D SET(IEN,"")
65 ;Make sure the PXRM WORKSTATION device exists.
66 D MKWSDEV^PXRMHOST
67 ;Set up the output file before DIP is called.
68 S PATH=$$PWD^%ZISH
69 S NOW=$$NOW^XLFDT
70 S NOW=$TR(NOW,".","")
71 S UNIQN=$J_NOW
72 S FILENAME="PXRMWSD"_UNIQN_".DAT"
73 S HFNAME=PATH_FILENAME
74 S IOP="PXRM WORKSTATION;80"
75 S %ZIS("HFSMODE")="W"
76 S %ZIS("HFSNAME")=HFNAME
77 D DISP(PXRMROOT,FLDS)
78 ;Move the host file into a global.
79 S GBL="^TMP(""PXRMINQ"",$J,1,0)"
80 S GBL=$NA(@GBL)
81 K ^TMP("PXRMINQ",$J)
82 S SUCCESS=$$FTG^%ZISH(PATH,FILENAME,GBL,3)
83 ;Look for a form feed, remove it and all subsequent lines.
84 S FF=$C(12)
85 I $G(VAR)["^" D
86 . S VAR=$NA(@VAR)
87 . S VAR=$P(VAR,")",1)
88 . S VAR=VAR_",IND,0)"
89 . S (DONE,IND)=0
90 . F Q:DONE S IND=$O(^TMP("PXRMINQ",$J,IND)) Q:+IND=0 D
91 .. I ^TMP("PXRMINQ",$J,IND,0)=FF S DONE=1 Q
92 .. S @VAR=^TMP("PXRMINQ",$J,IND,0)
93 E D
94 . S (DONE,IND)=0
95 . F Q:DONE S IND=$O(^TMP("PXRMINQ",$J,IND)) Q:+IND=0 D
96 .. S VAR(IND)=^TMP("PXRMINQ",$J,IND,0)
97 .. I VAR(IND)=FF S DONE=1
98 K ^TMP("PXRMINQ",$J)
99 ;Delete the host file.
100 S FILESPEC(FILENAME)=""
101 S SUCCESS=$$DEL^%ZISH(PATH,$NA(FILESPEC))
102 Q
103 ;
104 ;====================================================
105SELECT(ROOT,PROMPT,DEFAULT) ;Select the entry.
106 N DIC,DTOUT,DUOUT,Y
107 S DIC=ROOT
108 S DIC(0)="AEMQ"
109 S DIC("A")=PROMPT
110 I $G(DEFAULT)'="" S DIC("B")=DEFAULT
111 D ^DIC
112 Q Y
113 ;
114 ;====================================================
115SET(Y,TEXT) ;Set data for entry selection and the header.
116 ;
117 ;These variables need to be setup every time because DIP kills them.
118 ;They are newed in the calling routine.
119 S BY="NUMBER"
120 S (FR,TO)=+$P(Y,U,1)
121 ;If TEXT is null then no header.
122 I $L(TEXT)>0 D
123 . S NOW=$$NOW^XLFDT
124 . S NOW=$$FMTE^XLFDT(NOW,"1P")
125 . S DHD="W ?0 D HEADER^PXRMINQ("""_TEXT_""")"
126 E S DHD="@@"
127 Q
128 ;
129 ;====================================================
130SPONSOR ;Do sponsor inquiry.
131 N BY,DC,DHD,FLDS,FR,IENN,NOW,PXRMEDOK,PXRMFVPL,PXRMROOT,TO
132 S PXRMEDOK=1
133 S FLDS="[PXRM SPONSOR INQUIRY]"
134 S IENN=0
135 S PXRMROOT="^PXRMD(811.6,"
136 F Q:IENN=-1 D
137 . S IENN=$$SELECT(PXRMROOT,"Select Reminder Sponsor: ","")
138 . I IENN=-1 Q
139 . D SET(IENN,"REMINDER SPONSOR INQUIRY")
140 . D DISP(PXRMROOT,FLDS)
141 Q
142 ;
143 ;====================================================
144TAX ;Do taxonomy inquiry.
145 N BY,DC,DHD,FLDS,FR,IENN,NOW,PXRMFVPL,PXRMROOT,TO
146 S FLDS="[PXRM TAXONOMY INQUIRY]"
147 S IENN=0
148 S PXRMROOT="^PXD(811.2,"
149 F Q:IENN=-1 D
150 . S IENN=$$SELECT(PXRMROOT,"Select Reminder Taxonomy: ","")
151 . I IENN=-1 Q
152 . D SET(IENN,"REMINDER TAXONOMY INQUIRY")
153 . D DISP(PXRMROOT,FLDS)
154 Q
155 ;
156 ;====================================================
157TERM ;Do term inquiry.
158 N BY,DC,DHD,FLDS,FR,IENN,NOW,PXRMFVPL,PXRMROOT,TO
159 ;Build the finding variable pointer information
160 D BLDRLIST^PXRMVPTR(811.52,.01,.PXRMFVPL)
161 S FLDS="[PXRM TERM INQUIRY]"
162 S IENN=0
163 S PXRMROOT="^PXRMD(811.5,"
164 F Q:IENN=-1 D
165 . S IENN=$$SELECT(PXRMROOT,"Select Reminder Term: ","")
166 . I IENN=-1 Q
167 . D SET(IENN,"REMINDER TERM INQUIRY")
168 . D DISP(PXRMROOT,FLDS)
169 Q
170 ;
Note: See TracBrowser for help on using the repository browser.