| [613] | 1 | SRBL ;BIR/ADM - BLOOD PRODUCT VERIFICATION FOR VBECS ;09/01/05
|
|---|
| 2 | ;;3.0; Surgery ;**148**;24 Jun 93
|
|---|
| 3 | ;
|
|---|
| 4 | ; Reference to AVUNIT^VBECA1B supported by DBIA #4629
|
|---|
| 5 | ;
|
|---|
| 6 | SCAN D BAR ; test bar code reader
|
|---|
| 7 | S SRQ=0,DFN=$P(^SRF(SRTN,0),"^") K ^TMP("SRBL",$J)
|
|---|
| 8 | D AVUNIT^VBECA1B("SRBL",DFN) ; get list of units available for the patient
|
|---|
| 9 | TST K DIR S DIR(0)="FA^1:50",(SRPROMPT,DIR("A"))="Enter Blood Product Identifier: "
|
|---|
| 10 | S DIR("?")="Enter or scan the Blood Product Unit Id" D ^DIR K DIR G END:$D(DTOUT)!$D(DUOUT)
|
|---|
| 11 | D CODA,MATCH I 'SRMATCH G SRNO
|
|---|
| 12 | I SRMATCH=1 S SRY=SRMATCH D SRYES Q
|
|---|
| 13 | D LIST I SRQ G END
|
|---|
| 14 | S SRY=Y D SRYES
|
|---|
| 15 | Q
|
|---|
| 16 | LIST W ! S Y=^TMP("SRBL",$J,0),Z=$P(Y,"^",7),SRSSN=$E(Z,1,3)_"-"_$E(Z,4,5)_"-"_$E(Z,6,12)
|
|---|
| 17 | S SRNAME=$P(Y,"^",5)_","_$P(Y,"^",4)_" "_SRSSN
|
|---|
| 18 | S (SRI,SRZ)=0 F S SRZ=$O(SRBL(SRZ)) Q:'SRZ D
|
|---|
| 19 | .S Z=SRBL(SRZ),SRPROD=$P(Z,"^",4),X=$P(Z,"^",2) D ^%DT S SREXP=Y
|
|---|
| 20 | .W !!," ",SRZ_") Unit ID: ",SRUID,?45,SRPROD
|
|---|
| 21 | .W !,?4,"Patient: ",SRNAME,?45,"Expiration Date: " S Y=SREXP D DD^%DT W Y
|
|---|
| 22 | .S SRI=SRI+1
|
|---|
| 23 | W ! K DIR S DIR(0)="NO^1:"_SRI,DIR("A")="Select the blood product matching the unit label"
|
|---|
| 24 | D ^DIR K DIR I $D(DTOUT)!$D(DUOUT)!'Y S SRQ=1 Q
|
|---|
| 25 | S SRY=Y
|
|---|
| 26 | Q
|
|---|
| 27 | MATCH ; retrieve matching units from list of available units
|
|---|
| 28 | S (SRIDT,SRMATCH)=0 F S SRIDT=$O(^TMP("SRBL",$J,SRIDT)) Q:'SRIDT D
|
|---|
| 29 | .S X=^TMP("SRBL",$J,SRIDT)
|
|---|
| 30 | .I $P(X,"^",3)=SRUID S SRMATCH=SRMATCH+1,SRBL(SRMATCH)=X
|
|---|
| 31 | Q
|
|---|
| 32 | CODA ; interpret Codabar barcodes used to label the Unit ID of blood component
|
|---|
| 33 | I $$ISBTUID(.X) S SRUID=X Q
|
|---|
| 34 | S SRUID=$$STRIP(X)
|
|---|
| 35 | W ?45,"UNIT ID: ",SRUID
|
|---|
| 36 | Q
|
|---|
| 37 | SRYES S X=$P(SRBL(SRY),"^",2) D ^%DT I Y<DT D D ASK Q
|
|---|
| 38 | .I SRMATCH=1 D LIST
|
|---|
| 39 | .W !!,?30,"**WARNING**",!!,"Today's date exceeds the blood product expiration date.",!
|
|---|
| 40 | W !!!,?25,"No Discrepancies Found",!!! K DIR S DIR(0)="FOA",DIR("A")="Press RETURN to continue" D ^DIR G END
|
|---|
| 41 | SRNO W !!,?30,"**WARNING**",!!
|
|---|
| 42 | W ?5,"There is no record that this unit has been assigned to this patient."
|
|---|
| 43 | W !!,?8," Please recheck the patient and blood product IDs.",!!
|
|---|
| 44 | ASK K DIR S DIR(0)="Y",DIR("A")="Do you want to scan another product (Y/N)",DIR("B")="YES" D ^DIR I Y D END G SCAN
|
|---|
| 45 | END K ^TMP("SRBL",$J),DIR,SR,SRBL,SREXP,SRI,SRIDT,SRMATCH,SRNAME,SRPROD,SRPROMPT,SRQ,SRSSN,SRUID,SRY,SRZ,X,Y,Z
|
|---|
| 46 | Q
|
|---|
| 47 | STRIP(X) ; strip off any ISBT-128 barcode identifier characters
|
|---|
| 48 | S X=$TR(X,"=<>&%(","")
|
|---|
| 49 | Q X
|
|---|
| 50 | BAR ; test bar code reader
|
|---|
| 51 | N A,SR,SRABO,SRRH,SRPROMPT,X,Y S SR=""
|
|---|
| 52 | K DIR S DIR(0)="FAO^1:20" S DIR("A",1)="",(SRPROMPT,DIR("A"))=" => "
|
|---|
| 53 | S DIR("A",2)=" To use BAR CODE READER"
|
|---|
| 54 | S DIR("A",3)=" Pass reader wand over a GROUP-TYPE (ABO/Rh) label"
|
|---|
| 55 | S DIR("?",2)=" To test scanner, scan a GROUP-TYPE (ABO/Rh) label. Otherwise, press"
|
|---|
| 56 | S DIR("?",1)="",DIR("?")=" the Enter key." D ^DIR K DIR Q:$D(DTOUT)!$D(DUOUT)!(X="")
|
|---|
| 57 | W $C(13),$J("",79),$C(13),SRPROMPT,"(Bar code)"
|
|---|
| 58 | D ISBTBG(X,.SRABO,.SRRH) I SRABO]"" D Q
|
|---|
| 59 | .S SR=1,SR(2)=""
|
|---|
| 60 | .W " ",SRABO," ",SRRH
|
|---|
| 61 | S X=$$STRIP(X)
|
|---|
| 62 | F A=1:1 S Y=$P($T(G+A),";",4) Q:Y="" S X(1)=$F(X,Y) I X(1),$L(X)<X(1) S SR=$L(X)-3,SR(2)=$E(X,1,SR),SR=SR+1 Q
|
|---|
| 63 | I SR="" W $C(7),!!?28,"Not a GROUP-TYPE label",!?15,"Press <ENTER> key if BAR CODE READER is not used",! G BAR
|
|---|
| 64 | W " ",$P($T(G+A),";",3)
|
|---|
| 65 | Q
|
|---|
| 66 | ISBTBG(SRIN,SRBLABO,SRBLRH) ; check for ISBT-128 valid blood group and return ABO & Rh values
|
|---|
| 67 | ; Valid codes are prefixed by "=%".
|
|---|
| 68 | ;
|
|---|
| 69 | ; INPUT : SRIN = input from Blood Group barcode label.
|
|---|
| 70 | ; OUTPUT : SRBLABO (passed by reference) = ABO value
|
|---|
| 71 | ; SRBLRH (passed by reference) = Rh value
|
|---|
| 72 | ;
|
|---|
| 73 | N Z S (SRBLABO,SRBLRH)=""
|
|---|
| 74 | Q:$L(SRIN)'>3
|
|---|
| 75 | Q:$E(SRIN,1,2)'="=%"
|
|---|
| 76 | S Z=$E(SRIN,3,4)
|
|---|
| 77 | S SRBLABO=$S(57<Z&(Z<66):"A POS",46<Z&(Z<55):"O POS",90<Z&(Z<99):"O NEG",1<Z&(Z<10):"A NEG",12<Z&(Z<21):"B NEG",68<Z&(Z<77):"B POS",23<Z&(Z<32):"AB NEG",79<Z&(Z<88):"AB POS",1:"")
|
|---|
| 78 | Q:SRBLABO=""
|
|---|
| 79 | S SRBLRH=$P(SRBLABO," ",2)
|
|---|
| 80 | S SRBLABO=$P(SRBLABO," ")
|
|---|
| 81 | Q
|
|---|
| 82 | ISBTUID(SRBLIN) ; Check for and display valid ISBT-128 Unit Id
|
|---|
| 83 | ; Valid codes are prefixed by "="
|
|---|
| 84 | ;
|
|---|
| 85 | ; INPUT : SRBLIN = input from Unit Id barcode label.
|
|---|
| 86 | ; OUTPUT : Boolean
|
|---|
| 87 | ;
|
|---|
| 88 | Q:$E(SRBLIN,1,2)'?1"="1(1A,1N) 0
|
|---|
| 89 | S SRBLIN=$E(SRBLIN,2,14)
|
|---|
| 90 | S SRBLIN=$$UP^XLFSTR(SRBLIN) ; make uppercase
|
|---|
| 91 | W $C(13),$J("",79),$C(13),SRPROMPT,?32,"(Bar code)"
|
|---|
| 92 | D EN^DDIOL("UNIT ID: "_SRBLIN,"","?46")
|
|---|
| 93 | Q 1
|
|---|
| 94 | G ;;
|
|---|
| 95 | 51 ;;O POS;510
|
|---|
| 96 | 62 ;;A POS;620
|
|---|
| 97 | 73 ;;B POS;730
|
|---|
| 98 | 84 ;;AB POS;840
|
|---|
| 99 | 95 ;;O NEG;950
|
|---|
| 100 | 6 ;;A NEG;060
|
|---|
| 101 | 17 ;;B NEG;170
|
|---|
| 102 | 28 ;;AB NEG;280
|
|---|
| 103 | 55 ;;O;550
|
|---|
| 104 | 66 ;;A;660
|
|---|
| 105 | 77 ;;B;770
|
|---|
| 106 | 88 ;;AB;880
|
|---|
| 107 | ;;NA NA;
|
|---|
