source: WorldVistAEHR/trunk/r/SURGERY-SR/SRHLUO4.m@ 1420

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

initial load of WorldVistAEHR
File size: 4.7 KB
RevLine 
[613]1SRHLUO4 ;B'HAM ISC\DLR - Surgery Interface (Cont.) Utilities for building Outgoing HL7 Segments ; [ 05/06/98 7:14 AM ]
2 ;;3.0; Surgery ;**41**;24 Jun 93
3 ; Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
4OBR(SRI,CASE,SRENT) ;Observation
5 ;variables
6 ; OBR(obr) & OBX(obr,x) = temp array for processing segments
7 ; CNT(IEN) - eliminates redundant processing in file 133.2
8 ; SRHL - local array built by GETS^DIQ() call
9 ;
10 ;process all OBR and underlying OBX segments
11MAIN N CNT,FIELD,FILE,FLAGS,IEN,SEQ,SRST,SRX,SRY,SRY1,SROBR,TAR,TMPOBR
12 S (SROBR,SRX)=0 F S SRX=$O(^SRO(133.2,SRX)) Q:'SRX I $D(^SRO(133.2,SRX,2,0)) K OBR,OBX,NTE,TMPOBR I $$CHECK^SRHLUO4C(SRX) D POBR,POBX D MSG^SRHLUO4C(.OBR,.OBX,.NTE)
13EXIT ;
14 K DIQ,DA,DR,OBR,OBX,NTE
15 Q
16POBR ;sets up the DIQ
17 K SRHL,HDR,SR
18 ;setup the variables for the GETS^DIQ() call
19 S TAR="SRHL",FLAGS="IEN",IENS=CASE_",",SRST=""
20 ;check multiple entries to process using the GETS call
21 I $D(^SRO(133.2,SRX,1,0)) D INIT(SRX) I FIELD'="" S FIELD=FIELD_"*" D GETS^DIQ(FILE,IENS,FIELD,FLAGS,TAR)
22 ;OBR-4 text identifier
23 S (TMPOBR,HDR)="OBR"_HL("FS")_HL("FS")_HL("FS")_CASE_HL("FS")_$P(^SRO(133.2,SRX,0),U,10)_HLCOMP_$P(^(0),U)_HLCOMP_$P(^(0),U,11)
24 ;process all subordinate sequences (1 node)
25 S SRY=0 F S SRY=$O(^SRO(133.2,SRX,1,SRY)) Q:'SRY D:$$CHECK^SRHLUO4C(SRY)
26 .D INIT(SRY)
27 .;GETS file 130 fields or multiples if file 133.2 has 1 node
28 .I FILE=130 S FIELDS=FIELD_$S($D(^SRO(133.2,SRY,1,0)):"*",1:"") D GETS^DIQ(FILE,IENS,FIELDS,FLAGS,TAR)
29 .;process fields that are not multiples and do not have subordinate sequences
30 .I '$D(^SRO(133.2,SRY,1,0)) S SRST="" F S SRST=$O(SRHL(FILE,SRST)) Q:SRST="" D:$D(SRHL(FILE,SRST,FIELD,$S($P(^SRO(133.2,SRY,0),U,6)="TS":"I",$P(^(0),U,6)="CN":"I",1:"E")))
31 ..S:'$D(OBR(SRST)) OBR(SRST)=HDR S $P(OBR(SRST),HL("FS"),SEQ)=$S($P(OBR(SRST),HL("FS"),SEQ)="":"",1:$P(OBR(SRST),HL("FS"),SEQ)_HLCOMP)_$$VALUE^SRHLUO4C(SRY,FILE,SRST,FIELD)
32 .;process all multiples and subordinate sequences
33 .I $D(^SRO(133.2,SRY,1,0)) S SRY1=$O(^SRO(133.2,SRY,1,0)) I $$CHECK^SRHLUO4C(SRY1) S SRST="" F S SRST=$O(SRHL($P(^SRO(133.2,SRY1,0),U,2),SRST)) Q:SRST="" D
34 ..D INIT(SRY1) Q:'$D(SRHL(FILE,SRST,FIELD,$S($P(^SRO(133.2,SRY1,0),U,6)="TS":"I",$P(^(0),U,6)="CN":"I",1:"E")))
35 ..S FLD=$P(SRST,",",2,4),SEQ=$P($P(^SRO(133.2,SRY1,0),U,8),"-")+1
36 ..;process level 3 multiples: move lower level 2 info up to level 3 and level 2 info for other multiples at level 3
37 ..I $D(OBR(FLD))!$D(SR(FLD)) S OBR(SRST)=$S($D(OBR(FLD)):OBR(FLD),1:SR(FLD)) I $D(OBR(FLD)) S SR(FLD)=OBR(FLD) K OBR(FLD)
38 ..S $P(OBR(SRST),HL("FS"),SEQ)=$$VALUE^SRHLUO4C(SRY1,FILE,SRST,FIELD)
39 .K SR
40 Q
41POBX ;process the underlying OBX & NTE segments
42 S (SRY,OBX)=0 F S SRY=$O(^SRO(133.2,SRX,2,SRY)) Q:'SRY D:$$CHECK^SRHLUO4C(SRY)
43 .D INIT(SRY) I FILE=130 S:$D(^SRO(133.2,SRY,1,0)) FIELD=FIELD_"*" D GETS^DIQ(FILE,IENS,FIELD,FLAGS,TAR)
44 .I $P(^SRO(133.2,SRY,0),U,5)="NTE" D Q
45 ..S SRST="",SRZ=0 F S SRST=$O(SRHL(FILE,SRST)) Q:SRST="" S FLD=$S('$D(OBR(SRST)):$P(SRST,",",2,4),1:SRST) F S SRZ=$O(SRHL(FILE,SRST,FIELD,SRZ)) Q:'SRZ S NTE(FLD,SRZ)="NTE"_HL("FS")_SRZ_HL("FS")_"P"_HL("FS")_SRHL(FILE,SRST,FIELD,SRZ)
46 .S HDR="OBX"_HL("FS")_HL("FS")_$P(^SRO(133.2,SRY,0),U,6)_HL("FS")_$P(^(0),U,10)_HLCOMP_$P(^(0),U)_HLCOMP_$P(^(0),U,11),OBX=OBX+1
47 .;process non-multiple entries with or without 1 nodes
48 .S SRST="" F S SRST=$O(SRHL(FILE,SRST)) Q:SRST="" S VALUE=$$VALUE^SRHLUO4C(SRY,FILE,SRST,FIELD) I VALUE'="" D
49 ..S OBX(SRST,OBX)=HDR,SEQ=$P($P(^SRO(133.2,SRY,0),U,8),"-")+1,$P(OBX(SRST,OBX),HL("FS"),SEQ)=$S($P(OBX(SRST,OBX),HL("FS"),SEQ)="":"",1:$P(OBX(SRST,OBX),HL("FS"),SEQ)_HLCOMP)_VALUE
50 ..S:$P(^SRO(133.2,SRY,0),U,12)'="" $P(OBX(SRST,OBX),HL("FS"),7)=$P(^(0),U,12)
51 ..I '$D(OBR(SRST)) S OBR(SRST)=TMPOBR
52 ..;process the subordinate sequences
53 ..S SRY1=0,CNT(SRY)=1 F S SRY1=$O(^SRO(133.2,SRY,1,SRY1)) Q:'SRY1 S CNT(SRY1)=1 D INIT(SRY1) S FLD=$S('$D(OBR(SRST)):$P(SRST,",",2,4),1:SRST),$P(OBX(FLD,OBX),HL("FS"),SEQ)=$$VALUE^SRHLUO4C(SRY1,FILE,SRST,FIELD)
54 ..;reset FILE for the SRHL array loop
55 ..D INIT(SRY)
56 .;process all multiple entries
57 .I $D(^SRO(133.2,SRY,1,0)) S SRY1=$O(^SRO(133.2,SRY,1,0)) I SRY1>0 D INIT(SRY1) S SRST="" F S SRST=$O(SRHL(FILE,SRST)) Q:SRST="" D
58 ..;process all of the subordinate sequences (all 1 nodes)
59 ..S OBX=OBX+1,SRY1=0 F S SRY1=$O(^SRO(133.2,SRY,1,SRY1)) Q:'SRY1 D INIT(SRY1) S FLD=$S('$D(OBR(SRST)):$P(SRST,",",2,4),1:SRST),VALUE=$$VALUE^SRHLUO4C(SRY1,FILE,SRST,FIELD) D:VALUE'=""
60 ...S:SEQ=4 OBX(FLD,OBX)=HDR_HLCOMP_VALUE,$P(OBX(FLD,OBX),HL("FS"),7)=$P(^SRO(133.2,SRY1,0),U,12) S:SEQ'=4 $P(OBX(FLD,OBX),HL("FS"),SEQ)=VALUE
61 ...;S:SEQ=4 OBX(SRST,OBX)=HDR_HLCOMP_VALUE S:SEQ'=4 $P(OBX(FLD,OBX),HL("FS"),SEQ)=VALUE
62 Q
63INIT(IEN) ;initialize FILE FIELD and SEQ
64 S FILE=$P(^SRO(133.2,IEN,0),U,2),FIELD=$P(^(0),U,3),SEQ=$P($P(^(0),U,8),"-")+1
65 Q
Note: See TracBrowser for help on using the repository browser.