BLRLBMEC.m

BLRLBMEC ;IHS/CIA/PLS - OE/RR Order Lab for Intermec PC41;22-Jul-2005 23:17;SM

 ;;5.2;LR;**1020**;Sep 13, 2005

 ; Direct entry not allowed

 Q

 ;

OPEN() ;EP

 N STX,ETX,ESC,CR

 D INIT

 U IO

 W STX,ESC,"C",ETX                              ; Place printer in Advanced Mode

 W STX,ESC,"P",ETX                              ; Place printer in Program Mode

 W STX,"E*;F*",ETX                              ; Erase format and Create format (uses Temporary storage)

 W STX,"H0;o180,5;f3;c30;k5;d0,28",ETX          ; Patient Name

 W STX,"H1;o180,280;f3;c30;k5;d0,14",ETX        ; Lab Order Number

 W STX,"H2;o165,5;f3;c33;k8;d0,9",ETX           ; HRN

 W STX,"H3;o160,165;f3;c31;;k8;d0,10",ETX       ; DOB

 W STX,"H4;o160,323;f3;c31;;k8;d0,1",ETX        ; Sex

 W STX,"H5;o135,5;f3;c30;;k6;d0,25",ETX         ; Ordering Provider

 W STX,"H6;o115,5;f3;c30;;k6;d0,24",ETX         ; Hospital Location

 W STX,"H7;o115,260;f3;c30;;k6;d0,15",ETX       ; Room/Bed

 W STX,"H8;o90,5;f3;c30;;k6;d0,8",ETX           ; Urgency

 W STX,"H9;o90,120;f3;c30;;k6;d0,24",ETX        ; Drawn by text

 W STX,"H10;o66,5;f3;c30;;k6;d0,18",ETX         ; Collection D/T

 W STX,"H11;o66,205;f3;c30;;k6;d0,19",ETX       ; Tube Color

 W STX,"H12;o45,5;f3;c30;;k6;d0,38",ETX         ; Test Name

 W STX,"H13;o25,240;f3;c31;k5;d0,14",ETX        ; Lab Order Number

 W STX,"B14;o20,15;f3;c6,0;d0,14;h25;r2;w2;i0;p@",ETX    ; Lab Order Number (Code 128 Barcode)

 W STX,"R",ETX                                  ; Exit Program Mode, Enter Print Mode

 Q

OUT() ; EP

 N STX,ETX,ESC,CR

 D OPEN(),INIT

 U IO

 W STX,"R",ETX

 W STX,"<SI>W406",ETX

 W STX,ESC,"E*<CAN>",ETX

 W STX,$$NAME^ORU($G(ORPNAME),""),CR,ETX

 W STX,"LB#:"_$G(ORPLB),CR,ETX

 W STX,$G(HRCN),CR,ETX

 W STX,$$DATE^ORU($G(ORPDOB),"MM/DD/CCYY HR:MIN"),CR,ETX

 W STX,$G(ORPSEX),CR,ETX

 W STX,"PHY:"_$$NAME^ORU($G(ORPRPHY),""),CR,ETX

 W STX,"LOC:"_$G(ORPLOC),CR,ETX

 W STX,$G(ORPRMBED),CR,ETX

 W STX,$G(ORPURG),CR,ETX

 W STX,"Drawn By:_______________",CR,ETX

 W STX,"CDT:______________",CR,ETX

 W STX,$G(ORPCOT),CR,ETX

 D GETTST(.ORZTST)

 S TST=$G(ORZTST(1))

 S TST=$P(TST," ",1,$L(TST," ")-4)

 W STX,$G(TST),CR,ETX

 W STX,"LB#:"_$G(ORPLB),CR,ETX

 W STX,$S($G(ORPLB):ORPLB,1:""),CR,ETX

 W STX,"<ETB>FF",ETX

 Q

 ;

 ;

INIT S STX="<STX>",ETX="<ETX>",ESC="<ESC>",CR="<CR>"

 Q

