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) ;26-Feb-2013 11:57;PLS
  1.  ;;3.0;BAR CODE MED ADMIN;**1015**;Mar 2004;Build 62
  1.  ;
  1.  ; Reference/IA
  1.  ; File 50/221
  1.  ;
  1.  ; Modified - IHS/MSC/PLS - 02/26/13 - Line EN+14
  1. EN ;
  1.  N PSBIENS,PSBBAR,PSBDRUG,PSBQTY,PSBDOSE,PSBNAME,PSBWARD,PSBLOT
  1.  N PSBEXP,PSBMFG,PSBFCB,PSBSYM,PSBCNT,PSBANS,PSBORD
  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 PSBDOSE=$$GET1^DIQ(53.69,PSBIENS,.39)
  1.  S PSBNAME=$$GET1^DIQ(53.69,PSBIENS,.12)
  1.  ;IHS/MSC/PLS - 02/26/13
  1.  ;I PSBNAME]"" S PSBNAME=PSBNAME_" ("_$E($$GET1^DIQ(53.69,PSBIENS,.121),6,9)_")"
  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))_")"
  1.  S PSBWARD=$$GET1^DIQ(53.69,PSBIENS,.122)
  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.  I PSBDOSE]"" W $$DATA(20,60,"Dosage:") W $$DATA(100,60,PSBDOSE)
  1.  I PSBNAME]"" W $$DATA(350,60,PSBNAME)
  1.  I PSBWARD]"" W $$DATA(350,90,"Ward:") W $$DATA(400,90,PSBWARD)
  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
  1.  I PSBSYM="C39" W !,"^BY2,3.0^FO20,100^B3N,N,80,Y,N^FR^FD"_PSBBAR_"^FS"
  1.  ;
  1.  ; Code 128
  1.  I PSBSYM="128" W !,"^BY2,3.0^FO20,100^BCN,80,Y,N,N^FR^FD>:"_PSBBAR_"^FS"
  1.  ;
  1.  ; Code I 2 of 5
  1.  I PSBSYM="I25" 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.  ;