Routine: RMPRPI13

RMPRPI13 ;HIN/ODJ-PRINT BAR CODE LABELS ;2/09/01

 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996

 ;***** SELP - Prompt for Bar Code printer

SELP(RMPRBCP,RMPREXC,RMPRQ,RMPRIOP) ;

 N POP

 S %ZIS("A")="Select Bar Code Printer: "

 S %ZIS("B")=""

 S %ZIS="QN" K IOP

 D ^%ZIS

 S RMPRQ=0

 S RMPREXC=""

 I POP S RMPREXC="P" G SELPX

 I '$D(IO("Q")) D  G SELPX

 . S RMPRBCP=$G(IOST)

 . S:RMPRBCP="" RMPREXC="^"

 . S RMPRIOP=$G(ION)

. Q

 ;I '$D(IO("Q")) U IO D TEST G SELPX

 ;K IO("Q") S ZTDESC="SLAVE PRINT TEST"

 ;S ZTRTN="TEST^RMPRPI11",ZTIO=ION

 ;D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!",! H 1 G SELPX

SELPX Q

TEST S IOP=ION,%ZIS="" D ^%ZIS

 W !!,"TESTING SLAVE DEVICE",!!

 W @IOF

 D ^%ZISC

 ; Print bar code for printer using ZPLII command set (ZEBRAS)

 ; applies to S600

ZPLII(RMPRBARC,RMPRITXT,RMPRNCOP) ;

 N RMPRUNIT,RMPRLTYP,RMPRLWID,RMPRLHGT,RMPRLRES,RMPRMMIN

 N RMPRXDIM,RMPRQUIZ,RMPRHCPC,RMPRBLEN,RMPRDT,RMPRBHGT,RMPRCRLF

 N RMPRLEFT,RMPRDOWN,RMPRLCNT

 S RMPRUNIT="MM"   ; use mm units

 S RMPRLTYP=""     ; <not used yet>

 S RMPRLWID=75     ; Lable width   75mm

 S RMPRLHGT=25    ; Label height 25mm

 S RMPRLRES=8     ; 8 dots/mm resolution

 S RMPRMMIN=25.333 ; mm to the inch conversion factor

 I '+$G(RMPRNCOP) S RMPRNCOP=1

 ; Set the X dimension in dots (width of narrow bar)

 ; minimum recommended X dimension is .19mm (7.5/1000th inch)

 I RMPRUNIT="MM" D

 . S RMPRXDIM=RMPRLRES*.19

. Q

 I RMPRUNIT="IN" D

 . S RMPRXDIM=RMPRLRES*.0075

. Q

 S:RMPRXDIM'=(RMPRXDIM\1) RMPRXDIM=1+(RMPRXDIM\1)

 ; Calculate the quiet zone in dots

 ; this should be greater of 10 X dimensions or 2.5333 mm (.1 inch)

 I RMPRUNIT="MM" D

 . S RMPRQUIZ=((2.5333*RMPRLRES)\1)+1

 . S:RMPRQUIZ<(10*RMPRXDIM) RMPRQUIZ=10*RMPRXDIM

. Q

 I RMPRUNIT="IN" D

 . S RMPRQUIZ=((.1*RMPRLRES)\1)+1

 . S:RMPRQUIZ<(10*RMPRXDIM) RMPRQUIZ=10*RMPRXDIM

. Q

 ; Calculate length (in dots) of symbol to be printed

 ; Symbol is [HCPCS code][-][Date and Time]

 ; [HCPCS code] and [-] will be alphanumeric

 ; [Date and Time] will be numeric using code C

 S RMPRHCPC=$P(RMPRBARC,"-",1)

 S RMPRBLEN=((11*($L(RMPRHCPC)+5))+35)*RMPRXDIM

 S RMPRDT=$P(RMPRBARC,"-",2)

 S RMPRBLEN=RMPRBLEN+(((5.5*($L(RMPRDT)))+35)*RMPRXDIM)

 ; Calculate bar height in dots

 ; this should be .15 times symbol length or .25 inches

 I RMPRUNIT="MM" D

 . S RMPRBHGT=((6.33325*RMPRLRES)\1)+1

 . S:RMPRBHGT<(((.15*RMPRBLEN)\1)+1) RMPRBHGT=1+((.15*RMPRBLEN)\1)

