source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMDLST.m@ 1800

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

initial load of WorldVistAEHR

File size: 4.2 KB
RevLine 
[613]1PXRMDLST ; SLC/PJH - Reminder Dialog Inquiry ;05/30/2000
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 ;
4 ;
5START N BY,DC,DHD,DIC,EXPAND,FLDS,FR,L,LIT,LOGIC,NOW,TO,Y
6 N PXRMFIEN,PXRMHD
7 ;
8 S LIT="ALL DIALOGS"
9 I PXRMDTYP="R" S LIT="REMINDER DIALOGS"
10 I PXRMDTYP="P" S LIT="DIALOG PROMPTS"
11 I PXRMDTYP="F" S LIT="DIALOG FORCED VALUES"
12 I PXRMDTYP="E" S LIT="DIALOG ELEMENTS"
13 I PXRMDTYP="G" S LIT="DIALOG GROUPS"
14 ;
15 ;DIC is killed by DIP.
16SELECT S DIC="^PXRMD(801.41,"
17 S DIC(0)="AEMQ"
18 S DIC("A")="Select Dialog Definition: "
19 ;Current dialog type only
20 S DIC("S")="I $P(^(0),U,4)=PXRMDTYP"
21 D ^DIC
22 I Y'=-1 D G SELECT
23 .;^DIP options
24 .D SET
25 .D DISP
26END Q
27 ;
28 ;List all (for protocol PXRM SELECTION LIST)
29 ;--------
30ALL N BY,DC,DHD,DIC,DIS,FLDS,FR,L,LIT,LOGIC,NOW,TO,Y
31 S LIT="ALL DIALOGS"
32 I PXRMDTYP="R" S LIT="REMINDER DIALOGS"
33 I PXRMDTYP="P" S LIT="DIALOG PROMPTS"
34 I PXRMDTYP="E" S LIT="DIALOG ELEMENTS"
35 I PXRMDTYP="G" S LIT="DIALOG GROUPS"
36 I PXRMDTYP="F" S LIT="DIALOG FORCED VALUES"
37 I $G(PXRMGTYP)="DLG" S LIT="REMINDER DIALOGS"
38 S Y=1
39 D SET
40 S DIC="^PXRMD(801.41,"
41 ;
42 I PXRMDTYP'="A" S DIS(0)="I $P($G(^PXRMD(801.41,D0,0)),U,4)=PXRMDTYP"
43 S BY=".01"
44 S FR=""
45 S TO=""
46 S DHD="W ?0 D HED^PXRMDLST"
47 D DISP
48 Q
49 ;
50 ;Inquire/Print Option (for protocol PXRM GENERAL INQUIRE/PRINT)
51 ;--------------------
52INQ(Y) N BY,DC,DHD,DIC,FLDS,FR,L,LOGIC,NOW,TO
53 S DIC="^PXRMD(801.41,"
54 S DIC(0)="AEMQ"
55 D SET
56 D DISP
57 Q
58 ;
59 ;Inquiry/Print for dialog edit (for protocol PXRM DIALOG SELECTION INQ)
60 ;-----------------------------
61INQ1 W IORESET
62 D START
63 Q
64 ;
65 ;
66 ;Display using print templates
67 ;-----------------------------
68DISP S L=0,FLDS="[PXRM REMINDER DIALOG]"
69 I PXRMDTYP="E" S FLDS="[PXRM DIALOG ELEMENT]"
70 I PXRMDTYP="F" S FLDS="[PXRM DIALOG FORCED VALUE]"
71 I PXRMDTYP="G" S FLDS="[PXRM DIALOG GROUP]"
72 I PXRMDTYP="P" S FLDS="[PXRM DIALOG PROMPT]"
73 I PXRMDTYP="S" S FLDS="[PXRM RESULT GROUP]"
74 I PXRMDTYP="T" S FLDS="[PXRM RESULT ELEMENT]"
75 ;
76 D EN1^DIP
77 Q
78 ;
79 ;Header
80 ;------
81HED N TEMP,TEXTLEN,TEXTHED,TEXTUND
82 S TEXTHED="REMINDER DIALOG INQUIRY"
83 S TEXTUND=$TR($J("",IOM)," ","-")
84 S TEMP=NOW_" Page "_DC
85 S TEXTLEN=$L(TEMP)
86 W TEXTHED
87 W ?(IOM-TEXTLEN),TEMP
88 W !,TEXTUND,!!
89 Q
90 ;
91 ;Get question text
92 ;-----------------
93PROMPT N DTYP,FIRST,NODE,SUB,LINE,TAB
94 S SUB=$P(X,U,2) Q:SUB=""
95 S DTYP=$P($G(^PXRMD(801.41,SUB,0)),U,4) Q:DTYP=""
96 ;Dialog element
97 I DTYP="E" D Q
98 .S NODE=0,FIRST=1,TAB=26
99 .F S NODE=$O(^PXRMD(801.41,SUB,25,NODE)) Q:'NODE D
100 ..S LINE=$G(^PXRMD(801.41,SUB,25,NODE,0))
101 ..I 'FIRST W !
102 ..I FIRST,$L(LINE)>50 W ! S TAB=2
103 ..W ?TAB,LINE
104 ;Prompt/Forced Value
105 I "FP"[DTYP W $P($G(^PXRMD(801.41,SUB,2)),U,4)
106 Q
107 ;
108SET ;Setup all the variables
109 ; Set Date for Header
110 S NOW=$$NOW^XLFDT
111 S NOW=$$FMTE^XLFDT(NOW,"1P")
112 ;
113 ;These variables need to be setup every time because DIP kills them.
114 S BY="NUMBER"
115 S (FR,TO)=+$P(Y,U,1)
116 S DHD="W ?0 D HED^PXRMDLST"
117 ;
118 Q
119 ;
120 ;Orderable item
121 ;--------------
122ORDER I '$G(D0) Q
123 N QNAM,QORDER,RIEN,RNAM
124 S RIEN=$P($G(^PXRMD(801.41,D0,1)),U,3),RNAM=""
125 I RIEN S RNAM=$P($G(^PXRMD(801.9,RIEN,0)),U)
126 I RNAM'="ORDERED" W ?24,"N/A" Q
127 S QORDER=$P($G(^PXRMD(801.41,D0,1)),U,7)
128 I 'QORDER W ?24,"None" Q
129 S QNAM=$P($G(^ORD(101.43,QORDER,0)),U) I QNAM="" S QNAM="Unknown"
130 W ?24,QNAM," (OI["_QORDER_"])"
131 Q
132 ;
133 ;Dialog ELEMENT pointed to by REMINDER DIALOGS/GROUPS
134 ;----------------------------------------------------
135REPLACE(DIEN,TAB,CUR) ;
136 Q:'$G(DIEN)
137 N DSUB,DENAM,DETYP,DTLIT,DMES
138 S DSUB=0
139 F S DSUB=$O(^PXRMD(801.41,"R",DIEN,DSUB)) Q:'DSUB D
140 .S DATA=$G(^PXRMD(801.41,DSUB,0)) Q:DATA=""
141 .S DENAM=$P(DATA,U) Q:DENAM=""
142 .S DETYP=$P(DATA,U,4) Q:DETYP=""
143 .S DTLIT="??",DMES="" S:CUR=DSUB DMES="Current "
144 .I DETYP="G" S DTLIT="Dialog Group"
145 .I DETYP="E" S DTLIT="Dialog Element"
146 .W ?TAB,DENAM_" ("_DMES_DTLIT_")",!
147 Q
148 ;
149USE(DIEN,TAB,CUR) ;
150 Q:'$G(DIEN)
151 N DSUB,DENAM,DETYP,DTLIT,DMES
152 S DSUB=0
153 F S DSUB=$O(^PXRMD(801.41,"AD",DIEN,DSUB)) Q:'DSUB D
154 .S DATA=$G(^PXRMD(801.41,DSUB,0)) Q:DATA=""
155 .S DENAM=$P(DATA,U) Q:DENAM=""
156 .S DETYP=$P(DATA,U,4) Q:DETYP=""
157 .S DTLIT="??",DMES="" S:CUR=DSUB DMES="Current "
158 .I DETYP="R" S DTLIT="Reminder Dialog"
159 .I DETYP="G" S DTLIT="Dialog Group"
160 .I DETYP="E" S DTLIT="Dialog Element"
161 .I DETYP="S" S DTLIT="Result Group"
162 .W ?TAB,DENAM_" ("_DMES_DTLIT_")",!
163 Q
Note: See TracBrowser for help on using the repository browser.