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

RMPRPIYZ.m

Go to the documentation of this file. 
  1. RMPRPIYZ ;HINES CIO/ODJ - Bar Code Print all label ;10/8/02  13:11
  1.  ;;3.0;PROSTHETICS;**61,108**;Feb 09, 1996
  1.  Q
  1.  ;
  1. PB ;***** PB - Print ALL Bar Code labels
  1.  ;
  1.  ;
  1.  ;***** STN - prompt for Site/Station
  1. STN ;S RMPROVAL=$G(RMPRSTN("IEN"))
  1.  W @IOF S RMPRERR=$$STN^RMPRPIY1(.RMPRSTN,.RMPREXC)
  1.  I RMPRERR G PBX
  1.  I RMPREXC'="" G PBX
  1.  S RS=RMPRSTN("IEN") K RMPR1,RMPR11
  1.  ;
  1. LOC ; askk for location
  1.  ;
  1.  S RMPRERR=$$LOCNM^RMPRPIY2(RMPRSTN("IEN"),.RMPR5,.RMPREXC)
  1.  I RMPREXC="T"!(RMPREXC="^") G PBX
  1.  I RMPREXC="P" G STN
  1.  S RL=RMPR5("IEN") K RMPR1
  1.  ;
  1.  ;***** PRINT - print bar code labels
  1.  ;              requires RMPRNLAB (number of labels) and
  1.  ;                       RMPRBCP (bar code printer name) to be set
  1.  ;                       RMPRBARC (bar code to print)
  1.  ;                       RMPRIOP (the device to open)
  1. PRINT ;I '$D(RMPRBCP) G PRINTX
  1.  ;allows queing of bar code labels
  1. SELD S %ZIS("A")="Select Bar Code Printer: "
  1.  S %ZIS="QM" K IOP W ! D ^%ZIS G:POP PRINTX
  1.  I $G(IOST)'["P-ZEBRA" D
  1.  . W !!,"** WARNING - This is NOT a Zebra Bar Code Printer!!",!!
  1.  I '$D(IO("Q")) U IO G PNOW
  1.  K IO("Q") S ZTDESC="PRINT BAR CODE LABELS",ZTRTN="PNOW^RMPRPIYZ"
  1.  S ZTIO=ION,ZTSAVE("RS")="",ZTSAVE("RL")=""
  1.  D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!" H 2 G PRINTC
  1.  ;
  1. PNOW ;jump here if not queued.
  1.  ;
  1.  ;
  1. LOOP ;loop 661.7 for all items in a location.
  1.  F RI=0:0 S RI=$O(^RMPR(661.7,"C",RL,RI)) Q:RI'>0  S RMDAT=$G(^RMPR(661.7,RI,0)) S RMSTN=$P(RMDAT,U,5) I RMSTN=RS D PROC
  1.  ;exit/done printing bar code labels
  1.  G PRINTC
  1.  ;
  1. PROC ;process bar code for printing.
  1.  S (RMPRNLAB,RME)=0,RMPR11("DESCRIPTION")=""
  1.  S RMPR6("VENDOR")="",RMLOCNA=""
  1.  K RMPR7I,RM441,RM661
  1.  S RMPR7("IEN")=RI,RMPR7("HCPCS")=$P(RMDAT,U,1)
  1.  S RMPR7("ITEM")=$P(RMDAT,U,4),RH=$P(RMDAT,U,1)
  1.  S RD=$P(RMDAT,U,2)
  1.  S (RMPR7("LOCATION"),RMLOC)=$P(RMDAT,U,6)
  1.  S RMPR7("VALUE")=$P(RMDAT,U,8),RMPR7("QUANTITY")=$P(RMDAT,U,7)
  1.  I $G(RMLOC),$D(^RMPR(661.5,RMLOC,0)) D
  1.  .S RMLOCNA=$P(^RMPR(661.5,RMLOC,0),U,1)
  1.  ;
  1. ITEM ;get 661.11 record
  1.  S RMPR11("IEN")=$O(^RMPR(661.11,"ASHI",RS,RH,RMPR7("ITEM"),0))
  1.  S RME=$$GET^RMPRPIX1(.RMPR11)
  1.  I RME=1 Q
  1.  ;
  1. VEND ;get vendor from 661.6.
  1.  S RMV="",RMPR6("VENDOR")="",RMPR11("ITEM MSTER")=""
  1.  F K=0:0 S K=$O(^RMPR(661.6,"C",RD,K)) Q:K'>0  S RM6=$G(^RMPR(661.6,K,0)) D
  1.  .Q:RH'=$P(RM6,U,1)
  1.  .I (RH=$P(RM6,U,1)),(RMLOC=$P(RM6,U,14)) S RMV=$P(RM6,U,12)
  1.  .S:$G(RMV) RMPR6("VENDOR")=$$GETVEN^RMPRPIU0(RMV)
  1.  ;
  1.  ;external format of items at #661.7
  1.  S RME=$$ETOI^RMPRPIX7(.RMPR7,.RMPR7I)
  1.  I RME=1 Q
  1.  ;
  1.  ;set variables for printing bar code.
  1.  S RMPRBARC=RMPR7I("HCPCS")_"-"_$P(RMPR7I("DATE&TIME"),".",1)_$P(RMPR7I("DATE&TIME"),".",2)
  1.  S RMPRITXT("DATE")=$E(RMPR7I("DATE&TIME"),4,5)_"/"_$E(RMPR7I("DATE&TIME"),6,7)_"/"_(1700+$E(RMPR7I("DATE&TIME"),1,3))
  1.  S RMPRITXT("ITEM")=RMPR11("HCPCS-ITEM")
  1.  S RMPRITXT("MASTER DESC")=RMPR11("ITEM MASTER")
  1.  S RMPRITXT("ITEM DESC")=RMPR11("DESCRIPTION")
  1.  S RMPRITXT("UNIT PRICE")=+$J(RMPR7("VALUE")/RMPR7("QUANTITY"),0,2)
  1.  S RMPRITXT("VENDOR")=RMPR6("VENDOR")
  1.  S RMPRITXT("LOCATION")=RMLOCNA
  1.  S RMPRNLAB=RMPR7("QUANTITY")
  1.  ;call bar code routine
  1.  D ZPLII^RMPRPI11(RMPRBARC,.RMPRITXT,RMPRNLAB)
  1.  Q
  1.  ;
  1. PRINTC ;
  1.  D ^%ZISC K IONOFF
  1.  ;
  1. PBX D KILL^XUSCLEAN
  1. PRINTX Q