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
