SRHLVUI2.m

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

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