TEST ;EP - Output test label

 N STX,ETX,ESC,CR

 D ^%ZIS

 Q:POP

 U IO

 D OPEN()

 D INIT

 ;

 U IO

 W STX,"R",ETX

 W STX,ESC,"E*<CAN>",ETX

 W STX,"TEST,PATIENT WITH LONG NAME","<CR>",ETX

 W STX,"LB#:3392829<CR>",ETX

 W STX,440303,"<CR>",ETX

 W STX,"05/25/2005",CR,ETX

 W STX,"M",CR,ETX

 W STX,"PHY:SMITH,PHYSICIAN NAMED",CR,ETX

 W STX,"LOC:EMERGENCY ROOM 2ND FLOOR ROOM 103",CR,ETX

 W STX,"R/B:A201-104",CR,ETX

 W STX,"ROUTINE",CR,ETX

 W STX,"Drawn By:_________________",CR,ETX

 W STX,"CDT:______________",CR,ETX

 W STX,"TUBE TOP IS MARBLE",CR,ETX

 W STX,"HEPATITIS B SURFACE ANTIGEN",CR,ETX

 W STX,"LB#:3392829",CR,ETX

 W STX,3392829,CR,ETX

 W STX,"<ETB>FF",ETX

 D ^%ZISC

 Q

 ;

GETTST(Y) ;API TO RETURN TESTNAME

 N ORPDAD

 S ORPDAD=$O(^OR(100,ORIFN,2,0)) D TEXT^ORQ12(.Y,ORIFN_$S($G(OACTION):";"_OACTION,1:"")) M ^TMP("ORP:",$J)=Y S OROOT2="^TMP(""ORP:"",$J)"

 Q

BLRLBMEC  ;IHS/CIA/PLS - OE/RR Order Lab for Intermec PC41;22-Jul-2005 23:17;SM

 +1       ;;5.2;LR;**1020**;Sep 13, 2005

 +2       ; Direct entry not allowed

 +3        QUIT 

 +4       ;

OPEN()    ;EP

 +1        NEW STX,ETX,ESC,CR

 +2        DO INIT

 +3        USE IO

 +4       ; Place printer in Advanced Mode

           WRITE STX,ESC,"C",ETX

 +5       ; Place printer in Program Mode

           WRITE STX,ESC,"P",ETX

 +6       ; Erase format and Create format (uses Temporary storage)

           WRITE STX,"E*;F*",ETX

 +7       ; Patient Name

           WRITE STX,"H0;o180,5;f3;c30;k5;d0,28",ETX

 +8       ; Lab Order Number

           WRITE STX,"H1;o180,280;f3;c30;k5;d0,14",ETX

 +9       ; HRN

           WRITE STX,"H2;o165,5;f3;c33;k8;d0,9",ETX

 +10      ; DOB

           WRITE STX,"H3;o160,165;f3;c31;;k8;d0,10",ETX

 +11      ; Sex

           WRITE STX,"H4;o160,323;f3;c31;;k8;d0,1",ETX

 +12      ; Ordering Provider

           WRITE STX,"H5;o135,5;f3;c30;;k6;d0,25",ETX

 +13      ; Hospital Location

           WRITE STX,"H6;o115,5;f3;c30;;k6;d0,24",ETX

 +14      ; Room/Bed

           WRITE STX,"H7;o115,260;f3;c30;;k6;d0,15",ETX

 +15      ; Urgency

           WRITE STX,"H8;o90,5;f3;c30;;k6;d0,8",ETX

 +16      ; Drawn by text

           WRITE STX,"H9;o90,120;f3;c30;;k6;d0,24",ETX

 +17      ; Collection D/T

           WRITE STX,"H10;o66,5;f3;c30;;k6;d0,18",ETX

 +18      ; Tube Color

           WRITE STX,"H11;o66,205;f3;c30;;k6;d0,19",ETX

 +19      ; Test Name

           WRITE STX,"H12;o45,5;f3;c30;;k6;d0,38",ETX

 +20      ; Lab Order Number

           WRITE STX,"H13;o25,240;f3;c31;k5;d0,14",ETX

 +21      ; Lab Order Number (Code 128 Barcode)

           WRITE STX,"B14;o20,15;f3;c6,0;d0,14;h25;r2;w2;i0;p@",ETX

 +22      ; Exit Program Mode, Enter Print Mode

           WRITE STX,"R",ETX

 +23       QUIT 

