[613] | 1 | RMPRPIYZ ;HINES CIO/ODJ - Bar Code Print all label ;10/8/02 13:11
|
---|
| 2 | ;;3.0;PROSTHETICS;**61,108**;Feb 09, 1996
|
---|
| 3 | Q
|
---|
| 4 | ;
|
---|
| 5 | PB ;***** PB - Print ALL Bar Code labels
|
---|
| 6 | ;
|
---|
| 7 | ;
|
---|
| 8 | ;***** STN - prompt for Site/Station
|
---|
| 9 | STN ;S RMPROVAL=$G(RMPRSTN("IEN"))
|
---|
| 10 | W @IOF S RMPRERR=$$STN^RMPRPIY1(.RMPRSTN,.RMPREXC)
|
---|
| 11 | I RMPRERR G PBX
|
---|
| 12 | I RMPREXC'="" G PBX
|
---|
| 13 | S RS=RMPRSTN("IEN") K RMPR1,RMPR11
|
---|
| 14 | ;
|
---|
| 15 | LOC ; askk for location
|
---|
| 16 | ;
|
---|
| 17 | S RMPRERR=$$LOCNM^RMPRPIY2(RMPRSTN("IEN"),.RMPR5,.RMPREXC)
|
---|
| 18 | I RMPREXC="T"!(RMPREXC="^") G PBX
|
---|
| 19 | I RMPREXC="P" G STN
|
---|
| 20 | S RL=RMPR5("IEN") K RMPR1
|
---|
| 21 | ;
|
---|
| 22 | ;***** PRINT - print bar code labels
|
---|
| 23 | ; requires RMPRNLAB (number of labels) and
|
---|
| 24 | ; RMPRBCP (bar code printer name) to be set
|
---|
| 25 | ; RMPRBARC (bar code to print)
|
---|
| 26 | ; RMPRIOP (the device to open)
|
---|
| 27 | PRINT ;I '$D(RMPRBCP) G PRINTX
|
---|
| 28 | ;allows queing of bar code labels
|
---|
| 29 | SELD S %ZIS("A")="Select Bar Code Printer: "
|
---|
| 30 | S %ZIS="QM" K IOP W ! D ^%ZIS G:POP PRINTX
|
---|
| 31 | I $G(IOST)'["P-ZEBRA" D
|
---|
| 32 | . W !!,"** WARNING - This is NOT a Zebra Bar Code Printer!!",!!
|
---|
| 33 | I '$D(IO("Q")) U IO G PNOW
|
---|
| 34 | K IO("Q") S ZTDESC="PRINT BAR CODE LABELS",ZTRTN="PNOW^RMPRPIYZ"
|
---|
| 35 | S ZTIO=ION,ZTSAVE("RS")="",ZTSAVE("RL")=""
|
---|
| 36 | D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!" H 2 G PRINTC
|
---|
| 37 | ;
|
---|
| 38 | PNOW ;jump here if not queued.
|
---|
| 39 | ;
|
---|
| 40 | ;
|
---|
| 41 | LOOP ;loop 661.7 for all items in a location.
|
---|
| 42 | 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
|
---|
| 43 | ;exit/done printing bar code labels
|
---|
| 44 | G PRINTC
|
---|
| 45 | ;
|
---|
| 46 | PROC ;process bar code for printing.
|
---|
| 47 | S (RMPRNLAB,RME)=0,RMPR11("DESCRIPTION")=""
|
---|
| 48 | S RMPR6("VENDOR")="",RMLOCNA=""
|
---|
| 49 | K RMPR7I,RM441,RM661
|
---|
| 50 | S RMPR7("IEN")=RI,RMPR7("HCPCS")=$P(RMDAT,U,1)
|
---|
| 51 | S RMPR7("ITEM")=$P(RMDAT,U,4),RH=$P(RMDAT,U,1)
|
---|
| 52 | S RD=$P(RMDAT,U,2)
|
---|
| 53 | S (RMPR7("LOCATION"),RMLOC)=$P(RMDAT,U,6)
|
---|
| 54 | S RMPR7("VALUE")=$P(RMDAT,U,8),RMPR7("QUANTITY")=$P(RMDAT,U,7)
|
---|
| 55 | I $G(RMLOC),$D(^RMPR(661.5,RMLOC,0)) D
|
---|
| 56 | .S RMLOCNA=$P(^RMPR(661.5,RMLOC,0),U,1)
|
---|
| 57 | ;
|
---|
| 58 | ITEM ;get 661.11 record
|
---|
| 59 | S RMPR11("IEN")=$O(^RMPR(661.11,"ASHI",RS,RH,RMPR7("ITEM"),0))
|
---|
| 60 | S RME=$$GET^RMPRPIX1(.RMPR11)
|
---|
| 61 | I RME=1 Q
|
---|
| 62 | ;
|
---|
| 63 | VEND ;get vendor from 661.6.
|
---|
| 64 | S RMV="",RMPR6("VENDOR")="",RMPR11("ITEM MSTER")=""
|
---|
| 65 | 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
|
---|
| 66 | .Q:RH'=$P(RM6,U,1)
|
---|
| 67 | .I (RH=$P(RM6,U,1)),(RMLOC=$P(RM6,U,14)) S RMV=$P(RM6,U,12)
|
---|
| 68 | .S:$G(RMV) RMPR6("VENDOR")=$$GETVEN^RMPRPIU0(RMV)
|
---|
| 69 | ;
|
---|
| 70 | ;external format of items at #661.7
|
---|
| 71 | S RME=$$ETOI^RMPRPIX7(.RMPR7,.RMPR7I)
|
---|
| 72 | I RME=1 Q
|
---|
| 73 | ;
|
---|
| 74 | ;set variables for printing bar code.
|
---|
| 75 | S RMPRBARC=RMPR7I("HCPCS")_"-"_$P(RMPR7I("DATE&TIME"),".",1)_$P(RMPR7I("DATE&TIME"),".",2)
|
---|
| 76 | S RMPRITXT("DATE")=$E(RMPR7I("DATE&TIME"),4,5)_"/"_$E(RMPR7I("DATE&TIME"),6,7)_"/"_(1700+$E(RMPR7I("DATE&TIME"),1,3))
|
---|
| 77 | S RMPRITXT("ITEM")=RMPR11("HCPCS-ITEM")
|
---|
| 78 | S RMPRITXT("MASTER DESC")=RMPR11("ITEM MASTER")
|
---|
| 79 | S RMPRITXT("ITEM DESC")=RMPR11("DESCRIPTION")
|
---|
| 80 | S RMPRITXT("UNIT PRICE")=+$J(RMPR7("VALUE")/RMPR7("QUANTITY"),0,2)
|
---|
| 81 | S RMPRITXT("VENDOR")=RMPR6("VENDOR")
|
---|
| 82 | S RMPRITXT("LOCATION")=RMLOCNA
|
---|
| 83 | S RMPRNLAB=RMPR7("QUANTITY")
|
---|
| 84 | ;call bar code routine
|
---|
| 85 | D ZPLII^RMPRPI11(RMPRBARC,.RMPRITXT,RMPRNLAB)
|
---|
| 86 | Q
|
---|
| 87 | ;
|
---|
| 88 | PRINTC ;
|
---|
| 89 | D ^%ZISC K IONOFF
|
---|
| 90 | ;
|
---|
| 91 | PBX D KILL^XUSCLEAN
|
---|
| 92 | PRINTX Q
|
---|