source: WorldVistAEHR/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDFU1B.m@ 1240

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

initial load of WorldVistAEHR

File size: 5.4 KB
Line 
1IBDFU1B ;ALB/CJM - ENCOUNTER FORM ;NOV 16,1992
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
3 ;utilities
4BLKDESCR(IBBLK) ;parses the block record pointed to by IBBLK and puts the
5 ;descripition in IBBLK array - should be called by reference
6 ;returns 1 if block description is too incomplete to print block
7 Q:'$G(IBBLK) 1
8 N NODE0
9 S NODE0=$G(^IBE(357.1,IBBLK,0))
10 S IBBLK("NAME")=$P(NODE0,"^",1)
11 S IBBLK("Y")=$P(NODE0,"^",4)
12 S IBBLK("X")=$P(NODE0,"^",5)
13 S IBBLK("W")=$P(NODE0,"^",6)
14 S IBBLK("H")=$P(NODE0,"^",7)
15 S IBBLK("BOX")=$P(NODE0,"^",10)
16 S IBBLK("HDR")=$P(NODE0,"^",11)
17 S IBBLK("HDISP")=$P(NODE0,"^",12)
18 S IBBLK("S")=$P(NODE0,"^",3)
19 S IBBLK("PAGE")=1+(IBBLK("Y")\IBFORM("PAGE_HT"))
20 Q:NODE0="" 1
21 Q 0
22 ;
23RTNDSCR(RTN) ;RTN should be a pointer to the Package Interface file
24 ;RTN should be passed by reference
25 ;
26 N NODE
27 S NODE="",RTN=+$G(RTN)
28 S:RTN NODE=$G(^IBE(357.6,RTN,0))
29 S RTN("ACTION")=$P(NODE,"^",6)
30 ;
31 ;for input interfaces (mapping)
32 I RTN("ACTION")=1 D Q
33 .S RTN("AVAIL")=$P(NODE,"^",9)
34 .Q
35 ;
36 ;for output interfaces
37 I RTN("ACTION")=2 D Q
38 .N NODFN
39 .S NODFN=$P(NODE,"^",15)
40 .S RTN("NAME")=$P(NODE,"^",1)
41 .S RTN("RTN")=$P(NODE,"^",2,3)
42 .S RTN("CHANGES")=$P(NODE,"^",5)
43 .S RTN("DATATYPE")=$P(NODE,"^",7)
44 .S RTN("FULL")=$P(NODE,"^",8)
45 .S RTN("AVAIL")=$P(NODE,"^",9)
46 .S RTN("ENTRY")=$S(RTN:$G(^IBE(357.6,RTN,4)),1:"")
47 .S RTN("EXIT")=$S(RTN:$G(^IBE(357.6,RTN,5)),1:"")
48 .;determine where the interface should put the data
49 .I NODFN S RTN("DATA_LOCATION")="^TMP(""IB"",$J,""INTERFACES"","""_RTN("NAME")_""")"
50 .I 'NODFN S RTN("DATA_LOCATION")="^TMP(""IB"",$J,""INTERFACES"",+$G(DFN),"""_RTN("NAME")_""")"
51 ;
52 ;for selection interfaces
53 I RTN("ACTION")=3 D Q
54 .S RTN("NAME")=$P(NODE,"^",1)
55 .S RTN("RTN")=$P(NODE,"^",2,3)
56 .S RTN("FULL")=$P(NODE,"^",8)
57 .S RTN("AVAIL")=$P(NODE,"^",9)
58 .S RTN("DYNAMIC")=$P(NODE,"^",14)
59 .S RTN("ENTRY")=$S(RTN:$G(^IBE(357.6,RTN,4)),1:"")
60 .S RTN("EXIT")=$S(RTN:$G(^IBE(357.6,RTN,5)),1:"")
61 .S RTN("DATA_LOCATION")="^TMP(""IB"",$J,""INTERFACES"","""_RTN("NAME")_""")"
62 .S RTN("NAME",1)=$$DATANAME(RTN,1),RTN("WIDTH",1)=$$DATANODE(RTN,1)
63 .S RTN("INPUT_RTN")=$P(NODE,"^",13)
64 ;
65 ;for reports
66 I RTN("ACTION")=4 D Q
67 .S RTN("RTN")=$P(NODE,"^",2,3)
68 .S RTN("AVAIL")=$P(NODE,"^",9)
69 .S RTN("HSMRY?")=$P(NODE,"^",10)
70 .S RTN("HSMRY")=$P(NODE,"^",11)
71 .S RTN("ENTRY")=$S(RTN:$G(^IBE(357.6,RTN,4)),1:"")
72 .S RTN("EXIT")=$S(RTN:$G(^IBE(357.6,RTN,5)),1:"")
73 ;
74 ;in case the action type is not defined
75 S RTN("NAME")=$P(NODE,"^",1)
76 S RTN("RTN")=$P(NODE,"^",2,3)
77 S RTN("CHANGES")=$P(NODE,"^",5)
78 S RTN("DATATYPE")=$P(NODE,"^",7)
79 S RTN("FULL")=$P(NODE,"^",8)
80 S RTN("AVAIL")=$P(NODE,"^",9)
81 S RTN("DYNAMIC")=$P(NODE,"^",14)
82 S RTN("ENTRY")=$S(RTN:$G(^IBE(357.6,RTN,4)),1:"")
83 S RTN("EXIT")=$S(RTN:$G(^IBE(357.6,RTN,5)),1:"")
84 ;
85 ;I FULL,RTN S IEN=0 F S IEN=$O(^IBE(357.6,RTN,15,IEN)) Q:'IEN S NODE=$G(^IBE(357.6,RTN,15,IEN,0)) D
86 ;.S I=$P(NODE,"^",3)
87 ;.Q:'I
88 ;.S RTN("NODE",I)=$P(NODE,"^",4),RTN("NAME",I)=$P(NODE,"^")
89 Q
90 ;
91WARNING(OBJECT) ; displays a warning
92 S:'$D(OBJECT) OBJECT="object"
93 W !,"WARNING! The "_OBJECT_" is partially outside the block."
94 D PAUSE^IBDFU5
95 Q
96 ; ** The following routines assume BLKDESCR has been called and the IBBLK array is defined
97 ;
98MINX() ;the smallest X a block element can begin at
99 Q $S((IBBLK("BOX")=1):1,1:0)
100 ;
101MAXX() ;the largest X a block element can begin at
102 Q (IBBLK("W")-(1+$S(IBBLK("BOX")=1:1,1:0)))
103 ;
104MINY() ;the smallest Y a block element can begin at
105 Q $S(IBBLK("BOX")=1:1,1:0)
106 ;
107MAXY() ;the largest Y a block element can begin at
108 Q (IBBLK("H")-(1+$S((IBBLK("BOX")=1):1,1:0)))
109 ;
110DORTN(IBRTN) ;calls the rtn specified by the pkg interface if ok
111 ;IBRTN is an array containing data from the package interface in format returned by RTNDESCR and MUST be passed by reference
112 ;returns 0 if not successful, 1 otherwise
113 N QUIT,VARIABLE,VARIEN,IBARY
114 S QUIT=0
115 ;
116 ;set IBARY to node where the interface should return the data
117 I (IBRTN("ACTION")=2)!(IBRTN("ACTION")=3) D
118 .S IBARY=IBRTN("DATA_LOCATION")
119 .K @IBARY
120 ;
121 Q:IBRTN("AVAIL")'=1 0
122 ;
123 ;verify that required variables exist
124 S VARIEN=0 F S VARIEN=$O(^IBE(357.6,IBRTN,7,VARIEN)) Q:'VARIEN S VARIABLE=$P($G(^IBE(357.6,IBRTN,7,VARIEN,0)),"^") I '$D(@VARIABLE) S QUIT=1 Q
125 Q:QUIT 0
126 ;
127 ;new protected variables
128 S VARIEN=0 F S VARIEN=$O(^IBE(357.6,IBRTN,6,VARIEN)) Q:'VARIEN S VARIABLE=$P($G(^IBE(357.6,IBRTN,6,VARIEN,0)),"^") N @VARIABLE
129 ;
130 ;make sure the entry point is known
131 Q:$G(IBRTN("RTN"))="" 0
132 ;
133 ;make sure the entry point exists
134 Q:$P(IBRTN("RTN"),"^",2)="" 0
135 I $P(IBRTN("RTN"),"^")'="" Q:'$L($T(@$P(IBRTN("RTN"),"^")^@$P($P(IBRTN("RTN"),"^",2),"("))) 0
136 I $P(IBRTN("RTN"),"^")="" Q:'$L($T(^@$P($P(IBRTN("RTN"),"^",2),"("))) 0
137 ;
138 ;call the interface routine,xecute the entry and exit actions
139 X IBRTN("ENTRY")
140 D @IBRTN("RTN")
141 X IBRTN("EXIT")
142 Q 1
143 ;
144DATANAME(RTN,PIECE) ;returns the name of the data for field=piece
145 Q:'RTN!'PIECE ""
146 I PIECE=1 Q $P($G(^IBE(357.6,RTN,2)),"^")
147 N NODE,IEN
148 S IEN=$O(^IBE(357.6,RTN,15,"C",PIECE,0))
149 Q:'IEN ""
150 Q $P($G(^IBE(357.6,RTN,15,IEN,0)),"^")
151 ;
152DATANODE(RTN,PIECE) ;returns the node that the field=piece is on
153 Q:'RTN!'PIECE ""
154 I PIECE=1 Q ""
155 S IEN=$O(^IBE(357.6,RTN,15,"C",PIECE,0))
156 Q:'IEN ""
157 Q $P($G(^IBE(357.6,RTN,15,IEN,0)),"^",4)
158 ;
159DATATYPE(TYPE) ;returns the description of the datatype=TYPE
160 ;TYPE must be passed by reference
161 ;
162 N NODE
163 S NODE=""
164 I $G(TYPE) S NODE=$G(^IBE(359.1,TYPE,0))
165 S TYPE("SPACE")=$P(NODE,"^",6)
166 S TYPE("MAX_INPUT")=$P(NODE,"^",2)
167 S TYPE("FORMAT")=$P(NODE,"^",5)
168 Q
Note: See TracBrowser for help on using the repository browser.