OUT()     ; EP

 +1        NEW STX,ETX,ESC,CR

 +2        DO OPEN()

           DO INIT

 +3        USE IO

 +4        WRITE STX,"R",ETX

 +5        WRITE STX,"<SI>W406",ETX

 +6        WRITE STX,ESC,"E*<CAN>",ETX

 +7        WRITE STX,$$NAME^ORU($GET(ORPNAME),""),CR,ETX

 +8        WRITE STX,"LB#:"_$GET(ORPLB),CR,ETX

 +9        WRITE STX,$GET(HRCN),CR,ETX

 +10       WRITE STX,$$DATE^ORU($GET(ORPDOB),"MM/DD/CCYY HR:MIN"),CR,ETX

 +11       WRITE STX,$GET(ORPSEX),CR,ETX

 +12       WRITE STX,"PHY:"_$$NAME^ORU($GET(ORPRPHY),""),CR,ETX

 +13       WRITE STX,"LOC:"_$GET(ORPLOC),CR,ETX

 +14       WRITE STX,$GET(ORPRMBED),CR,ETX

 +15       WRITE STX,$GET(ORPURG),CR,ETX

 +16       WRITE STX,"Drawn By:_______________",CR,ETX

 +17       WRITE STX,"CDT:______________",CR,ETX

 +18       WRITE STX,$GET(ORPCOT),CR,ETX

 +19       DO GETTST(.ORZTST)

 +20       SET TST=$GET(ORZTST(1))

 +21       SET TST=$PIECE(TST," ",1,$LENGTH(TST," ")-4)

 +22       WRITE STX,$GET(TST),CR,ETX

 +23       WRITE STX,"LB#:"_$GET(ORPLB),CR,ETX

 +24       WRITE STX,$SELECT($GET(ORPLB):ORPLB,1:""),CR,ETX

 +25       WRITE STX,"<ETB>FF",ETX

 +26       QUIT 

 +27      ;

 +28      ;

INIT       SET STX="<STX>"

           SET ETX="<ETX>"

           SET ESC="<ESC>"

           SET CR="<CR>"

 +1        QUIT 

TEST      ;EP - Output test label

 +1        NEW STX,ETX,ESC,CR

 +2        DO ^%ZIS

 +3        IF POP

               QUIT 

 +4        USE IO

 +5        DO OPEN()

 +6        DO INIT

 +7       ;

 +8        USE IO

 +9        WRITE STX,"R",ETX

 +10       WRITE STX,ESC,"E*<CAN>",ETX

 +11       WRITE STX,"TEST,PATIENT WITH LONG NAME","<CR>",ETX

 +12       WRITE STX,"LB#:3392829<CR>",ETX

 +13       WRITE STX,440303,"<CR>",ETX

 +14       WRITE STX,"05/25/2005",CR,ETX

 +15       WRITE STX,"M",CR,ETX

 +16       WRITE STX,"PHY:SMITH,PHYSICIAN NAMED",CR,ETX

 +17       WRITE STX,"LOC:EMERGENCY ROOM 2ND FLOOR ROOM 103",CR,ETX

 +18       WRITE STX,"R/B:A201-104",CR,ETX

 +19       WRITE STX,"ROUTINE",CR,ETX

 +20       WRITE STX,"Drawn By:_________________",CR,ETX

 +21       WRITE STX,"CDT:______________",CR,ETX

 +22       WRITE STX,"TUBE TOP IS MARBLE",CR,ETX

 +23       WRITE STX,"HEPATITIS B SURFACE ANTIGEN",CR,ETX

 +24       WRITE STX,"LB#:3392829",CR,ETX

 +25       WRITE STX,3392829,CR,ETX

 +26       WRITE STX,"<ETB>FF",ETX

 +27       DO ^%ZISC

 +28       QUIT 

 +29      ;

GETTST(Y) ;API TO RETURN TESTNAME

 +1        NEW ORPDAD

 +2        SET ORPDAD=$ORDER(^OR(100,ORIFN,2,0))

           DO TEXT^ORQ12(.Y,ORIFN_$SELECT($GET(OACTION):";"_OACTION,1:""))

           MERGE ^TMP("ORP:",$JOB)=Y

           SET OROOT2="^TMP(""ORP:"",$J)"

 +3        QUIT