source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMFIP.m@ 794

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

initial load of FOIAVistA 6/30/08 version

File size: 5.4 KB
Line 
1PXRMFIP ; SLC/PJH - Edit/Inquire Finding Item Parameters ;03/09/2000
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 ;
4 ;General selection
5START N DIC,PXRMGTYP,PXRMHD,Y
6SELECT ;Get lists of finding types for display
7 N DEF,DEF1,DEF2 D DEF^PXRMRUTL("811.902",.DEF,.DEF1,.DEF2)
8 S PXRMHD="Finding Item Parameters",PXRMFIP="",PXRMGTYP="FIP"
9 D START^PXRMSEL(PXRMHD,PXRMGTYP,"PXRMFIP")
10 ;Should return a value
11 I PXRMFIP D G SELECT
12 .S PXRMHD="FINDING ITEM PARAMETER NAME:"
13 .;Listman option
14 .D START^PXRMGEN(PXRMHD,PXRMGTYP,PXRMFIP)
15 ;
16END Q
17 ;
18 ;List all finding item parameters (for protocol PXRM SELECTION LIST)
19 ;--------------------------------
20ALL N BY,DC,DHD,DIC,FLDS,FR,L,LOGIC,NOW,TO,Y
21 S Y=1
22 D SET
23 S DIC="^PXRMD(801.43,"
24 S BY=".01"
25 S FR=""
26 S TO=""
27 S DHD="W ?0 D HED^PXRMFIP"
28 D DISP
29 Q
30 ;
31 ;Inquire/Print Option (for protocol PXRM GENERAL INQUIRE/PRINT)
32 ;--------------------
33INQ(Y) N BY,DC,DHD,DIC,FLDS,FR,L,LOGIC,NOW,TO
34 S DIC="^PXRMD(801.43,"
35 S DIC(0)="AEMQ"
36 D SET
37 D DISP
38 Q
39 ;
40 ;Display Header (see DHD variable)
41 ;--------------
42HED N TEMP,TEXTLEN,TEXTHED,TEXTUND
43 S TEXTHED="FINDING ITEM PARAMETER LIST"
44 S TEXTUND=$TR($J("",IOM)," ","-")
45 S TEMP=NOW_" Page "_DC
46 S TEXTLEN=$L(TEMP)
47 W TEXTHED
48 W ?(IOM-TEXTLEN),TEMP
49 W !,TEXTUND,!!
50 Q
51 ;
52 ;DISPLAY (Display from FLDS array)
53 ;-------
54DISP S L=0,FLDS="[PXRM FINDING ITEM PARAMETERS]"
55 D EN1^DIP
56 Q
57 ;
58SET ;Setup all the variables
59 ; Set Date for Header
60 S NOW=$$NOW^XLFDT
61 S NOW=$$FMTE^XLFDT(NOW,"1P")
62 ;
63 ;These variables need to be setup every time because DIP kills them.
64 S BY="NUMBER"
65 S (FR,TO)=+$P(Y,U,1)
66 S DHD="W ?0 D HED^PXRMFIP"
67 ;
68 Q
69 ;
70 ;Build display for selected finding item parametr - Called from PXRMGEN
71 ;----------------------------------------------------------------------
72FIP(PXRMFIP) ;
73 N DATA,DDIS,DNAM,DIEN,DHED,DTYP,FDES,FDIS,FITEM,FGLOB,FLIT,FSUB,FTYP
74 N HED1,HED2,LCT,SUB
75 S VALMCNT=0 K ^TMP("PXRMGENS",$J),^TMP("PXRMGEN",$J)
76 ;Format headings to include finding item parameter name
77 S DATA=$G(^PXRMD(801.43,PXRMFIP,0)),FDES=$P(DATA,U),FDIS=$P(DATA,U,3)
78 S HEADER=PXRMHD_" "_FDES_" ("_$S(FDIS:"DISABLED",1:"ENABLED")_")"
79 ;Dialog ien
80 S DATA=$G(^PXRMD(801.43,PXRMFIP,0)),DIEN=$P(DATA,U,4)
81 ;Finding Item
82 S FITEM=$P(DATA,U,2),FTYP=$P(FITEM,";",2),FSUB=$P(FITEM,";")
83 S FLIT="??",FDES=$P(DATA,U)
84 I FTYP]"" S FTYP=$G(DEF1(FTYP)) S:FTYP="" FTYP="??"
85 I FSUB,FTYP'="??" D
86 .S FLIT=FTYP_"("_FSUB_")",FGLOB=U_$P(FITEM,";",2)_FSUB_",0)"
87 .S FDES=$P($G(@FGLOB),U) I FDES="" S FDES="??"
88 S HED1="Finding Type: "_FLIT
89 S HED2="Finding Item: "_FDES
90 ;Dialog details
91 I DIEN S DATA=$G(^PXRMD(801.41,DIEN,0))
92 ;Unknown pointer
93 I ('DIEN)!(DATA="") D Q
94 .S VALMCNT=VALMCNT+1
95 .S ^TMP("PXRMGEN",$J,VALMCNT,0)="Bad Pointer to Dialog File"
96 .S ^TMP("PXRMGEN",$J,"VALMCNT")=VALMCNT
97 ;Dialog type, name and disabled flag
98 S DTYP=$P(DATA,U,4)
99 S DHED=$S(DTYP="G":"Group",DTYP="E":"Element",1:"??")
100 ;
101 ;Dialog Element Details
102 I DTYP="E" D ELEMENT(DIEN,"")
103 ;
104 ;Dialog Group Details
105 I DTYP="G" D
106 .S DDIS=$P(DATA,U,3),DNAM=$P(DATA,U)
107 .S DNAM=DNAM_" ("_$S(DDIS:"DISABLED",1:"ENABLED")_")"
108 .S VALMCNT=VALMCNT+1
109 .S ^TMP("PXRMGEN",$J,VALMCNT,0)=$J("",79)
110 .S VALMCNT=VALMCNT+1
111 .S ^TMP("PXRMGEN",$J,VALMCNT,0)="Dialog Group: "_DNAM
112 .S ^TMP("PXRMGEN",$J,"VALMCNT")=VALMCNT
113 .;
114 .N DSEQ,EIEN,SUB S SUB=0
115 .;Loop through group for elements
116 .F S SUB=$O(^PXRMD(801.41,DIEN,10,SUB)) Q:'SUB D
117 ..S DATA=$G(^PXRMD(801.41,DIEN,10,SUB,0)) Q:DATA=""
118 ..S DSEQ=$P(DATA,U) Q:'DSEQ S EIEN=$P(DATA,U,2) Q:'EIEN
119 ..;Save dialog elements in sequence order
120 ..S ^TMP("PXRMGENS",$J,DSEQ)=EIEN
121 .;
122 .;Put the list into the array List Manager is using.
123 .S DSEQ="",LCT=0
124 .F S DSEQ=$O(^TMP("PXRMGENS",$J,DSEQ)) Q:DSEQ="" D
125 ..S EIEN=$G(^TMP("PXRMGENS",$J,DSEQ)) Q:'EIEN
126 ..D ELEMENT(EIEN,DSEQ)
127 .;Final linefeed
128 .S VALMCNT=VALMCNT+1
129 .S ^TMP("PXRMGEN",$J,VALMCNT,0)=$J("",79)
130 .S ^TMP("PXRMGEN",$J,"VALMCNT")=VALMCNT
131 ;
132 K ^TMP("PXRMGENS",$J)
133 ;Create headings
134 D CHGCAP^VALM("HEADER1",HED1)
135 D CHGCAP^VALM("HEADER2",HED2)
136 D CHGCAP^VALM("HEADER3","")
137 Q
138 ;
139 ;Dialog Element Details
140 ;----------------------
141ELEMENT(DIEN,DSEQ) ;
142 N DATA,DNAM,DDIS,DTXT,TSUB,TXT
143 S DATA=$G(^PXRMD(801.41,DIEN,0)) Q:DATA=""
144 S DDIS=$P(DATA,U,3),DNAM=$P(DATA,U)
145 S DNAM=DNAM_" ("_$S(DDIS:"DISABLED",1:"ENABLED")_")"
146 S TXT="Dialog Element: "_DNAM
147 I DSEQ S TXT=$J(DSEQ,2)_") "_TXT
148 I 'DSEQ S TXT=" "_TXT
149 S VALMCNT=VALMCNT+1
150 S ^TMP("PXRMGEN",$J,VALMCNT,0)=$J("",79)
151 S VALMCNT=VALMCNT+1
152 S ^TMP("PXRMGEN",$J,VALMCNT,0)=TXT
153 S ^TMP("PXRMGEN",$J,"VALMCNT")=VALMCNT
154 ;Dialog Text
155 S TSUB=0,TXT=" Dialog Text: "
156 F S TSUB=$O(^PXRMD(801.41,DIEN,25,TSUB)) Q:'TSUB D
157 .S DTXT=$G(^PXRMD(801.41,DIEN,25,TSUB,0))
158 .S VALMCNT=VALMCNT+1
159 .S ^TMP("PXRMGEN",$J,VALMCNT,0)=TXT_DTXT
160 .S ^TMP("PXRMGEN",$J,"VALMCNT")=VALMCNT,TXT=$J("",17)
161 ;Additional prompts/forced values
162 N ACNT,ADES,AIEN,ASUB,ATYP,DATA
163 S ASUB=0,ACNT=0,TXT=" Additional Prompts: "
164 F S ASUB=$O(^PXRMD(801.41,DIEN,10,ASUB)) Q:'ASUB D
165 .;Get prompt ien
166 .S AIEN=$P($G(^PXRMD(801.41,DIEN,10,ASUB,0)),U,2) Q:AIEN=""
167 .;Get description and type from dialog file
168 .S DATA=$G(^PXRMD(801.41,AIEN,0))
169 .S ADES=$P(DATA,U) I ADES="" S ADES=AIEN
170 .S ATYP="" I $P(DATA,U,4)="F" S ATYP=" (forced value)"
171 .S VALMCNT=VALMCNT+1,ACNT=ACNT+1
172 .S ^TMP("PXRMGEN",$J,VALMCNT,0)=TXT_ADES_ATYP,TXT=$J("",24)
173 .S ^TMP("PXRMGEN",$J,"VALMCNT")=VALMCNT
174 I ACNT=0 D
175 .S VALMCNT=VALMCNT+1,ACNT=ACNT+1
176 .S ^TMP("PXRMGEN",$J,VALMCNT,0)=TXT_"*NONE*"
177 .S ^TMP("PXRMGEN",$J,"VALMCNT")=VALMCNT
178 Q
Note: See TracBrowser for help on using the repository browser.