. Q

 I RMPRUNIT="IN" D

 . S RMPRBHGT=((.25*RMPRLRES)\1)+1

 . S:RMPRBHGT<(((.15*RMPRBLEN)\1)+1) RMPRBHGT=1+((.15*RMPRBLEN)\1)

. Q

 ; *** Print the symbol ***

 S RMPRCRLF=$C(13)_$C(10)

 S RMPRLCNT=0

ZPLIIP W "^XA",RMPRCRLF

 W "^LH"_RMPRQUIZ_","_RMPRQUIZ,RMPRCRLF

 W "^BY"_RMPRXDIM_",3.0,"_RMPRBHGT,RMPRCRLF

 S RMPRLEFT=RMPRQUIZ

 S RMPRDOWN=RMPRQUIZ\2

 ; the BAR CODE

 W "^FO"_RMPRLEFT_","_RMPRDOWN_","_"^BCN,"_RMPRBHGT_",Y,N,N,A^FD"_RMPRBARC_"^FS",RMPRCRLF

 S RMPRDOWN=RMPRDOWN+((1.4*RMPRBHGT)\1)

 ; Description fields

 W "^FO"_RMPRLEFT_","_RMPRDOWN,RMPRCRLF

 W "^AC^FD"_$E(RMPRITXT("ITEM")_$J("",15),1,15)_$E("$ "_RMPRITXT("UNIT PRICE")_$J("",15),1,15)_RMPRITXT("DATE")_"^FS",RMPRCRLF

 S RMPRDOWN=RMPRDOWN+1+RMPRQUIZ

 W "^FO"_RMPRLEFT_","_RMPRDOWN,RMPRCRLF

 W "^AB^FD"_RMPRITXT("MASTER DESC")_"^FS",RMPRCRLF

 S RMPRDOWN=RMPRDOWN+1+(RMPRQUIZ\1.5)

 W "^FO"_RMPRLEFT_","_RMPRDOWN,RMPRCRLF

 W "^AB^FD"_RMPRITXT("ITEM DESC")_"^FS",RMPRCRLF

 S RMPRDOWN=RMPRDOWN+1+(RMPRQUIZ\1.5)

 W "^FO"_RMPRLEFT_","_RMPRDOWN,RMPRCRLF

 W "^AB^FD"_RMPRITXT("VENDOR")_"^FS",RMPRCRLF

 ; finish

 W "^XZ",RMPRCRLF

 S RMPRLCNT=1+RMPRLCNT

 I RMPRLCNT<RMPRNCOP G ZPLIIP

ZPLIIX Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPI13   3685     printed  Apr 23, 2025@18:50:35                                                                                                                                                                                                    Page 2

RMPRPI13  ;HIN/ODJ-PRINT BAR CODE LABELS ;2/09/01

 +1       ;;3.0;PROSTHETICS;**61**;Feb 09, 1996

 +2       ;

 +3        QUIT

 +4       ;

 +5       ;***** SELP - Prompt for Bar Code printer

SELP(RMPRBCP,RMPREXC,RMPRQ,RMPRIOP) ;

 +1        NEW POP

 +2        SET %ZIS("A")="Select Bar Code Printer: "

 +3        SET %ZIS("B")=""

 +4        SET %ZIS="QN"

           KILL IOP

 +5        DO ^%ZIS

 +6        SET RMPRQ=0

 +7        SET RMPREXC=""

 +8        IF POP

               SET RMPREXC="P"

               GOTO SELPX

 +9        IF '$DATA(IO("Q"))

               Begin DoDot:1

 +10               SET RMPRBCP=$GET(IOST)

 +11               if RMPRBCP=""

                       SET RMPREXC="^"

 +12               SET RMPRIOP=$GET(ION)

 +13               QUIT

               End DoDot:1

               GOTO SELPX

 +14      ;I '$D(IO("Q")) U IO D TEST G SELPX

 +15      ;K IO("Q") S ZTDESC="SLAVE PRINT TEST"

 +16      ;S ZTRTN="TEST^RMPRPI11",ZTIO=ION

 +17      ;D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!",! H 1 G SELPX

