source: WorldVistAEHR/trunk/r/SURGERY-SR/SRHLVUO4.m@ 1351

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

initial load of WorldVistAEHR
File size: 4.6 KB
RevLine 
[613]1SRHLVUO4 ;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) ;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
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 D:$$CHECK^SRHLUO4C(SRX) POBR,POBX,MSGV^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 HDR="OBR"_HLFS_HLFS_HLFS_CASE_HLFS_$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 1 node exists
28 .I FILE=130 S FIELD=FIELD_$S($D(^SRO(133.2,SRY,1,0)):"*",1:"") D GETS^DIQ(FILE,IENS,FIELD,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),HLFS,SEQ)=$S($P(OBR(SRST),HLFS,SEQ)="":"",1:$P(OBR(SRST),HLFS,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),HLFS,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"_HLFS_SRZ_HLFS_"P"_HLFS_SRHL(FILE,SRST,FIELD,SRZ)
46 .S HDR="OBX"_HLFS_HLFS_$P(^SRO(133.2,SRY,0),U,6)_HLFS_$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),HLFS,SEQ)=$S($P(OBX(SRST,OBX),HLFS,SEQ)="":"",1:$P(OBX(SRST,OBX),HLFS,SEQ)_HLCOMP)_VALUE
50 ..S:$P(^SRO(133.2,SRY,0),U,12)'="" $P(OBX(SRST,OBX),HLFS,7)=$P(^(0),U,12)
51 ..;process the subordinate sequences
52 ..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),HLFS,SEQ)=$$VALUE^SRHLUO4C(SRY1,FILE,SRST,FIELD)
53 ..;reset FILE for the SRHL array loop
54 ..D INIT(SRY)
55 .;process all multiple entries
56 .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
57 ..;process all of the subordinate sequences (all 1 nodes)
58 ..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'=""
59 ...S:SEQ=4 OBX(FLD,OBX)=HDR_HLCOMP_VALUE,$P(OBX(FLD,OBX),HLFS,7)=$P(^SRO(133.2,SRY1,0),U,12) S:SEQ'=4 $P(OBX(FLD,OBX),HLFS,SEQ)=VALUE
60 ...;S:SEQ=4 OBX(SRST,OBX)=HDR_HLCOMP_VALUE S:SEQ'=4 $P(OBX(FLD,OBX),HLFS,SEQ)=VALUE
61 Q
62INIT(IEN) ;initialize FILE FIELD and SEQ
63 S FILE=$P(^SRO(133.2,IEN,0),U,2),FIELD=$P(^(0),U,3),SEQ=$P($P(^(0),U,8),"-")+1
64 Q
Note: See TracBrowser for help on using the repository browser.