source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMDLG.m@ 677

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

initial load of FOIAVistA 6/30/08 version
File size: 6.2 KB
Line 
1PXRMDLG ; SLC/PJH - Reminder Dialog Edit/Inquiry ;07/29/2004
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 ;
4 ;Labels called from list 'PXRM DIALOG LIST'
5 ;
6EXIT ;Exit code
7 D CLEAN^VALM10
8 D FULL^VALM1
9 S VALMBCK="Q"
10 K ^TMP("PXRMDLG",$J)
11 K ^TMP("PXRMDLG4",$J)
12 Q
13 ;
14HDR ; Header code
15 S VALMHDR(1)=PXRMHD
16 S VALMHDR(2)=""
17 S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
18 Q
19 ;
20HELP ;Help code
21 N ORU,ORUPRMT,XQORM,PXRMTAG S PXRMTAG="GDLG"
22 D EN^VALM("PXRM DIALOG MAIN HELP")
23 Q
24 ;
25INIT ;Init
26 S VALMCNT=0
27 ;Delete any sequence numbers without dialogs
28 D CHECK
29 ;Load details of dialog
30 D BUILD(0)
31 Q
32 ;
33PEXIT ;PXRM DIALOG MENU protocol exit code
34 S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
35 ;Reset after page up or down
36 D XQORM
37 Q
38 ;
39 ;Other Subroutines
40 ;
41BUILD(INP) ;Build workfile (protocols PXRM DIALOG VIEW/LIST)
42 ;
43 ;Variable VIEW is set in the calling protocol
44 ;
45 ;0= DIALOG SUMMARY
46 ;1= DIALOG DETAILS
47 ;2= DIALOG TEXT
48 ;3= PROGRESS NOTE TEXT
49 ;4= INQUIRY (ALL FIELDS) - NO LISTMAN
50 ;5= DIALOG OVERVIEW
51 ;
52 S VIEW=INP,PXRMMODE=VIEW,VALMCNT=0,VALMBCK="R"
53 I VIEW=5 S VALMBG=1
54 K ^TMP("PXRMDLG",$J)
55 ;Headers
56 S DNAM=$P($G(^PXRMD(801.41,PXRMDIEN,0)),U)
57 I $P($G(^PXRMD(801.41,PXRMDIEN,0)),U,3)]"" D
58 .S DNAM=DNAM_" (DISABLED - "_$P($G(^PXRMD(801.41,PXRMDIEN,0)),U,3)_")"
59 S PXRMHD="DIALOG NAME: "_DNAM
60 I $P($G(^PXRMD(801.41,PXRMDIEN,0)),U,4)="R" D
61 .S PXRMHD="REMINDER "_PXRMHD
62 I $P($G(^PXRMD(801.41,PXRMDIEN,0)),U,4)="G" D
63 .S PXRMHD="DIALOG GROUP NAME: "_DNAM
64 I $P($G(^PXRMD(801.41,PXRMDIEN,100)),U)="N" D
65 .S PXRMHD=PXRMHD_" [NATIONAL] *LIMITED EDIT*"
66 D HDR
67 ;
68 N DATA,DGRP,DHED,FGLOB,FIEN,FITEM,FNAME,FNUM,FTYP,RESULT,RESNM
69 N NATIONAL,OIEN,ONAME,ONUM,PDIS,PIEN,PNAME,PTXT,PTYP,RIEN,RNAME,SEQ,SUB
70 ;Build list of finding items
71 N DEF,DEF1,DEF2 D DEF^PXRMRUTL("811.902",.DEF,.DEF1,.DEF2)
72 ;Check if nationalreminder dialog
73 S NATIONAL=0 S:$P($G(^PXRMD(801.41,PXRMDIEN,100)),U)="N" NATIONAL=1
74 ;Detail view of national dialogs allows only findings to be mapped
75 I VIEW=1,NATIONAL D ^PXRMDLG3,XQORM Q
76 ;Build Listman array
77 D ARRAY(PXRMDIEN)
78 Q
79 ;
80ARRAY(DIEN) ;Build Dialog Display in list manager
81 ;
82 N DNLOCK,NLINE,NODE,NSEL
83 S NLINE=0,NODE="PXRMDLG",NSEL=0
84 K ^TMP("PXRMDLG4",$J)
85 ;
86 S DNLOCK=$P($G(^PXRMD(801.41,DIEN,100)),U,4)
87 ;Group header
88 I $P($G(^PXRMD(801.41,DIEN,0)),U,4)="G" D
89 .D DLINE^PXRMDLG4(DIEN,"","",NODE)
90 ;Other components
91 D DETAIL^PXRMDLG4(DIEN,"",VIEW,NODE)
92 ;
93 ;Headers
94 N HDR2
95 I VIEW=0 S HDR2="Dialog Summary" I $G(VALMBG)="" S VALMBG=1
96 I VIEW=1 S HDR2="Detailed Display"
97 I VIEW=2 S HDR2="Dialog Text"
98 I VIEW=3 S HDR2="Progress Note Text"
99 I VIEW=5 S HDR2="Dialog Overview"
100 ;
101 ;Create headings
102 D CHGCAP^VALM("HEADER1","Item Seq.")
103 D CHGCAP^VALM("HEADER2",HDR2)
104 D CHGCAP^VALM("HEADER3","")
105 ;
106 S VALMCNT=NLINE
107 S ^TMP(NODE,$J,"VALMCNT")=VALMCNT
108 ;
109 D XQORM
110 Q
111 ;
112CHECK ;Search for sequence numbers with no dialog pointer
113 N CNT,DA,DCNT,DEL,DELTMP,IEN,NODE,SCNT,SEQ,SEQTMP,SNUM
114 S IEN=PXRMDIEN,DEL="",(CNT,DA,SCNT)=0
115 F S DA=$O(^PXRMD(801.41,IEN,10,DA)) Q:+DA=0 S NODE=^PXRMD(801.41,IEN,10,DA,0) D
116 . I NODE'[U S CNT=CNT+1 S DELTMP(CNT)=DA
117 . I NODE[U S SCNT=SCNT+1 S SEQTMP($P($G(NODE),U),SCNT)=DA
118 I CNT>0 D DELBLANK(IEN,.DELTMP)
119 S (SNUM,SEQ)=0
120 F S SEQ=$O(SEQTMP(SEQ)) Q:SEQ="" S DCNT=0 F S SNUM=$O(SEQTMP(SEQ,SNUM)) Q:+SNUM=0 S DCNT=DCNT+1 I DCNT>1 S DELTMP(DCNT)=SEQTMP(SEQ,SNUM) S DEL="Y"
121 I DEL="Y" D DELBLANK(IEN,.DELTMP)
122 Q
123 ;
124DELBLANK(IEN,DELTMP) ;Delete dialog multiple entry if dialog missing
125 N NUM,DA
126 S DA(1)=IEN
127 S NUM=0
128 F S NUM=$O(DELTMP(NUM)) Q:NUM="" D
129 . S DA=DELTMP(NUM) Q:'DA
130 . S DIK="^PXRMD(801.41,"_DA(1)_",10,"
131 . D ^DIK
132 K DIK
133 Q
134 ;
135DESC(FIEN) ;Finding description
136 ;Determine finding type
137 S FGLOB=$P(FIEN,";",2) Q:FGLOB=""
138 S FITEM=$P(FIEN,";") Q:FITEM=""
139 ;Diagnosis POV
140 I FGLOB["ICD9" D Q
141 .S FTYP="DIAGNOSIS",FGLOB=U_FGLOB_FITEM_",0)"
142 .S FNAME=$P($G(@FGLOB),U,3)_" ["_FITEM_"]"
143 ;Procedure CPT
144 I FGLOB["ICPT" D Q
145 .S FTYP="PROCEDURE",FGLOB=U_FGLOB_FITEM_",0)"
146 .S FNAME=$P($G(@FGLOB),U,2)_" ["_FITEM_"]"
147 ;Quick order
148 I FGLOB["ORD(101.41" D Q
149 .S FTYP="QUICK ORDER",FGLOB=U_FGLOB_FITEM_",0)"
150 .S FNAME=$P($G(@FGLOB),U,2)_" ["_FITEM_"]"
151 ;Short name for finding type
152 S FTYP=$G(DEF1(FGLOB)) Q:FTYP=""
153 S FNUM=" ["_FTYP_"("_FITEM_")]"
154 ;Long name
155 S FTYP=$G(DEF2(FTYP))
156 S FGLOB=U_FGLOB_FITEM_",0)"
157 S FNAME=$P($G(@FGLOB),U,1)
158 I FNAME="" S FNAME=$P($G(@FGLOB),U)
159 I FNAME]"" S FNAME=FNAME_FNUM Q
160 S FNAME=FITEM
161 Q
162 ;
163LIT(INP) ;Find description for dialog type
164 Q:INP="G" "Dialog group: "
165 Q:INP="F" "Forced value: "
166 Q:INP="P" "Prompt: "
167 Q:INP="E" "Dialog element: "
168 Q "???"
169 ;
170REMD ;Reminder Details
171 N ARRAY,SUB
172 ;Change listman headings
173 D CHGCAP^VALM("HEADER1","Reminder Inquiry")
174 D CHGCAP^VALM("HEADER2","")
175 D CHGCAP^VALM("HEADER3","")
176 ;Check if dialog is linked to a reminder
177 I 'PXRMITEM D Q
178 .S ^TMP("PXRMDLG",$J,2,0)=" *This dialog is not linked to a reminder*"
179 ;Build array using print template
180 D REMVAR^PXRMINQ(.ARRAY,PXRMITEM)
181 ;Copy into Listman global
182 S SUB=0
183 F S SUB=$O(ARRAY(SUB)) Q:'SUB D
184 .S VALMCNT=SUB
185 .S ^TMP("PXRMDLG",$J,VALMCNT,0)=ARRAY(VALMCNT)
186 Q
187 ;
188SEL ;PXRM DIALOG SELECTION ITEM validation
189 N ERR,IEN,SEL
190 S VALMBCK="",SEL=+$P(XQORNOD(0),"=",2)
191 ;Invalid selection
192 I ('SEL)!(SEL>VALMCNT)!('$D(@VALMAR@("IDX",SEL))) D Q
193 .W !,SEL_" is not an existing item number" H 2
194 ;Valid selection
195 S IEN=$O(@VALMAR@("IDX",SEL,"")) Q:'IEN
196 ;Copy/Delete/Edit dialog element
197 D IND^PXRMDEDI(IEN,SEL)
198 Q
199 ;
200XQORM ;Protocol Menu reset
201 S XQORM("#")=$O(^ORD(101,"B","PXRM DIALOG SELECTION ITEM",0))
202 S XQORM("#")=XQORM("#")_U_"1:"_VALMCNT
203 S XQORM("A")="Select Item: "
204 I PXRMGTYP="DLGE" D
205 .N FMENU
206 .S FMENU=$O(^ORD(101,"B","PXRM DIALOG GROUP MENU",0))_";ORD(101,"
207 .I FMENU S XQORM("HIJACK")=FMENU
208 I $G(PXRMDIEN)'="",$P($G(^PXRMD(801.41,PXRMDIEN,100)),U,4)=1,'$G(PXRMINST) D
209 .N FMENU
210 .S FMENU=$O(^ORD(101,"B","PXRM DIALOG LOCK",0))_";ORD(101,"
211 .I FMENU S XQORM("HIJACK")=FMENU
212 Q
213 ;
214XHLP(CALL) ;General help text routine.
215 N HTEXT
216 N DIWF,DIWL,DIWR,IC
217 S DIWF="C75",DIWL=0,DIWR=75
218 ;
219 I CALL=1 D
220 .S HTEXT(1)="Enter Yes to if you are adding a new sequence number or"
221 .S HTEXT(2)="dialog element to this reminder dialog."
222 K ^UTILITY($J,"W")
223 S IC=""
224 F S IC=$O(HTEXT(IC)) Q:IC="" D
225 . S X=HTEXT(IC)
226 . D ^DIWP
227 W !
228 S IC=0
229 F S IC=$O(^UTILITY($J,"W",0,IC)) Q:IC="" D
230 . W !,^UTILITY($J,"W",0,IC,0)
231 K ^UTILITY($J,"W")
232 W !
233 Q
Note: See TracBrowser for help on using the repository browser.