SELPX      QUIT

TEST       SET IOP=ION

           SET %ZIS=""

           DO ^%ZIS

 +1        WRITE !!,"TESTING SLAVE DEVICE",!!

 +2        WRITE @IOF

 +3        DO ^%ZISC

 +4        QUIT

 +5       ;

 +6       ; Print bar code for printer using ZPLII command set (ZEBRAS)

 +7       ; applies to S600

ZPLII(RMPRBARC,RMPRITXT,RMPRNCOP) ;

 +1        NEW RMPRUNIT,RMPRLTYP,RMPRLWID,RMPRLHGT,RMPRLRES,RMPRMMIN

 +2        NEW RMPRXDIM,RMPRQUIZ,RMPRHCPC,RMPRBLEN,RMPRDT,RMPRBHGT,RMPRCRLF

 +3        NEW RMPRLEFT,RMPRDOWN,RMPRLCNT

 +4       ; use mm units

           SET RMPRUNIT="MM"

 +5       ; <not used yet>

           SET RMPRLTYP=""

 +6       ; Lable width   75mm

           SET RMPRLWID=75

 +7       ; Label height 25mm

           SET RMPRLHGT=25

 +8       ; 8 dots/mm resolution

           SET RMPRLRES=8

 +9       ; mm to the inch conversion factor

           SET RMPRMMIN=25.333

 +10       IF '+$GET(RMPRNCOP)

               SET RMPRNCOP=1

 +11      ;

 +12      ; Set the X dimension in dots (width of narrow bar)

 +13      ; minimum recommended X dimension is .19mm (7.5/1000th inch)

 +14       IF RMPRUNIT="MM"

               Begin DoDot:1

 +15               SET RMPRXDIM=RMPRLRES*.19

 +16               QUIT

               End DoDot:1

 +17       IF RMPRUNIT="IN"

               Begin DoDot:1

 +18               SET RMPRXDIM=RMPRLRES*.0075

 +19               QUIT

               End DoDot:1

 +20       if RMPRXDIM'=(RMPRXDIM\1)

               SET RMPRXDIM=1+(RMPRXDIM\1)

 +21      ;

 +22      ; Calculate the quiet zone in dots

 +23      ; this should be greater of 10 X dimensions or 2.5333 mm (.1 inch)

 +24       IF RMPRUNIT="MM"

               Begin DoDot:1

 +25               SET RMPRQUIZ=((2.5333*RMPRLRES)\1)+1

 +26               if RMPRQUIZ<(10*RMPRXDIM)

                       SET RMPRQUIZ=10*RMPRXDIM

 +27               QUIT

               End DoDot:1

 +28       IF RMPRUNIT="IN"

               Begin DoDot:1

 +29               SET RMPRQUIZ=((.1*RMPRLRES)\1)+1

 +30               if RMPRQUIZ<(10*RMPRXDIM)

                       SET RMPRQUIZ=10*RMPRXDIM

 +31               QUIT

               End DoDot:1

 +32      ;

 +33      ; Calculate length (in dots) of symbol to be printed

 +34      ; Symbol is [HCPCS code][-][Date and Time]

 +35      ; [HCPCS code] and [-] will be alphanumeric

 +36      ; [Date and Time] will be numeric using code C

 +37       SET RMPRHCPC=$PIECE(RMPRBARC,"-",1)

 +38       SET RMPRBLEN=((11*($LENGTH(RMPRHCPC)+5))+35)*RMPRXDIM

 +39       SET RMPRDT=$PIECE(RMPRBARC,"-",2)

 +40       SET RMPRBLEN=RMPRBLEN+(((5.5*($LENGTH(RMPRDT)))+35)*RMPRXDIM)

 +41      ;

 +42      ; Calculate bar height in dots

 +43      ; this should be .15 times symbol length or .25 inches

 +44       IF RMPRUNIT="MM"

               Begin DoDot:1

 +45               SET RMPRBHGT=((6.33325*RMPRLRES)\1)+1

 +46               if RMPRBHGT<(((.15*RMPRBLEN)\1)+1)

                       SET RMPRBHGT=1+((.15*RMPRBLEN)\1)

 +47               QUIT

               End DoDot:1

 +48       IF RMPRUNIT="IN"

               Begin DoDot:1

 +49               SET RMPRBHGT=((.25*RMPRLRES)\1)+1

 +50               if RMPRBHGT<(((.15*RMPRBLEN)\1)+1)

                       SET RMPRBHGT=1+((.15*RMPRBLEN)\1)

 +51               QUIT

               End DoDot:1

 +52      ;

 +53      ; *** Print the symbol ***

 +54       SET RMPRCRLF=$CHAR(13)_$CHAR(10)

 +55       SET RMPRLCNT=0

