source: FOIAVistA/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7SBCR2.m@ 1800

Last change on this file since 1800 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 3.3 KB
Line 
1LA7SBCR2 ;DALOI/JMC - Shipping Barcode Reader Utility ; 16 Sept 2004
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**27,46,64**;Sep 27, 1994
3 ;
4 Q
5 ;
6SITE(LA7,LA7PROM,LA7BAR) ; Setup remote site info.
7 ; Input:
8 ; LA7=array to return values
9 ; LA7PROM=prompt to display to user
10 ; LA7BAR=0/1 using barcode reader
11 ; Screen: Second piece of bar-code must = SITE
12 ; Returns array LA7()
13 ;
14 ; If successful ERROR=0
15 ; IDTYPE=source of UID
16 ; LPC=longitudinal parity check of SM barcode info
17 ; RPSITE=primary sending site ien^name^station number
18 ; RSITE=sending site ien^name^station number
19 ; SCFG=pointer to shipping configuration (file #62.9)^name
20 ; SDT=Shipping date/time
21 ; SMID=shipping manifest id
22 ;
23 ; unsuccessful ERROR=>0^error message
24 ;
25 N LA7X,X,Y
26 ; Initialize array.
27 F Y="ERROR","IDTYPE","LPC","RPSITE","RSITE","SCFG","SDT","SMID" S LA7(Y)=""
28 S LA7PROM=$G(LA7PROM,"Site")
29 I LA7BAR D BAR
30 ;
31 I 'LA7BAR D
32 . N DIR,DIRUT,DTOUT,DUOUT,X,Y
33 . S DIR(0)="PO^62.9:EM",DIR("A")="Select Shipping Configuration"
34 . S DIR("S")="I $P(^LAHM(62.9,Y,0),U,3)=DUZ(2),$P(^LAHM(62.9,Y,0),U,4)"
35 . D ^DIR
36 . I Y<1 S LA7("ERROR")=1 Q
37 . S LA7("SCFG")=Y
38 ;
39 I 'LA7("ERROR") D
40 . I LA7("SCFG") D GETSITE Q
41 . I 'LA7("SCFG") S LA7("ERROR")=3 Q
42 ;
43 I LA7("ERROR") D
44 . S LA7("ERROR")=LA7("ERROR")_"^"_$P($T(ERROR+LA7("ERROR")),";;",2)
45 ;
46 Q
47 ;
48 ;
49GETSITE ; Retrieve site info from institution file for this shipping configuration.
50 ; Set ID type from shipping configuration.
51 N LRX,LRY,X,Y
52 S Y(0)=$G(^LAHM(62.9,+LA7("SCFG"),0))
53 S LA7("IDTYPE")=$P(Y(0),"^",5)
54 ;
55 ; *** Remove line when other id types supported. ***
56 I LA7("IDTYPE")>1 S LA7("ERROR")=4
57 ;
58 S LRX=$P(Y(0),"^",2)
59 S LRY=$$GET1^DIQ(4,LRX_",",.01)
60 I LRX,LRY'="" D
61 . S LRY(99)=$$RETFACID^LA7VHLU2(LRX,2,1)
62 . S LA7("RSITE")=LRX_"^"_LRY_"^"_LRY(99)
63 E S LA7("ERROR")=5
64 ;
65 S LRX=$P(Y(0),"^",6)
66 S LRY=$$GET1^DIQ(4,LRX_",",.01)
67 I LRX,LRY'="" D
68 . S LRY(99)=$$RETFACID^LA7VHLU2(LRX,2,1)
69 . S LA7("RPSITE")=LRX_"^"_LRY_"^"_LRY(99)
70 E S LA7("ERROR")=5
71 Q
72 ;
73 ;
74BAR ; Read SM bar code
75 ;
76 N LA7BCS,Y
77 ;
78 S Y=$$RD^LA7SBCR(.LA7PROM,1),LA7=""
79 I Y=0 S LA7("ERROR")=1 Q
80 I Y<1 S LA7("ERROR")=2 Q
81 ;
82 ; barcode info & longitudinal parity check
83 ; original bar code style
84 I $E(Y,1,11)="1^STX^SITE^" D
85 . S LA7=$P(Y,"STX^SITE^",2)
86 . S LA7=$P(LA7,"^ETX",1)
87 . S LA7("LPC")=$P(Y,"^ETX",2)
88 ; new bar code style
89 I $E(Y,1,7)="1^SITE^" D
90 . S LA7=$P(Y,"^",3,5)
91 . S LA7("LPC")=$P(Y,"^",6)
92 . S LA7BCS=1
93 ;
94 I LA7="" S LA7("ERROR")=2 Q
95 ;
96 I $P(LA7,"^")'="" D
97 . N X,Y,Z
98 . S Z=$$FINDSITE^LA7VHLU2($P(LA7,"^"),2,1)
99 . I Z="" S LA7("ERROR")=5 Q
100 . S (X,Y)=0
101 . F S X=$O(^LAHM(62.9,"C",Z,X)) Q:'X D Q:Y
102 . . S X(0)=$G(^LAHM(62.9,X,0))
103 . . I $P(X(0),"^",3)=DUZ(2),$P(X(0),"^",4) S LA7("SCFG")=X_"^"_$P(X(0),"^"),Y=1
104 ;
105 ; shipping date/time
106 I $P(LA7,"^",2) S LA7("SDT")=$$DT^LA7SBCR($P(LA7,"^",2))
107 ;
108 ; shipping manifest id
109 I $P(LA7,"^",3)'="" S LA7("SMID")=$P(LA7,"^",3)
110 ;
111 Q
112 ;
113 ;
114ERROR ;; Code/Text of error messages
1151 ;;User timeout/abort;;
1162 ;;Incorrect barcode format;;
1173 ;;No Shipping Configuration identified in file #62.9;;
1184 ;;Sender's Specimen ID source not presently supported;;
1195 ;;No entry in INSTITUTION file #4;;
Note: See TracBrowser for help on using the repository browser.