LA7SBCR2 ;DALOI/JMC - Shipping Barcode Reader Utility ;05/29/12 10:28
;;5.2;AUTOMATED LAB INSTRUMENTS;**27,46,64,74**;Sep 27, 1994;Build 229
;
Q
;
SITE(LA7,LA7PROM,LA7BAR) ; Setup remote site info.
; Input:
; LA7=array to return values
; LA7PROM=prompt to display to user
; LA7BAR=0/1 using barcode reader
; Screen: Second piece of bar-code must = SITE
; Returns array LA7()
;
; If successful ERROR=0
; IDTYPE=source of UID
; HSITE=host site ien^name^station number
; LPC=longitudinal parity check of SM barcode info
; RPSITE=primary sending site ien^name^station number
; RSITE=sending site ien^name^station number
; SCFG=pointer to shipping configuration (file #62.9)^name
; SDT=Shipping date/time
; SMID=shipping manifest id
;
; unsuccessful ERROR=>0^error message
;
N LA7X,X,Y
; Initialize array.
F Y="ERROR","HSITE","IDTYPE","LPC","RPSITE","RSITE","SCFG","SDT","SMID" S LA7(Y)=""
S LA7PROM=$G(LA7PROM,"Site")
I LA7BAR D BAR
;
I 'LA7BAR D
. N DIR,DIRUT,DTOUT,DUOUT,X,Y
. S DIR(0)="PO^62.9:EM",DIR("A")="Select Shipping Configuration"
. S DIR("S")="I $P(^LAHM(62.9,Y,0),U,3)=DUZ(2),$P(^LAHM(62.9,Y,0),U,4)"
. D ^DIR
. I Y<1 S LA7("ERROR")=1 Q
. S LA7("SCFG")=Y
;
I 'LA7("ERROR") D
. I LA7("SCFG") D GETSITE Q
. I 'LA7("SCFG") S LA7("ERROR")=3 Q
;
I LA7("ERROR") D
. S LA7("ERROR")=LA7("ERROR")_"^"_$P($T(ERROR+LA7("ERROR")),";;",2)
;
Q
;
;
GETSITE ; Retrieve site info from institution file for this shipping configuration.
; Set ID type from shipping configuration.
N LRX,LRY,X,Y
S Y(0)=$G(^LAHM(62.9,+LA7("SCFG"),0))
S LA7("IDTYPE")=$P(Y(0),"^",5)
;
; Check if same system and idtype=3
I LA7("IDTYPE")>1 D
. I LA7("IDTYPE")=3,$P(Y(0),"^",6)=$P(Y(0),"^",11) Q
. S LA7("ERROR")=4
;
S LRX=$P(Y(0),"^",2)
S LRY=$$GET1^DIQ(4,LRX_",",.01)
I LRX,LRY'="" D
. S LRY(99)=$$RETFACID^LA7VHLU2(LRX,2,1)
. S LA7("RSITE")=LRX_"^"_LRY_"^"_LRY(99)
E S LA7("ERROR")=5
;
S LRX=$P(Y(0),"^",6)
S LRY=$$GET1^DIQ(4,LRX_",",.01)
I LRX,LRY'="" D
. S LRY(99)=$$RETFACID^LA7VHLU2(LRX,2,1)
. S LA7("RPSITE")=LRX_"^"_LRY_"^"_LRY(99)
E S LA7("ERROR")=5
;
S LRX=$P(Y(0),"^",3)
S LRY=$$GET1^DIQ(4,LRX_",",.01)
I LRX,LRY'="" D
. S LRY(99)=$$RETFACID^LA7VHLU2(LRX,1,1)
. S LA7("HSITE")=LRX_"^"_LRY_"^"_LRY(99)
I 'LRX!(LRY="") S LA7("ERROR")=5
;
Q
;
;
BAR ; Read SM bar code
;
N LA7BCS,Y
;
S Y=$$RD^LA7SBCR(.LA7PROM,1),LA7=""
I Y=0 S LA7("ERROR")=1 Q
I Y<1 S LA7("ERROR")=2 Q
;
; barcode info & longitudinal parity check
; original bar code style
I $E(Y,1,11)="1^STX^SITE^" D
. S LA7=$P(Y,"STX^SITE^",2)
. S LA7=$P(LA7,"^ETX",1)
. S LA7("LPC")=$P(Y,"^ETX",2)
; new bar code style
I $E(Y,1,7)="1^SITE^" D
. S LA7=$P(Y,"^",3,5)
. S LA7("LPC")=$P(Y,"^",6)
. S LA7BCS=1
;
I LA7="" S LA7("ERROR")=2 Q
;
I $P(LA7,"^")'="" D
. N X,Y,Z
. S Z=$$FINDSITE^LA7VHLU2($P(LA7,"^"),2,1)
. I Z="" S LA7("ERROR")=5 Q
. S (X,Y)=0
. F S X=$O(^LAHM(62.9,"C",Z,X)) Q:'X D Q:Y
. . S X(0)=$G(^LAHM(62.9,X,0))
. . I $P(X(0),"^",3)=DUZ(2),$P(X(0),"^",4) S LA7("SCFG")=X_"^"_$P(X(0),"^"),Y=1
;
; shipping date/time
I $P(LA7,"^",2) S LA7("SDT")=$$DT^LA7SBCR($P(LA7,"^",2))
;
; shipping manifest id
I $P(LA7,"^",3)'="" S LA7("SMID")=$P(LA7,"^",3)
;
Q
;
;
ERROR ;; Code/Text of error messages
1 ;;User timeout/abort;;
2 ;;Incorrect barcode format;;
3 ;;No Shipping Configuration identified in file #62.9;;
4 ;;Sender's Specimen ID source not presently supported;;
5 ;;No entry in INSTITUTION file #4;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA7SBCR2 3769 printed Oct 16, 2024@17:40:13 Page 2
LA7SBCR2 ;DALOI/JMC - Shipping Barcode Reader Utility ;05/29/12 10:28
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**27,46,64,74**;Sep 27, 1994;Build 229
+2 ;
+3 QUIT
+4 ;
SITE(LA7,LA7PROM,LA7BAR) ; Setup remote site info.
+1 ; Input:
+2 ; LA7=array to return values
+3 ; LA7PROM=prompt to display to user
+4 ; LA7BAR=0/1 using barcode reader
+5 ; Screen: Second piece of bar-code must = SITE
+6 ; Returns array LA7()
+7 ;
+8 ; If successful ERROR=0
+9 ; IDTYPE=source of UID
+10 ; HSITE=host site ien^name^station number
+11 ; LPC=longitudinal parity check of SM barcode info
+12 ; RPSITE=primary sending site ien^name^station number
+13 ; RSITE=sending site ien^name^station number
+14 ; SCFG=pointer to shipping configuration (file #62.9)^name
+15 ; SDT=Shipping date/time
+16 ; SMID=shipping manifest id
+17 ;
+18 ; unsuccessful ERROR=>0^error message
+19 ;
+20 NEW LA7X,X,Y
+21 ; Initialize array.
+22 FOR Y="ERROR","HSITE","IDTYPE","LPC","RPSITE","RSITE","SCFG","SDT","SMID"
SET LA7(Y)=""
+23 SET LA7PROM=$GET(LA7PROM,"Site")
+24 IF LA7BAR
DO BAR
+25 ;
+26 IF 'LA7BAR
Begin DoDot:1
+27 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+28 SET DIR(0)="PO^62.9:EM"
SET DIR("A")="Select Shipping Configuration"
+29 SET DIR("S")="I $P(^LAHM(62.9,Y,0),U,3)=DUZ(2),$P(^LAHM(62.9,Y,0),U,4)"
+30 DO ^DIR
+31 IF Y<1
SET LA7("ERROR")=1
QUIT
+32 SET LA7("SCFG")=Y
End DoDot:1
+33 ;
+34 IF 'LA7("ERROR")
Begin DoDot:1
+35 IF LA7("SCFG")
DO GETSITE
QUIT
+36 IF 'LA7("SCFG")
SET LA7("ERROR")=3
QUIT
End DoDot:1
+37 ;
+38 IF LA7("ERROR")
Begin DoDot:1
+39 SET LA7("ERROR")=LA7("ERROR")_"^"_$PIECE($TEXT(ERROR+LA7("ERROR")),";;",2)
End DoDot:1
+40 ;
+41 QUIT
+42 ;
+43 ;
GETSITE ; Retrieve site info from institution file for this shipping configuration.
+1 ; Set ID type from shipping configuration.
+2 NEW LRX,LRY,X,Y
+3 SET Y(0)=$GET(^LAHM(62.9,+LA7("SCFG"),0))
+4 SET LA7("IDTYPE")=$PIECE(Y(0),"^",5)
+5 ;
+6 ; Check if same system and idtype=3
+7 IF LA7("IDTYPE")>1
Begin DoDot:1
+8 IF LA7("IDTYPE")=3
IF $PIECE(Y(0),"^",6)=$PIECE(Y(0),"^",11)
QUIT
+9 SET LA7("ERROR")=4
End DoDot:1
+10 ;
+11 SET LRX=$PIECE(Y(0),"^",2)
+12 SET LRY=$$GET1^DIQ(4,LRX_",",.01)
+13 IF LRX
IF LRY'=""
Begin DoDot:1
+14 SET LRY(99)=$$RETFACID^LA7VHLU2(LRX,2,1)
+15 SET LA7("RSITE")=LRX_"^"_LRY_"^"_LRY(99)
End DoDot:1
+16 IF '$TEST
SET LA7("ERROR")=5
+17 ;
+18 SET LRX=$PIECE(Y(0),"^",6)
+19 SET LRY=$$GET1^DIQ(4,LRX_",",.01)
+20 IF LRX
IF LRY'=""
Begin DoDot:1
+21 SET LRY(99)=$$RETFACID^LA7VHLU2(LRX,2,1)
+22 SET LA7("RPSITE")=LRX_"^"_LRY_"^"_LRY(99)
End DoDot:1
+23 IF '$TEST
SET LA7("ERROR")=5
+24 ;
+25 SET LRX=$PIECE(Y(0),"^",3)
+26 SET LRY=$$GET1^DIQ(4,LRX_",",.01)
+27 IF LRX
IF LRY'=""
Begin DoDot:1
+28 SET LRY(99)=$$RETFACID^LA7VHLU2(LRX,1,1)
+29 SET LA7("HSITE")=LRX_"^"_LRY_"^"_LRY(99)
End DoDot:1
+30 IF 'LRX!(LRY="")
SET LA7("ERROR")=5
+31 ;
+32 QUIT
+33 ;
+34 ;
BAR ; Read SM bar code
+1 ;
+2 NEW LA7BCS,Y
+3 ;
+4 SET Y=$$RD^LA7SBCR(.LA7PROM,1)
SET LA7=""
+5 IF Y=0
SET LA7("ERROR")=1
QUIT
+6 IF Y<1
SET LA7("ERROR")=2
QUIT
+7 ;
+8 ; barcode info & longitudinal parity check
+9 ; original bar code style
+10 IF $EXTRACT(Y,1,11)="1^STX^SITE^"
Begin DoDot:1
+11 SET LA7=$PIECE(Y,"STX^SITE^",2)
+12 SET LA7=$PIECE(LA7,"^ETX",1)
+13 SET LA7("LPC")=$PIECE(Y,"^ETX",2)
End DoDot:1
+14 ; new bar code style
+15 IF $EXTRACT(Y,1,7)="1^SITE^"
Begin DoDot:1
+16 SET LA7=$PIECE(Y,"^",3,5)
+17 SET LA7("LPC")=$PIECE(Y,"^",6)
+18 SET LA7BCS=1
End DoDot:1
+19 ;
+20 IF LA7=""
SET LA7("ERROR")=2
QUIT
+21 ;
+22 IF $PIECE(LA7,"^")'=""
Begin DoDot:1
+23 NEW X,Y,Z
+24 SET Z=$$FINDSITE^LA7VHLU2($PIECE(LA7,"^"),2,1)
+25 IF Z=""
SET LA7("ERROR")=5
QUIT
+26 SET (X,Y)=0
+27 FOR
SET X=$ORDER(^LAHM(62.9,"C",Z,X))
if 'X
QUIT
Begin DoDot:2
+28 SET X(0)=$GET(^LAHM(62.9,X,0))
+29 IF $PIECE(X(0),"^",3)=DUZ(2)
IF $PIECE(X(0),"^",4)
SET LA7("SCFG")=X_"^"_$PIECE(X(0),"^")
SET Y=1
End DoDot:2
if Y
QUIT
End DoDot:1
+30 ;
+31 ; shipping date/time
+32 IF $PIECE(LA7,"^",2)
SET LA7("SDT")=$$DT^LA7SBCR($PIECE(LA7,"^",2))
+33 ;
+34 ; shipping manifest id
+35 IF $PIECE(LA7,"^",3)'=""
SET LA7("SMID")=$PIECE(LA7,"^",3)
+36 ;
+37 QUIT
+38 ;
+39 ;
ERROR ;; Code/Text of error messages
1 ;;User timeout/abort;;
2 ;;Incorrect barcode format;;
3 ;;No Shipping Configuration identified in file #62.9;;
4 ;;Sender's Specimen ID source not presently supported;;
5 ;;No entry in INSTITUTION file #4;;
