- LR7OFA3 ;slc/dcm - Process OBR messages from OE/RR for AP ;8/11/97
- ;;5.2T9;LR;**1018**;Nov 17, 2004
- ;;5.2;LAB SERVICE;**121,187**;Sep 27, 1994
- ;
- OBR ;Process OBR part of MSG array
- ;TEST= Ptr to test in file 60
- ;TESTN= Test Name
- ;TYPE= Collection Sample Type
- ;SAMP= Ptr to Collection sample in file 62
- ;URG= Urgency
- I '$O(LRXMSG(0)) D
- . S TEST=+$P($P(LRXMSG,"|",5),"^",4),TESTN=$P($P(LRXMSG,"|",5),"^",6),TYPE=$$LRACTCOD^LR7OU0($P(LRXMSG,"|",12)),SPEC=$S($P($P($P(LRXMSG,"|",5),"^",4),"~",2):$P($P($P(LRXMSG,"|",5),"^",4),"~",2),1:$$LRSPEC^LR7OU0($P(LRXMSG,"|",16)))
- . S URG=$$LRURG^LR7OU0($P($P(LRXMSG,"|",28),"^",6))
- I $O(LRXMSG(0)) D
- . N I,J,X1,CTR
- . F CTR=1:1:$L(LRXMSG,"|") S X1(CTR)=$P(LRXMSG,"|",CTR)
- . S J=0 F S J=$O(LRXMSG(J)) Q:J<1 D
- .. S I=1 I $E(LRXMSG(J))'="|" S X1(CTR)=X1(CTR)_$P(LRXMSG,"|"),I=I+1
- .. F I=I:1:$L(LRXMSG(J),"|") S CTR=CTR+1,X1(CTR)=$P(LRXMSG(J),"|",I)
- . S TEST=$P(X1(5),"^",4),TESTN=$P(X1(5),"^",6),TYPE=$$LRACTCOD^LR7OU0(X1(12)),SPEC=$S($P($P(X1(5),"^",4),"~",2):$P($P(X1(5),"^",4),"~",2),1:$$LRSPEC^LR7OU0(X1(16)))
- . S URG=$$LRURG^LR7OU0($P(X1(28),"^",6))
- I '$L(TEST) D ACK^LR7OF0("DE",LRXORC,"TEST pointer not sent in message") S LREND=1 Q
- I '$L(TESTN) D ACK^LR7OF0("DE",LRXORC,"Test Name not sent in message") S LREND=1 Q
- I '$L(TYPE) D ACK^LR7OF0("DE",LRXORC,"Collection type not sent in message") S LREND=1 Q
- I '$L(SAMP) D ACK^LR7OF0("DE",LRXORC,"Sample pointer not sent in message") S LREND=1 Q
- I '$L(URG) D ACK^LR7OF0("DE",LRXORC,"Urgency not sent in message") S LREND=1 Q
- I LRXTYPE="NW" D ST Q ;New order request
- Q
- ST S LRSX=LRSX+1 I $D(^TMP("OR",$J,"LROT",STARTDT,TYPE,SAMP,LRSX)) G ST
- S ^TMP("OR",$J,"LROT",STARTDT,TYPE,SAMP,0)=ORIFN
- S ^TMP("OR",$J,"LROT",STARTDT,TYPE,SAMP,LRSX)=TEST
- S ^TMP("OR",$J,"LROT",STARTDT,TYPE,SAMP,LRSX,1)=URG
- Q
- LR7OFA3 ;slc/dcm - Process OBR messages from OE/RR for AP ;8/11/97
- +1 ;;5.2T9;LR;**1018**;Nov 17, 2004
- +2 ;;5.2;LAB SERVICE;**121,187**;Sep 27, 1994
- +3 ;
- OBR ;Process OBR part of MSG array
- +1 ;TEST= Ptr to test in file 60
- +2 ;TESTN= Test Name
- +3 ;TYPE= Collection Sample Type
- +4 ;SAMP= Ptr to Collection sample in file 62
- +5 ;URG= Urgency
- +6 IF '$ORDER(LRXMSG(0))
- Begin DoDot:1
- +7 SET TEST=+$PIECE($PIECE(LRXMSG,"|",5),"^",4)
- SET TESTN=$PIECE($PIECE(LRXMSG,"|",5),"^",6)
- SET TYPE=$$LRACTCOD^LR7OU0($PIECE(LRXMSG,"|",12))
- SET SPEC=$SELECT($PIECE($PIECE($PIECE(LRXMSG,"|",5),"^",4),"~",2):$PIECE($PIECE($PIECE(LRXMSG,"|",5),"^",4),"~",2),1:$$LRSPEC^LR7OU0($PIECE(LRXMSG,"|",16)))
- +8 SET URG=$$LRURG^LR7OU0($PIECE($PIECE(LRXMSG,"|",28),"^",6))
- End DoDot:1
- +9 IF $ORDER(LRXMSG(0))
- Begin DoDot:1
- +10 NEW I,J,X1,CTR
- +11 FOR CTR=1:1:$LENGTH(LRXMSG,"|")
- SET X1(CTR)=$PIECE(LRXMSG,"|",CTR)
- +12 SET J=0
- FOR
- SET J=$ORDER(LRXMSG(J))
- IF J<1
- QUIT
- Begin DoDot:2
- +13 SET I=1
- IF $EXTRACT(LRXMSG(J))'="|"
- SET X1(CTR)=X1(CTR)_$PIECE(LRXMSG,"|")
- SET I=I+1
- +14 FOR I=I:1:$LENGTH(LRXMSG(J),"|")
- SET CTR=CTR+1
- SET X1(CTR)=$PIECE(LRXMSG(J),"|",I)
- End DoDot:2
- +15 SET TEST=$PIECE(X1(5),"^",4)
- SET TESTN=$PIECE(X1(5),"^",6)
- SET TYPE=$$LRACTCOD^LR7OU0(X1(12))
- SET SPEC=$SELECT($PIECE($PIECE(X1(5),"^",4),"~",2):$PIECE($PIECE(X1(5),"^",4),"~",2),1:$$LRSPEC^LR7OU0(X1(16)))
- +16 SET URG=$$LRURG^LR7OU0($PIECE(X1(28),"^",6))
- End DoDot:1
- +17 IF '$LENGTH(TEST)
- DO ACK^LR7OF0("DE",LRXORC,"TEST pointer not sent in message")
- SET LREND=1
- QUIT
- +18 IF '$LENGTH(TESTN)
- DO ACK^LR7OF0("DE",LRXORC,"Test Name not sent in message")
- SET LREND=1
- QUIT
- +19 IF '$LENGTH(TYPE)
- DO ACK^LR7OF0("DE",LRXORC,"Collection type not sent in message")
- SET LREND=1
- QUIT
- +20 IF '$LENGTH(SAMP)
- DO ACK^LR7OF0("DE",LRXORC,"Sample pointer not sent in message")
- SET LREND=1
- QUIT
- +21 IF '$LENGTH(URG)
- DO ACK^LR7OF0("DE",LRXORC,"Urgency not sent in message")
- SET LREND=1
- QUIT
- +22 ;New order request
- IF LRXTYPE="NW"
- DO ST
- QUIT
- +23 QUIT
- ST SET LRSX=LRSX+1
- IF $DATA(^TMP("OR",$JOB,"LROT",STARTDT,TYPE,SAMP,LRSX))
- GOTO ST
- +1 SET ^TMP("OR",$JOB,"LROT",STARTDT,TYPE,SAMP,0)=ORIFN
- +2 SET ^TMP("OR",$JOB,"LROT",STARTDT,TYPE,SAMP,LRSX)=TEST
- +3 SET ^TMP("OR",$JOB,"LROT",STARTDT,TYPE,SAMP,LRSX,1)=URG
- +4 QUIT