ZPLIIP     WRITE "^XA",RMPRCRLF

 +1        WRITE "^LH"_RMPRQUIZ_","_RMPRQUIZ,RMPRCRLF

 +2        WRITE "^BY"_RMPRXDIM_",3.0,"_RMPRBHGT,RMPRCRLF

 +3        SET RMPRLEFT=RMPRQUIZ

 +4        SET RMPRDOWN=RMPRQUIZ\2

 +5       ;

 +6       ; the BAR CODE

 +7        WRITE "^FO"_RMPRLEFT_","_RMPRDOWN_","_"^BCN,"_RMPRBHGT_",Y,N,N,A^FD"_RMPRBARC_"^FS",RMPRCRLF

 +8        SET RMPRDOWN=RMPRDOWN+((1.4*RMPRBHGT)\1)

 +9       ;

 +10      ; Description fields

 +11       WRITE "^FO"_RMPRLEFT_","_RMPRDOWN,RMPRCRLF

 +12       WRITE "^AC^FD"_$EXTRACT(RMPRITXT("ITEM")_$JUSTIFY("",15),1,15)_$EXTRACT("$ "_RMPRITXT("UNIT PRICE")_$JUSTIFY("",15),1,15)_RMPRITXT("DATE")_"^FS",RMPRCRLF

 +13       SET RMPRDOWN=RMPRDOWN+1+RMPRQUIZ

 +14       WRITE "^FO"_RMPRLEFT_","_RMPRDOWN,RMPRCRLF

 +15       WRITE "^AB^FD"_RMPRITXT("MASTER DESC")_"^FS",RMPRCRLF

 +16       SET RMPRDOWN=RMPRDOWN+1+(RMPRQUIZ\1.5)

 +17       WRITE "^FO"_RMPRLEFT_","_RMPRDOWN,RMPRCRLF

 +18       WRITE "^AB^FD"_RMPRITXT("ITEM DESC")_"^FS",RMPRCRLF

 +19       SET RMPRDOWN=RMPRDOWN+1+(RMPRQUIZ\1.5)

 +20       WRITE "^FO"_RMPRLEFT_","_RMPRDOWN,RMPRCRLF

 +21       WRITE "^AB^FD"_RMPRITXT("VENDOR")_"^FS",RMPRCRLF

 +22      ;

 +23      ; finish

 +24       WRITE "^XZ",RMPRCRLF

 +25       SET RMPRLCNT=1+RMPRLCNT

 +26       IF RMPRLCNT<RMPRNCOP

               GOTO ZPLIIP

ZPLIIX     QUIT

RMPRPI13.m