- SRHLVUI ;B'ham ISC/DLR - Surgery Interface Utility to process incoming segments ; [ 05/06/98 7:14 AM ]
- ;;3.0; Surgery ;**41**;24 Jun 93
- ; Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
- ;;This routine utilizes the Surgery Interface file (133.2).
- OBR(IEN,OBR) ;process Observation Request Segment (OBR) fields 3-4,7-8,27
- ;variables set in the calling routine SRHLORU
- ; IEN - The Observation ID's internal entry number in file 133.2
- ; OBR - (parameter) HL7 incoming segment
- ;
- N LVL,VALUE
- I $G(IEN)="" D
- .S ID=$P($P(OBR,HLFS,5),HLCOMP,2) I $G(ID)="" S HLERR="Missing OBR identifier" Q
- .S IEN=$O(^SRO(133.2,"AC",ID,0)) I $G(IEN)="" D SET^SRHLVORU("Invalid OBR identifier",OBR,"",.SRHLX) Q
- ;Process all Surgery field(s) associated with this Observation ID entry
- ; a DR string is set for every field in the message that is associated
- ; with a surgery field (1 node multiple holds associated fields)
- I $$CHECK(IEN)'=1 S QOBR=1 Q
- START I $P(^SRO(133.2,IEN,0),U,3)!($D(^(1,0))) D
- .I $P(^SRO(133.2,IEN,0),U,3)&('$D(^(1,0))) S LVL=$P(^SRO(133.2,IEN,0),U,9),VALUE=$$VALUE(IEN) Q:$$CHKV(IEN,VALUE)="^" D DR(LVL,IEN)
- .;sets the DR string level (DR and DR(2,...)) for the standard DIE call
- .I $D(^SRO(133.2,IEN,1,0)) S SRX=0 F S SRX=$O(^SRO(133.2,IEN,1,SRX)) Q:'SRX!($D(HLERR))!$G(QOBR)=1 S LVL=$P(^SRO(133.2,SRX,0),U,9) Q:"123"[$G(LVL)&($G(LVL)="") D
- ..I $D(^SRO(133.2,SRX,1,0)) S SRIEN=SRX ; SRIEN is for DR(3 string sets
- ..I $$CHECK(SRX)=1&('$D(^SRO(133.2,SRX,1,0))) I $$CHKV(SRX,$$VALUE(SRX))'="^" D DR(LVL,SRX) D:$P(^SRO(133.2,SRX,0),U,3)=.01
- ...S LVL=$P(^SRO(133.2,$S($D(SRIEN):SRIEN,1:IEN),0),U,9) D DR(LVL,$S($D(SRIEN):SRIEN,1:IEN)) I $D(SRIEN) K SRIEN
- Q
- ERR(MSG,IEN) ;setup the error message for the acknowledgement message
- S:'$D(HLERR) HLERR="Invalid "_ID_" information." S SRERR(1)=$P(MSG,HLFS),SRERR(2)=$P(MSG,HLFS,2)
- Q
- CHECK(IEN) ;check universal id or observation id sequence to the Surgery Interface file
- I $G(IEN)="" Q 0
- Q $P($G(^SRO(133.2,IEN,0)),U,4)["R"
- VALUE(XX) ;SET the value of the identified segment field in file 133.2
- I XX="" Q ""
- N VALUE
- ;set VALUE = identifiers field #6 Message and #7 HL7 sequence in file 133.2, ex. S VALUE=$P($P(OBX,HLFS,5),HLCOMP,1)
- S:$P(^SRO(133.2,XX,0),U,6)'="CN" VALUE=$P($P(@$P(^SRO(133.2,XX,0),U,5),HLFS,$P($P(^(0),U,8),"-")+1),HLCOMP,$P($P(^(0),U,8),"-",2))
- S:$P(^SRO(133.2,XX,0),U,6)="CN" VALUE=$P(@$P(^SRO(133.2,XX,0),U,5),HLFS,$P($P(^(0),U,8),"-")+1)
- S:VALUE'="" VALUE=$S($P(^(0),U,6)="TS":$$FMDATE^HLFNC(VALUE),$P(^(0),U,6)="CE":VALUE,$P(^(0),U,6)="TX":VALUE,$P(^(0),U,6)="FT":VALUE,$P(^(0),U,6)="NM":+VALUE,1:VALUE)
- I $P(^SRO(133.2,XX,0),U,6)="CN" S VALUE=$$DNAME^SRHLVU(VALUE),VALUE=$S(VALUE="":"",1:VALUE)
- ;if field #14, Always create new entry, is set then add "" for DIE stuff
- I $P(^SRO(133.2,XX,0),U,13)=1 S VALUE=""""_VALUE_""""
- Q VALUE
- DR(LVL,IEN) ;set DR or DR(... string for the FileMan DIE call
- Q:$G(LVL)=""!$G(IEN)=""
- N VALUE,FLAG,RESULT,FILE,FIELD,TYPE
- S VALUE=$$VALUE(IEN),TYPE=$P(^SRO(133.2,IEN,0),U,6)
- I LVL=1 S DR=$G(DR)_$S($G(DR)'="":";",1:"")_$P(^SRO(133.2,IEN,0),U,3)_$S(TYPE="TS":"////",1:"///")_VALUE
- I LVL'=1 D
- .S DR(LVL,$P(^SRO(133.2,IEN,0),U,2))=$G(DR(LVL,$P(^SRO(133.2,IEN,0),U,2)))_$S($D(DR(LVL,$P(^SRO(133.2,IEN,0),U,2))):";",1:"")_$P(^SRO(133.2,IEN,0),U,3)_$S(TYPE="TS":"////",1:"///")_VALUE
- Q
- CHKV(IEN,VALUE) ;check for invalid field values
- N TEXT
- I (VALUE="")!(IEN="") Q ""
- ;added to by-pass time stamp fields input transforms
- I $P(^SRO(133.2,IEN,0),U,6)="TS" Q VALUE_"^"
- N D0,CVALUE,FILE,FIELD,FLAG,RESULT
- S FILE=$P(^SRO(133.2,IEN,0),U,2),FIELD=$P(^(0),U,3),FLAG="E",CVALUE=$TR(VALUE,"""",""),RESULT=""
- S D0=$P(OBR,HLFS,4) ; set for input transformer purposes
- D CHK^DIE(FILE,FIELD,FLAG,CVALUE,.RESULT) I RESULT="^" S TEXT="Invalid value, "_VALUE_$S($P(^SRO(133.2,IEN,0),U,11)'="":" for File #"_$P($P(^SRO(133.2,IEN,0),U,11),"99VA",2),1:"") D SET^SRHLVORU(TEXT,OBR,$G(OBX),.SRHLX)
- ;if a multilple value is invalid kill DR and to stop processing this OBR
- I RESULT="^",$P(^SRO(133.2,IEN,0),U,5)="OBR",FIELD=.01 K DR S QOBR=1
- Q $S($D(RESULT(0)):RESULT(0),1:RESULT)
- SRHLVUI ;B'ham ISC/DLR - Surgery Interface Utility to process incoming segments ; [ 05/06/98 7:14 AM ]
- +1 ;;3.0; Surgery ;**41**;24 Jun 93
- +2 ; Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
- +3 ;;This routine utilizes the Surgery Interface file (133.2).
- OBR(IEN,OBR) ;process Observation Request Segment (OBR) fields 3-4,7-8,27
- +1 ;variables set in the calling routine SRHLORU
- +2 ; IEN - The Observation ID's internal entry number in file 133.2
- +3 ; OBR - (parameter) HL7 incoming segment
- +4 ;
- +5 NEW LVL,VALUE
- +6 IF $GET(IEN)=""
- Begin DoDot:1
- +7 SET ID=$PIECE($PIECE(OBR,HLFS,5),HLCOMP,2)
- IF $GET(ID)=""
- SET HLERR="Missing OBR identifier"
- QUIT
- +8 SET IEN=$ORDER(^SRO(133.2,"AC",ID,0))
- IF $GET(IEN)=""
- DO SET^SRHLVORU("Invalid OBR identifier",OBR,"",.SRHLX)
- QUIT
- End DoDot:1
- +9 ;Process all Surgery field(s) associated with this Observation ID entry
- +10 ; a DR string is set for every field in the message that is associated
- +11 ; with a surgery field (1 node multiple holds associated fields)
- +12 IF $$CHECK(IEN)'=1
- SET QOBR=1
- QUIT
- START IF $PIECE(^SRO(133.2,IEN,0),U,3)!($DATA(^(1,0)))
- Begin DoDot:1
- +1 IF $PIECE(^SRO(133.2,IEN,0),U,3)&('$DATA(^(1,0)))
- SET LVL=$PIECE(^SRO(133.2,IEN,0),U,9)
- SET VALUE=$$VALUE(IEN)
- IF $$CHKV(IEN,VALUE)="^"
- QUIT
- DO DR(LVL,IEN)
- +2 ;sets the DR string level (DR and DR(2,...)) for the standard DIE call
- +3 IF $DATA(^SRO(133.2,IEN,1,0))
- SET SRX=0
- FOR
- SET SRX=$ORDER(^SRO(133.2,IEN,1,SRX))
- IF 'SRX!($DATA(HLERR))!$GET(QOBR)=1
- QUIT
- SET LVL=$PIECE(^SRO(133.2,SRX,0),U,9)
- IF "123"[$GET(LVL)&($GET(LVL)="")
- QUIT
- Begin DoDot:2
- +4 ; SRIEN is for DR(3 string sets
- IF $DATA(^SRO(133.2,SRX,1,0))
- SET SRIEN=SRX
- +5 IF $$CHECK(SRX)=1&('$DATA(^SRO(133.2,SRX,1,0)))
- IF $$CHKV(SRX,$$VALUE(SRX))'="^"
- DO DR(LVL,SRX)
- IF $PIECE(^SRO(133.2,SRX,0),U,3)=.01
- Begin DoDot:3
- +6 SET LVL=$PIECE(^SRO(133.2,$SELECT($DATA(SRIEN):SRIEN,1:IEN),0),U,9)
- DO DR(LVL,$SELECT($DATA(SRIEN):SRIEN,1:IEN))
- IF $DATA(SRIEN)
- KILL SRIEN
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +7 QUIT
- ERR(MSG,IEN) ;setup the error message for the acknowledgement message
- +1 IF '$DATA(HLERR)
- SET HLERR="Invalid "_ID_" information."
- SET SRERR(1)=$PIECE(MSG,HLFS)
- SET SRERR(2)=$PIECE(MSG,HLFS,2)
- +2 QUIT
- CHECK(IEN) ;check universal id or observation id sequence to the Surgery Interface file
- +1 IF $GET(IEN)=""
- QUIT 0
- +2 QUIT $PIECE($GET(^SRO(133.2,IEN,0)),U,4)["R"
- VALUE(XX) ;SET the value of the identified segment field in file 133.2
- +1 IF XX=""
- QUIT ""
- +2 NEW VALUE
- +3 ;set VALUE = identifiers field #6 Message and #7 HL7 sequence in file 133.2, ex. S VALUE=$P($P(OBX,HLFS,5),HLCOMP,1)
- +4 IF $PIECE(^SRO(133.2,XX,0),U,6)'="CN"
- SET VALUE=$PIECE($PIECE(@$PIECE(^SRO(133.2,XX,0),U,5),HLFS,$PIECE($PIECE(^(0),U,8),"-")+1),HLCOMP,$PIECE($PIECE(^(0),U,8),"-",2))
- +5 IF $PIECE(^SRO(133.2,XX,0),U,6)="CN"
- SET VALUE=$PIECE(@$PIECE(^SRO(133.2,XX,0),U,5),HLFS,$PIECE($PIECE(^(0),U,8),"-")+1)
- +6 IF VALUE'=""
- SET VALUE=$SELECT($PIECE(^(0),U,6)="TS":$$FMDATE^HLFNC(VALUE),$PIECE(^(0),U,6)="CE":VALUE,$PIECE(^(0),U,6)="TX":VALUE,$PIECE(^(0),U,6)="FT":VALUE,$PIECE(^(0),U,6)="NM":+VALUE,1:VALUE)
- +7 IF $PIECE(^SRO(133.2,XX,0),U,6)="CN"
- SET VALUE=$$DNAME^SRHLVU(VALUE)
- SET VALUE=$SELECT(VALUE="":"",1:VALUE)
- +8 ;if field #14, Always create new entry, is set then add "" for DIE stuff
- +9 IF $PIECE(^SRO(133.2,XX,0),U,13)=1
- SET VALUE=""""_VALUE_""""
- +10 QUIT VALUE
- DR(LVL,IEN) ;set DR or DR(... string for the FileMan DIE call
- +1 IF $GET(LVL)=""!$GET(IEN)=""
- QUIT
- +2 NEW VALUE,FLAG,RESULT,FILE,FIELD,TYPE
- +3 SET VALUE=$$VALUE(IEN)
- SET TYPE=$PIECE(^SRO(133.2,IEN,0),U,6)
- +4 IF LVL=1
- SET DR=$GET(DR)_$SELECT($GET(DR)'="":";",1:"")_$PIECE(^SRO(133.2,IEN,0),U,3)_$SELECT(TYPE="TS":"////",1:"///")_VALUE
- +5 IF LVL'=1
- Begin DoDot:1
- +6 SET DR(LVL,$PIECE(^SRO(133.2,IEN,0),U,2))=$GET(DR(LVL,$PIECE(^SRO(133.2,IEN,0),U,2)))_$SELECT($DATA(DR(LVL,$PIECE(^SRO(133.2,IEN,0),U,2))):";",1:"")_$PIECE(^SRO(133.2,IEN,0),U,3)_$SELECT(TYPE="TS":"////",1:"///")_VALUE
- End DoDot:1
- +7 QUIT
- CHKV(IEN,VALUE) ;check for invalid field values
- +1 NEW TEXT
- +2 IF (VALUE="")!(IEN="")
- QUIT ""
- +3 ;added to by-pass time stamp fields input transforms
- +4 IF $PIECE(^SRO(133.2,IEN,0),U,6)="TS"
- QUIT VALUE_"^"
- +5 NEW D0,CVALUE,FILE,FIELD,FLAG,RESULT
- +6 SET FILE=$PIECE(^SRO(133.2,IEN,0),U,2)
- SET FIELD=$PIECE(^(0),U,3)
- SET FLAG="E"
- SET CVALUE=$TRANSLATE(VALUE,"""","")
- SET RESULT=""
- +7 ; set for input transformer purposes
- SET D0=$PIECE(OBR,HLFS,4)
- +8 DO CHK^DIE(FILE,FIELD,FLAG,CVALUE,.RESULT)
- IF RESULT="^"
- SET TEXT="Invalid value, "_VALUE_$SELECT($PIECE(^SRO(133.2,IEN,0),U,11)'="":" for File #"_$PIECE($PIECE(^SRO(133.2,IEN,0),U,11),"99VA",2),1:"")
- DO SET^SRHLVORU(TEXT,OBR,$GET(OBX),.SRHLX)
- +9 ;if a multilple value is invalid kill DR and to stop processing this OBR
- +10 IF RESULT="^"
- IF $PIECE(^SRO(133.2,IEN,0),U,5)="OBR"
- IF FIELD=.01
- KILL DR
- SET QOBR=1
- +11 QUIT $SELECT($DATA(RESULT(0)):RESULT(0),1:RESULT)
