source: FOIAVistA/tag/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDFRPC.m@ 636

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

initial load of FOIAVistA 6/30/08 version
File size: 6.7 KB
Line 
1IBDFRPC ;ALB/AAS - AICS Return list of interfaces ; 2-JAN-96
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;**1,23**;APR 24, 1997
3 ;
4CLNLSTI(RESULT,CLINIC) ; -- Procedure
5 ; -- Broker call to return list of data entry elements for a clinic/patient/form
6 ; rpc := IBD GET INPUT OBJECT BY CLINIC
7 ;
8 ; -- input CLINIC = pointer to hospital location file or clinic name
9 ; Result = called by reference or use a closed global root
10 ;
11 ; -- output The format of the returned array is as follows
12 ; result(0) := count of array elements
13 ; result(n) := $p1 := pkg interface name
14 ; $p2 := pkg interface ien
15 ; $p3 := form name
16 ; $p4 := form type
17 ; $p5 := type of input object
18 ; $p6 := input object ien.
19 ; $P7 := Vital Name (vitals only)
20 ; $p8 := manual data entry supported
21 ; $p9 := Block ien
22 ; $p10 := block row
23 ; $p11 := block column
24 ;
25 N I,J,X,Y,CL1,FTYP,IBDX,FRM,CNT
26 ;
27 I $E($G(RESULT),1)="^" S ARRY=RESULT
28 E S ARRY="RESULT"
29 ;
30 K @ARRY S @ARRY@(0)="Clinic Not Found"
31 I +CLINIC'=CLINIC,CLINIC'="" S CLINIC=+$O(^SC("B",CLINIC,0))
32 G:'CLINIC CLNLSTQ
33 ;
34 ; -- find forms for clinic in clinic set up
35 ; if no form, use default form from parameters
36 S CL1=$O(^SD(409.95,"B",CLINIC,0))
37 I 'CL1 D G CLNLSTQ
38 .S @ARRY@(0)="No forms for Clinic"
39 .S FRM=$$DEFAULT Q:'FRM
40 .S @ARRY@(0)="Using Default Form"
41 .D FRMLSTI(.RESULT,FRM,11,0)
42 ;
43 S IBDX=$G(^SD(409.95,CL1,0)) F FTYP=2,3,4,5,6,8,9 I $P(IBDX,"^",FTYP)'="" S FRM=$P(IBDX,"^",FTYP) D FRMLSTI(.RESULT,FRM,FTYP,0)
44 ;
45CLNLSTQ Q
46 ;
47FRMLSTI(RESULT,FRM,FTYP,KILL,ALLOBJ) ; -- procedure
48 ; -- Broker call to return list of data entry elemets for one form
49 ; rpc := IBD GET INPUT OBJECT BY FORM
50 ;
51 ; -- input FRM := pointer to encounter form file (357) or form name
52 ; Result := Call by reference or use a closed global root
53 ; FTYP := type of form for clinic (optional)
54 ; KILL := 1 to kill results array prior to setting (default) (optional)
55 ; ALLOBJ := 1 to return all form objects, not just input objs
56 ; 0 to not kill array
57 ;
58 ; -- output The format of the returned array is as follows
59 ; Result(0) := count of array elements
60 ; Result(n) $p1 := pkg interface name
61 ; $p2 := pkg interface ien
62 ; $p3 := form name
63 ; $p4 := form type
64 ; $p5 := type of input object
65 ; $p6 := input object ien.
66 ; $p7 := Vital Name (vitals only)
67 ; $p8 := manual data entry supported
68 ; $p9 := Block ien
69 ; $p10 := block row
70 ; $p11 := block column
71 ;
72 N C,BLK,SEL,X,Y,ROW,COL,RESULT1,VITAL,CNT,ARRY,SEL1
73 I $E($G(RESULT),1)="^" S ARRY=RESULT
74 E S ARRY="RESULT"
75 ;
76 I +FRM'=FRM,FRM'="" S FRM=+$O(^IBE(357,"B",FRM,0))
77 I 'FRM S FRM=$$DEFAULT S:FRM @ARRY@(0)="Using default form" G:'FRM FRMLSTQ
78 I $G(FTYP)="" S FTYP=1
79 I $G(KILL)="" S KILL=1 K:KILL @ARRY
80 I $G(@ARRY@(0))="" S @ARRY@(0)="Form Not Found"
81 I '$G(ALLOBJ),$P($G(^IBE(357,FRM,0)),"^",12)'=1 S @ARRY@(0)="Form not scannable" G FRMLSTQ
82 ;
83 ; -- first find all the blocks
84 S X=0 F S X=$O(^IBE(357.1,"C",FRM,X)) Q:'X S BLK=X D
85 .; -- get row and column of block
86 .S ROW=$P($G(^IBE(357.1,+BLK,0)),"^",4),COL=$P(^(0),"^",5)
87 .Q:ROW=""!(COL="")
88 .;
89 .; -- now find all the selection lists with input interfaces
90 .S Y=0 F S Y=$O(^IBE(357.2,"C",BLK,Y)) Q:'Y D
91 ..S SEL=+$P($G(^IBE(357.2,+Y,0)),"^",11)
92 ..;I $P($G(^IBE(357.6,+SEL,0)),"^",13)'=""!($G(ALLOBJ)) D ; has input interface
93 ..S SEL1=$P($G(^IBE(357.6,+SEL,0)),"^",13)
94 ..I '$G(ALLOBJ) S SEL=SEL1
95 ..I $G(ALLOBJ),SEL1'="" S SEL=SEL1
96 ..Q:$G(^IBE(357.6,+SEL,0))=""
97 ..D ADDIN(.RESULT1,FRM,FTYP,SEL,3,+Y,BLK,ROW,COL)
98 ..Q
99 .;
100 .; -- find multiple choice fields
101 .S Y=0 F S Y=$O(^IBE(357.93,"C",BLK,Y)) Q:'Y D
102 ..S SEL=+$P($G(^IBE(357.93,+Y,0)),"^",6)
103 ..I $P($G(^IBE(357.6,+SEL,0)),"^",13)'="" D
104 ...S SEL=$P($G(^IBE(357.6,+SEL,0)),"^",13)
105 ...Q:$G(^IBE(357.6,+SEL,0))=""
106 ...D ADDIN(.RESULT1,FRM,FTYP,SEL,4,Y,BLK,ROW,COL)
107 ..I $P($G(^IBE(357.6,+SEL,0)),"^",6)=1 D ADDIN(.RESULT1,FRM,FTYP,SEL,4,Y,BLK,ROW,COL)
108 ..Q
109 .;
110 .; -- find Hand Print fields
111 .S Y=0 F S Y=$O(^IBE(359.94,"C",BLK,Y)) Q:'Y D
112 ..S SEL=+$P($G(^IBE(359.94,+Y,0)),"^",6)
113 ..S VITAL=""
114 ..I $P($G(^IBE(357.6,+SEL,0)),"^")["VITAL" S VITAL=$P($G(^IBE(359.1,+$P($G(^IBE(359.94,+Y,0)),"^",10),0)),"^")
115 ..I $P($G(^IBE(357.6,+SEL,0)),"^",13)'="" D
116 ...S SEL=$P($G(^IBE(357.6,+SEL,0)),"^",13)
117 ...Q:$G(^IBE(357.6,+SEL,0))=""
118 ...D ADDIN(.RESULT1,FRM,FTYP,SEL,5,Y,BLK,ROW,COL)
119 ..I $P($G(^IBE(357.6,+SEL,0)),"^",6)=1 D ADDIN(.RESULT1,FRM,FTYP,SEL,5,Y,BLK,ROW,COL,VITAL)
120 ..Q
121 .;
122 .I $G(ALLOBJ) D
123 ..; find Data fields
124 ..S Y=0 F S Y=$O(^IBE(357.5,"C",BLK,Y)) Q:'Y D ADDIN(.RESULT1,FRM,FTYP,+$P($G(^IBE(357.5,+Y,0)),"^",3),6,Y,BLK,ROW,COL)
125 ..
126 ..; find form lines
127 ..S Y=0 F S Y=$O(^IBE(357.7,"C",BLK,Y)) Q:'Y D ADDIN(.RESULT1,FRM,FTYP,"FORM LINE",7,Y,BLK,ROW,COL)
128 ..;
129 ..; find text areas
130 ..S Y=0 F S Y=$O(^IBE(357.8,"C",BLK,Y)) Q:'Y D ADDIN(.RESULT1,FRM,FTYP,"TEXT AREA",8,Y,BLK,ROW,COL)
131 .Q
132 ;
133 ; -- now set results into single array
134 S ROW="",CNT=+$G(@ARRY@(0))
135 F S ROW=$O(RESULT1(ROW)) Q:ROW="" S COL="" F S COL=$O(RESULT1(ROW,COL)) Q:COL="" D
136 .S C=0 F S C=$O(RESULT1(ROW,COL,C)) Q:C="" D
137 ..S CNT=CNT+1
138 ..S @ARRY@(CNT)=RESULT1(ROW,COL,C)
139 S @ARRY@(0)=CNT
140 K RESULT1
141 ;
142FRMLSTQ Q
143 ;
144ADDIN(RESULT1,FRM,FTYP,SEL,ITYP,ENTRY,BLK,ROW,COL,VITAL) ; --add to array
145 N ITYPE1
146 S ITYPE1=$S(ITYP=3:"LIST",ITYP=4:"MC",ITYP=5:"HP",ITYP=6:"DF",ITYP=7:"FL",ITYP=8:"TA",1:"OTHER")
147 S RESULT1(0)=$G(RESULT1(0))+1
148 S RESULT1(+ROW,+COL,RESULT1(0))=$S(+SEL:$P($G(^IBE(357.6,+SEL,0)),"^"),1:SEL)_"^"_SEL_"^"_$P($G(^IBE(357,+FRM,0)),"^")_"^"_$P($T(TYP+FTYP),";;",2)_"^"_ITYPE1_"^"_$G(ENTRY)_"^"_$G(VITAL)_"^"_$$MNL
149 S RESULT1(+ROW,+COL,RESULT1(0))=RESULT1(+ROW,+COL,RESULT1(0))_"^"_$G(BLK)_"^"_$G(ROW)_"^"_$G(COL)
150 Q
151 ;
152MNL() ; -- is manual data entry supported
153 Q $S($G(^IBE(357.6,+SEL,18))'="":1,1:0)
154 ;
155DEFAULT() ; -- find default form from parameters
156 N FRM
157 S FRM=$P($G(^IBD(357.09,1,0)),"^",4)
158 I FRM="" S FRM=$O(^IBE(357,"B","PRIMARY CARE SAMPLE V2.1",0))
159 Q FRM
160 ;
161TESTC ; -- test list by clinic
162 K TEST
163 D CLNLSTI(.TEST,25)
164 X "ZW TEST"
165 Q
166 ;
167TESTF ; -- test list by form
168 K TEST
169 D FRMLSTI(.TEST,91)
170 X "ZW TEST"
171 Q
172 ;
173TYP ; types of forms/from piece in 409.95
174 ;;
175 ;;BASIC FORM
176 ;;SUPPLIMENTAL FORM, EST. PATIENTS
177 ;;SUPPLEMENTAL FORM, FIRST VISIT
178 ;;FORM W/O PATIENT DATA
179 ;;SUPPLEMENTAL FORM
180 ;;
181 ;;SUPPLEMENTAL FORM
182 ;;SUPPLEMENTAL FORM
183 ;;
184 ;;DEFAULT FORM
185 ;;
Note: See TracBrowser for help on using the repository browser.