Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSBOBL

PSBOBL.m

Go to the documentation of this file. 
  1. PSBOBL ;BIRMINGHAM/EFC-BAR CODE LABELS (ZEBRA SPECIFIC) ;8/18/21  18:50
  1.  ;;3.0;BAR CODE MED ADMIN;**70,81,106,131**;Mar 2004;Build 11
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; Reference/IA
  1.  ; File 50/221
  1.  ;
  1.  ;*70 - 1459: Adding clinic to BL and BZ chui labels.
  1.  ;*106- add Hazardous to Handle & Dispose alert text
  1.  ;*131 - Restore y coordinate of first line of label to '25' so as to not be truncated
  1.  ;
  1. EN ;
  1.  N PSBIENS,PSBBAR,PSBDRUG,PSBQTY,PSBDOSE,PSBNAME,PSBWARD,PSBLOT
  1.  N PSBEXP,PSBMFG,PSBFCB,PSBSYM,PSBCNT,PSBANS,PSBORD,PSBCLIN   ;[*70-1459]
  1.  N PSBDD,HAZ,PSBHAZ                                                                     ;*106
  1.  S PSBIENS=PSBRPT_","
  1.  S PSBBAR=$P($P($G(^PSB(53.69,PSBRPT,.3)),U,1),"~",2)
  1.  ;
  1.  S PSBPRE=$$GET^XPAR("DIV","PSB DEFAULT BARCODE PREFIX")
  1.  S:PSBPRE]"" PSBBAR=PSBPRE_$S(PSBPRE?1.N:"-",1:"")_PSBBAR
  1.  ;
  1.  S PSBDRUG=$$GET1^DIQ(53.69,PSBIENS,.31)
  1.  S PSBQTY=+$$GET1^DIQ(53.69,PSBIENS,.35)
  1.  S:PSBQTY PSBDRUG=PSBDRUG_" (Qty: "_PSBQTY_")"
  1.  S PSBDD=$$GET1^DIQ(53.69,PSBIENS,.31,"I"),HAZ=$$HAZ^PSSUTIL($P(PSBDD,"~",2))           ;*106
  1.  S PSBDOSE=$$GET1^DIQ(53.69,PSBIENS,.39)
  1.  S PSBNAME=$$GET1^DIQ(53.69,PSBIENS,.12)
  1.  I PSBNAME]"" S PSBNAME=PSBNAME_" ("_$S(DUZ("AG")="I":$$HRN^AUPNPAT($P($G(^PSB(53.69,+PSBIENS,.1)),U,2),$P(^(0),U,4)),1:$E($$GET1^DIQ(53.69,PSBIENS,.121),6,9))_")" ;add code for IHS, PSB*3*81
  1.  S PSBWARD=$$GET1^DIQ(53.69,PSBIENS,.122)
  1.  S PSBCLIN=$$GET1^DIQ(53.69,PSBIENS,5)                        ;[*70-1459]
  1.  S PSBLOT=$$GET1^DIQ(53.69,PSBIENS,.32)
  1.  S PSBEXP=$$GET1^DIQ(53.69,PSBIENS,.33)
  1.  S PSBMFG=$$GET1^DIQ(53.69,PSBIENS,.34)
  1.  S PSBFCB=$$GET1^DIQ(53.69,PSBIENS,.36)_"/"_$$GET1^DIQ(53.69,PSBIENS,.37)
  1.  S PSBSYM=$$GET^XPAR("DIV","PSB DEFAULT BARCODE FORMAT",,"E")
  1.  F PSBCNT=1:1:+$P(PSBRPT(.3),U,8) D LABEL
  1.  Q
  1.  ;
  1. LABEL ; Print the Label
  1.  W "^XA"
  1.  W !,"^LH0,0^FS"
  1.  W $$DATA(20,25,"Drug:")
  1.  W $$DATA(100,25,PSBDRUG)
  1.  S PSBHAZ=$S($P(HAZ,U):"<<HAZ Handle>> ",1:"") S:$P(HAZ,U,2) PSBHAZ=PSBHAZ_"<<HAZ Dispose>>"   ;*106
  1.  ; *131 - Tweaking the spacing of the dosage label and description to accommodate <HAZ> text
  1.  ;W:$G(PSBHAZ)]"" $$DATA(20,35,PSBHAZ) ;*106
  1.  ;I PSBDOSE]"" W $$DATA(20,60,"Dosage:") W $$DATA(100,60,PSBDOSE)
  1.  S HASHAZ=$G(PSBHAZ)]""
  1.  I HASHAZ D
  1.  . W $$DATA(20,50,PSBHAZ)
  1.  . I PSBDOSE]"" W $$DATA(20,75,"Dosage:") W $$DATA(100,75,PSBDOSE)
  1.  ; If no HAZ text, keep the 'pre-106' x,y coordinates
  1.  I 'HASHAZ D
  1.  . I PSBDOSE]"" W $$DATA(20,60,"Dosage:") W $$DATA(100,60,PSBDOSE)
  1.  I PSBNAME]"" W $$DATA(350,60,PSBNAME)
  1.  I PSBCLIN]"" W $$DATA(350,90,"Clinic:") W $$DATA(400,90,PSBCLIN)            ;[*70-1459]
  1.  I PSBCLIN="",PSBWARD]"" W $$DATA(350,90,"Ward:") W $$DATA(400,90,PSBWARD)   ;[*70-1459]
  1.  I PSBLOT]"" W $$DATA(350,120,"Lot#:") W $$DATA(400,120,PSBLOT)
  1.  I PSBEXP]"" W $$DATA(500,120,"Exp:") W $$DATA(550,120,PSBEXP)
  1.  I PSBMFG]"" W $$DATA(350,150,"Mfg:") W $$DATA(400,150,PSBMFG)
  1.  W $$DATA(350,180,"Filled/Checked By:") W $$DATA(520,180,PSBFCB)
  1.  ;
  1.  ; Code 39 - Adjust spacing to accommodate <HAZ> text if it exists
  1.  I PSBSYM="C39" D
  1.  . I HASHAZ W !,"^BY2,3.0^FO20,107^B3N,N,70,Y,N^FR^FD"_PSBBAR_"^FS"
  1.  . I 'HASHAZ W !,"^BY2,3.0^FO20,100^B3N,N,80,Y,N^FR^FD"_PSBBAR_"^FS"
  1.  ;
  1.  ; Code 128  - Adjust spacing to accommodate <HAZ> text if it exists
  1.  I PSBSYM="128" D
  1.  . I HASHAZ W !,"^BY2,3.0^FO20,107^BCN,70,Y,N,N^FR^FD>:"_PSBBAR_"^FS"
  1.  . I 'HASHAZ W !,"^BY2,3.0^FO20,100^BCN,80,Y,N,N^FR^FD>:"_PSBBAR_"^FS"
  1.  ;
  1.  ; Code I 2 of 5  - Adjust spacing to accommodate <HAZ> text if it exists
  1.  I PSBSYM="I25" D
  1.  . I HASHAZ W !,"^BY2,3.0^FO20,107^B2N,70,Y,N,N^FR^FD>:"_PSBBAR_"^FS"
  1.  . I 'HASHAZ W !,"^BY2,3.0^FO20,100^B2N,80,Y,N,N^FR^FD>:"_PSBBAR_"^FS"
  1.  ;
  1.  I PSBSYM="" W $$DATA(20,100,"PSB DEFAULT BARCODE FORMAT Undefined.")
  1.  ;
  1.  ; Close Label
  1.  W !,"^XZ",!
  1.  H 2
  1.  Q
  1.  ;
  1. DATA(X,Y,TEXT) ; Code to place the data on the label
  1.  W !,"^FO"_X_","_Y_"^A0N,30,20^CI13^FR^FD"_TEXT_"^FS"
  1.  Q ""
  1.  ;
  1. INPTR ;Input transform for DRUG field (#.31) in file 53.69.
  1.  K:$L(X)>40!($L(X)<1) X I $D(X) D
  1.  .S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  1.  .N DIC S DIC="^PSDRUG(",DIC(0)="EQNM",D="B^C^VAPN^VAC^NDC^XATC"
  1.  .S DIC("S")="I '$G(^PSDRUG(+Y,""I""))!($G(^(""I""))>DT),$P($G(^PSDRUG(+Y,2)),U,3)[""I""!($P($G(^PSDRUG(+Y,2)),U,3)[""U"")"
  1.  .D:+X'>0 MIX^DIC1
  1.  .D:+X>0 ^DIC
  1.  .S:+Y>0 X=$$GET1^DIQ(50,+Y_",",.01)_"~"_+Y K:+Y<1 X
  1.  Q
  1.  ;