source: WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLUCM009.m@ 1259

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

initial load of WorldVistAEHR

File size: 6.5 KB
Line 
1HLUCM009 ;CIOFO-O/LJA - HL7/Capacity Mgt API-II ;2/25/03-08:50
2 ;;1.6;HEALTH LEVEL SEVEN;**103**;Oct 13, 1995
3 ;
4IEN870(IEN772) ; Given 772 find 870...
5 N DATA,I773,I870,IEN
6 S DATA=$G(^HL(772,+IEN772,0))
7 ;
8 ; Logical Link field...
9 S IEN=$P(DATA,U,11) I IEN QUIT IEN ;->
10 ;
11 ; Related Event Protocol...
12 S IEN=$P(DATA,U,10),IEN=$P($G(^ORD(101,+IEN,770)),U,7) I IEN QUIT IEN ;->
13 ;
14 S I773=0
15 F S I773=$O(^HLMA("B",IEN772,I773)) Q:I773'>0 D QUIT:I870
16 . S I870=$P($G(^HLMA(+I773,0)),U,7)
17 I $G(I870) QUIT +I870 ;->
18 ;
19 QUIT ""
20 ;
21MSGTYPE(IEN772) ; MSG or MSA's type...
22 N DEL,IN
23 S IN=$G(^HL(772,+IEN772,"IN",1,0)) QUIT:IN']"" "MSG" ;->
24 S DEL=$E(IN,4) QUIT:DEL']"" "MSG" ;->
25 S IN=$P(IN,DEL,2) QUIT:IN']"" "MSG" ;->
26 I $L(IN)=2,$E(IN)="C"!($E(IN)="A") QUIT IN ;->
27 QUIT "MSG"
28 ;
29KILLS(WHEN) ; Kills of ^TMP data WHEN (START or END or ALL)
30 N DATA
31 ;
32 ; If ALL, set WHEN to include START and END...
33 S:WHEN="ALL" WHEN="STARTandEND"
34 ;
35 ; Always KILLs...
36 F DATA="ACTUAL","HLCHILD",$G(TOTALS)_"ERRTIME","HLOAD772","N","HLNMSP94","HLNMSPXRF","HLPARENT","HLRECNM","U","X" D
37 . KILL ^TMP(DATA,$J),^TMP($J,DATA)
38 ;
39 ; START-only KILLs...
40 I WHEN["START" D
41 . F DATA="HLUCMSTORE","RFAC",$G(TOTALS) D
42 . . QUIT:DATA']"" ;-> Sometimes TOTALS might not be defined
43 . . KILL ^TMP(DATA,$J),^TMP($J,DATA)
44 ;
45 ; END-only KILLs...
46 I WHEN["END" D
47 . KILL HLAPI
48 . ; Don't store any debug global data...
49 . I $G(^TMP($J,"HLUCM"))'="DEBUG GLOBAL" KILL ^TMP($J)
50 . F DATA="HL4","HLUCM","HLUCMDT" D
51 . . KILL ^TMP($J,DATA),^TMP(DATA,$J)
52 ;
53 QUIT
54 ;
55SITESMSH(TXT) ; Return location pieces, slightly modified...
56 N DIV,P4,P6
57 S DIV=$E(TXT,4),P4=$P(TXT,DIV,4),P6=$P(TXT,DIV,6)
58 S P4=$S(P4?1.N1"~"!(P4?1.N):+P4,1:"")
59 S P6=$S(P6?1.N1"~"!(P6?1.N):+P6,1:"")
60 QUIT P4_U_P6
61 ;
62MAILTYPE(MIEN) ; Is MSH in Mailman message local or remote...
63 N IEN,RECNO,TO,TOID,TYPE
64 S TYPE="L"
65 KILL ^TMP($J,"HLMAILTYPE")
66 D QD^XMXUTIL3(+MIEN,,,,,"^TMP($J,""HLMAILTYPE"")")
67 S RECNO=0
68 F S RECNO=$O(^TMP($J,"HLMAILTYPE","XMLIST",RECNO)) Q:RECNO'>0!(TYPE'="L") D
69 . S TO=$G(^TMP($J,"HLMAILTYPE","XMLIST",+RECNO,"TO"))
70 . S TOID=$G(^TMP($J,"HLMAILTYPE","XMLIST",+RECNO,"TO ID"))
71 . I TO["@"!(TOID="R") S TYPE="R"
72 KILL ^TMP($J,"HLMAILTYPE")
73 QUIT TYPE
74 ;
75NMSPXRF ; Xref of namespaces that can be inferred. (If start with DG change to DG)
76 N I,T KILL ^TMP($J,"HLNMSPXRF") F I=2:1 S T=$T(NMSPXRF+I) Q:T'[";;" S T=$P(T,";;",2,99),^TMP($J,"HLNMSPXRF",$P(T,U))=$P(T,U,2)
77 ;;DG^DG
78 ;;GM^GM
79 ;;HEC^HEC
80 ;;IB^IB
81 ;;IVM^IVM
82 ;;LA^LA
83 ;;MPI^MPI
84 ;;OR^OR
85 ;;PR^PR
86 ;;PS^PS
87 ;;RG^RG
88 ;;ROR^ROR
89 ;;SC^SC
90 ;;VEI^VEIB
91 ;;XM^XMB
92 ;;XU^XU
93 ;;XW^XWB
94 Q
95 ;
96ACCUMLAT(CATEGORY,TYPE,SORT,SUB1,SUB2,SUB3,SUB4) ; Generic accumulator
97 ;
98 I $G(SUB4)]"" D
99 . S TOTCURR=$G(^TMP(TOTALS,$J,CATEGORY,TYPE,SORT,SUB1,SUB2,SUB3,SUB4))
100 . D INCR^HLUCM001
101 . S ^TMP(TOTALS,$J,CATEGORY,TYPE,SORT,SUB1,SUB2,SUB3,SUB4)=TOTCURR
102 ;
103 S TOTCURR=$G(^TMP(TOTALS,$J,CATEGORY,TYPE,SORT,SUB1,SUB2,SUB3))
104 D INCR^HLUCM001
105 S ^TMP(TOTALS,$J,CATEGORY,TYPE,SORT,SUB1,SUB2,SUB3)=TOTCURR
106 ;
107 ; Totals level 2 for SUB...
108 S TOTCURR=$G(^TMP(TOTALS,$J,CATEGORY,TYPE,SORT,SUB1,SUB2))
109 D INCR^HLUCM001
110 S ^TMP(TOTALS,$J,CATEGORY,TYPE,SORT,SUB1,SUB2)=TOTCURR
111 ;
112 ; Totals level 1 for SUB...
113 S TOTCURR=$G(^TMP(TOTALS,$J,CATEGORY,TYPE,SORT,SUB1))
114 D INCR^HLUCM001
115 S ^TMP(TOTALS,$J,CATEGORY,TYPE,SORT,SUB1)=TOTCURR
116 ;
117 ; Total level TYPE/SORT...
118 S TOTCURR=$G(^TMP(TOTALS,$J,CATEGORY,TYPE,SORT))
119 D INCR^HLUCM001
120 S ^TMP(TOTALS,$J,CATEGORY,TYPE,SORT)=TOTCURR
121 ;
122 ; Total level TYPE
123 S TOTCURR=$G(^TMP(TOTALS,$J,CATEGORY,TYPE))
124 D INCR^HLUCM001
125 S ^TMP(TOTALS,$J,CATEGORY,TYPE)=TOTCURR
126 ;
127 ; Total level CATEGORY
128 ; [Don't subtotal here, for NMSP holds two different TYPEs, and
129 ; if totalled here, it would double count.]
130 ;
131 QUIT
132 ;
133LOAD772S(IEN772,HLNMSP) ; Load list of related 772s... [HL*1.6*91]
134 ;
135 ; Warning!!! This call point will never load more than 20 entries...
136 ; Any more than that, and probably an error condition
137 ; exists.
138 ;
139 N ACKTO,CHILD,DATA,FAC,HL772,HLI,HLJ,HLK,HLN,HLPCKG,HLZZI,HOLDNMSP,I
140 N I772,I773,MSGID,NUM,PARENT,PCKG,PIEN,PROT,TOTNUM,VAL,X
141 ;
142 KILL HLNMSP
143 QUIT:$G(^HL(772,+$G(IEN772),0))']"" "" ;->
144 ;
145 S DATA=$G(^HL(772,+$G(IEN772),0)) QUIT:DATA']"" "" ;->
146 ;
147 ; Loop until no new entries found or more than 20 entries...
148 S NUM=$$LOADEM^HLUCM050(+IEN772,.HLNMSP)
149 ;
150 QUIT NUM
151 ;
152HOLDTOT(IEN) ; Accumulate...
153 QUIT:$D(HOLDNMSP(IEN))!(TOTNUM>19) ;->
154 S HOLDNMSP(IEN)="",TOTNUM=TOTNUM+1
155 QUIT
156 ;
157SETUP() ; Perform checks, which can return error conditions, and
158 ; set up variables for $$LOOP. This extrinsic function returns
159 ; "" if no errors, or the # errors found. (Note that error
160 ; details placed in ERRINFO(ERROR-REASON)="")
161 N NOERR
162 S NOERR=""
163 D SETDEF ; Set defaults for parameters, if not passed
164 D FINDWAY ; Find way NMSP and PROT parameters passed
165 D SETMORE^HLUCM003 ; Additional var sets based on parameters & "way"...
166 D ERRCHK^HLUCM003 ; Check for errors...
167 KILL ^TMP(TOTALS,$J) ; Clear out storage location...
168 QUIT NOERR
169 ;
170SETDEF ; Set various defaults...
171 I '$D(PNMSP) S PNMSP=1
172 I '$D(IEN101) S IEN101=1
173 I $G(TOTALS)']"" S TOTALS="HLTOTALS"
174 S COND=$$UP^XLFSTR(COND)
175 S COND=$S($G(COND)="BOTH":COND,1:"EITHER") ; Default to EITHER matches, count it...
176 QUIT
177 ;
178FINDWAY ; How were NMSP and PROT passed? By reference? (If so, return 1)
179 ; Passed by reference?
180 S NMSPTYPE=$S($G(PNMSP)']""&($O(PNMSP(""))]""):1,1:0) ; 1=YES
181 S PROTYPE=$S($G(IEN101)']""&($O(IEN101(""))]""):1,1:0) ; 1=YES
182 QUIT
183 ;
184MSGID(MSGID) ; Search forward for MSA's to this MSGID...
185 N BIEN,CT,D,HOLD,I772,I773,MSA,X
186 ;
187 S X=$O(^HL(772,"C",MSGID,0)) I X S HOLD(X)=""
188 S X=$O(^HLMA("C",MSGID,0)) I X S X=+$G(^HLMA(+X,0)) I X S HOLD(X)=""
189 ;
190 Q
191 ;
192ERRMOVE(IEN772) ; Move all associated data out of ^TMP's totaling arrays
193 N IEN772C,IEN772P
194 ;
195 ; Find parent message (because have to move ALL associated messages out)
196 QUIT:$G(^TMP($J,"HLUCM"))'="DEBUG GLOBAL" ;->
197 S IEN772P=$O(^TMP($J,"HLUCMSTORE","X",+IEN772,0))
198 I IEN772P'>0 S IEN772P=IEN772
199 ;
200 ; Loop thru all associated messages in unit...
201 S IEN772C=0
202 F S IEN772C=$O(^TMP($J,"HLUCMSTORE","U",IEN772P,IEN772C)) Q:'IEN772C D
203 . F SUB="C","E","O","X" D
204 . . MERGE ^TMP($J,"HLUCMSTORE","ERR",SUB,IEN772C)=^TMP($J,"HLUCMSTORE",SUB,IEN772C)
205 . . KILL ^TMP($J,"HLUCMSTORE",SUB,IEN772C)
206 ;
207 ; Maybe there is no X xref...
208 MERGE ^TMP($J,"HLUCMSTORE","ERR","E",+IEN772P)=^TMP($J,"HLUCMSTORE","E",+IEN772P)
209 KILL ^TMP($J,"HLUCMSTORE","E",+IEN772P)
210 ;
211 ; Finally, move the unit's data...
212 MERGE ^TMP($J,"HLUCMSTORE","ERR","U",IEN772P)=^TMP($J,"HLUCMSTORE","U",IEN772P)
213 KILL ^TMP($J,"HLUCMSTORE","U",IEN772P)
214 ;
215 Q
216 ;
217EOR ;HLUCM009 - HL7/Capacity Mgt API-II ;2/25/03-08:50
Note: See TracBrowser for help on using the repository browser.