- SRHLVUI2 ;B'ham ISC/DLR - Surgery Interface Con. 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).
- NTE(NTE,OBR) ;process NTE-3
- ;anesthesia comments
- ;find the entry for this technique
- N FILE,FIELD,IENS,FLAGS,WP,X,Y
- N CASE S CASE=$P(OBR,HLFS,4) Q:CASE=""
- S DIC="^SRF("_CASE_",6,",DIC(0)="OSXZ",X=$P($P(OBR,HLFS,5),HLCOMP,5) D ^DIC Q:Y<0
- S FILE=130.06,FIELD=40,IENS=+Y_","_CASE_",",FLAGS="A",WP(1)=$P(NTE,HLFS,4) D WP^DIE(FILE,IENS,FIELD,FLAGS,"WP","SRE")
- Q
- OBX(OBX,OBR) ;process Observation Segment (OBX) fields 3,5,14,16
- ;
- N SRUPD,VALUE,CHKV,SROUT
- S ID=$P($P(OBX,HLFS,4),HLCOMP,2) I $G(ID)="" S HLERR="Missing Identifier with "_$P(OBX,HLFS)_" "_$P(OBX,HLFS,2) D ERR^SRHLVUI(OBX,IEN) Q
- S IEN=$O(^SRO(133.2,"AC",ID,0)) I $G(IEN)="" D SET^SRHLVORU("Invalid OBX identifier, "_ID_", ",OBR,OBX,.SRHLX) Q
- ;if field is set to receive, then set DR string for DIE call
- I $$CHECK^SRHLVUI(IEN)=1 D
- .I '$D(^SRO(133.2,IEN,1,0)) S VALUE=$$VALUE^SRHLVUI(IEN) D:VALUE="" I "^"'[$$CHKV^SRHLVUI(IEN,VALUE) S LVL=$P(^SRO(133.2,IEN,0),U,9) D DR^SRHLVUI(LVL,IEN) S UPDATE=1
- ..;create discrepancy message entry for null or invalid entries
- ..N TEXT S TEXT="Invalid value, "_$P($P(OBX,HLFS,6),HLCOMP,1,3)_$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)
- .;process multiple field segments, ex. replacement fluids
- .;SRUPD is used to update multiple field entries that are not multiples, ex. TOURNIQUET APPLIED. If the entry is not a multiple SRUPD is set to 0.
- .I $D(^SRO(133.2,IEN,1,0)) S SRUPD=1,SRX=0 F S SRX=$O(^SRO(133.2,IEN,1,SRX)) Q:'SRX!($D(HLERR))!($G(SROUT)=1) S LVL=$P(^SRO(133.2,SRX,0),U,9) Q:"123"[$G(LVL)&($G(LVL)="") D:$$CHECK^SRHLVUI(SRX)=1
- ..S CHKV=$$CHKV^SRHLVUI(SRX,$$VALUE^SRHLVUI(SRX)) D
- ...I CHKV'="^" D DR^SRHLVUI(LVL,SRX) I $P(^SRO(133.2,SRX,0),U,3)=.01 S UPDATE=1 S LVL=$P(^SRO(133.2,IEN,0),U,9) D DR^SRHLVUI(LVL,IEN) S SRUPD=0
- ...I CHKV="^" I $P(^SRO(133.2,SRX,0),U,3)=.01 S SROUT=1
- .;if SRUPD = 1 a non-multiple was processed, so update original IEN
- .I $D(^SRO(133.2,IEN,1,0))&($G(SRUPD)=1) S LVL=$P(^SRO(133.2,IEN,0),U,9) D DR^SRHLVUI(LVL,IEN)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRHLVUI2 2368 printed Mar 13, 2025@21:44:47 Page 2
- SRHLVUI2 ;B'ham ISC/DLR - Surgery Interface Con. 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).
- NTE(NTE,OBR) ;process NTE-3
- +1 ;anesthesia comments
- +2 ;find the entry for this technique
- +3 NEW FILE,FIELD,IENS,FLAGS,WP,X,Y
- +4 NEW CASE
- SET CASE=$PIECE(OBR,HLFS,4)
- if CASE=""
- QUIT
- +5 SET DIC="^SRF("_CASE_",6,"
- SET DIC(0)="OSXZ"
- SET X=$PIECE($PIECE(OBR,HLFS,5),HLCOMP,5)
- DO ^DIC
- if Y<0
- QUIT
- +6 SET FILE=130.06
- SET FIELD=40
- SET IENS=+Y_","_CASE_","
- SET FLAGS="A"
- SET WP(1)=$PIECE(NTE,HLFS,4)
- DO WP^DIE(FILE,IENS,FIELD,FLAGS,"WP","SRE")
- +7 QUIT
- OBX(OBX,OBR) ;process Observation Segment (OBX) fields 3,5,14,16
- +1 ;
- +2 NEW SRUPD,VALUE,CHKV,SROUT
- +3 SET ID=$PIECE($PIECE(OBX,HLFS,4),HLCOMP,2)
- IF $GET(ID)=""
- SET HLERR="Missing Identifier with "_$PIECE(OBX,HLFS)_" "_$PIECE(OBX,HLFS,2)
- DO ERR^SRHLVUI(OBX,IEN)
- QUIT
- +4 SET IEN=$ORDER(^SRO(133.2,"AC",ID,0))
- IF $GET(IEN)=""
- DO SET^SRHLVORU("Invalid OBX identifier, "_ID_", ",OBR,OBX,.SRHLX)
- QUIT
- +5 ;if field is set to receive, then set DR string for DIE call
- +6 IF $$CHECK^SRHLVUI(IEN)=1
- Begin DoDot:1
- +7 IF '$DATA(^SRO(133.2,IEN,1,0))
- SET VALUE=$$VALUE^SRHLVUI(IEN)
- if VALUE=""
- Begin DoDot:2
- +8 ;create discrepancy message entry for null or invalid entries
- +9 NEW TEXT
- SET TEXT="Invalid value, "_$PIECE($PIECE(OBX,HLFS,6),HLCOMP,1,3)_$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)
- End DoDot:2
- IF "^"'[$$CHKV^SRHLVUI(IEN,VALUE)
- SET LVL=$PIECE(^SRO(133.2,IEN,0),U,9)
- DO DR^SRHLVUI(LVL,IEN)
- SET UPDATE=1
- +10 ;process multiple field segments, ex. replacement fluids
- +11 ;SRUPD is used to update multiple field entries that are not multiples, ex. TOURNIQUET APPLIED. If the entry is not a multiple SRUPD is set to 0.
- +12 IF $DATA(^SRO(133.2,IEN,1,0))
- SET SRUPD=1
- SET SRX=0
- FOR
- SET SRX=$ORDER(^SRO(133.2,IEN,1,SRX))
- if 'SRX!($DATA(HLERR))!($GET(SROUT)=1)
- QUIT
- SET LVL=$PIECE(^SRO(133.2,SRX,0),U,9)
- if "123"[$GET(LVL)&($GET(LVL)="")
- QUIT
- if $$CHECK^SRHLVUI(SRX)=1
- Begin DoDot:2
- +13 SET CHKV=$$CHKV^SRHLVUI(SRX,$$VALUE^SRHLVUI(SRX))
- Begin DoDot:3
- +14 IF CHKV'="^"
- DO DR^SRHLVUI(LVL,SRX)
- IF $PIECE(^SRO(133.2,SRX,0),U,3)=.01
- SET UPDATE=1
- SET LVL=$PIECE(^SRO(133.2,IEN,0),U,9)
- DO DR^SRHLVUI(LVL,IEN)
- SET SRUPD=0
- +15 IF CHKV="^"
- IF $PIECE(^SRO(133.2,SRX,0),U,3)=.01
- SET SROUT=1
- End DoDot:3
- End DoDot:2
- +16 ;if SRUPD = 1 a non-multiple was processed, so update original IEN
- +17 IF $DATA(^SRO(133.2,IEN,1,0))&($GET(SRUPD)=1)
- SET LVL=$PIECE(^SRO(133.2,IEN,0),U,9)
- DO DR^SRHLVUI(LVL,IEN)
- End DoDot:1
- +18 QUIT
