BPCLOPRT ; IHS/OIT/MJL - PRINT LAB ORDERS FOR GUI ;
;;1.5;BPC;;MAY 26, 2005
;
PRTORD(BPCARRAY,BPCORDN) ;;EP REMOTE PROC: BPC PRINT LAB ORDER
D ENT
K BPCBED,BPCCNTR,BPCCS,BPCCSS,BPCDFN,BPCDOB,BPCDPF,BPCDTO,BPCDUZ,BPCGOT,BPCGUI,BPCHRCN,BPCI,BPCLLOC,BPCLRDFN,BPCLWC,BPCODT,BPCORDTM,BPCPNM,BPCPR,BPCSAMP,BPCSN,BPCSPC,BPCSSN,BPCT,BPCTP,BPCUR,BPCX,DOB,HRCN,LRDFN,Y
Q
;
ENT ;
;S BPCORDN=35970 ;USE THIS FOR TESTING
D ^XBKVAR
S BPCGUI=1,XWBWRAP=1,BPCX="" K ^TMP($J)
S BPCARRAY="^TMP("_$J_")"
S BPCSPC=$J("",77)
I $G(BPCORDN)="" S ^TMP($J,1)=-1,^TMP($J,2)="LAB ORDER NOT SENT!" Q
S BPCCNTR=1
D LAB
K Y
I BPCCNTR=1 S ^TMP($J,1)=1,^TMP($J,2)="No Data Available" Q
Q
;
LAB I '$D(^LRO(69,"C",BPCORDN)) S ^TMP($J,1)=-1,^TMP($J,2)="LAB ORDER NOT IN LAB ORDERS FILE" Q
S BPCODT="" F S BPCODT=$O(^LRO(69,"C",BPCORDN,BPCODT)) Q:'BPCODT D
.S BPCSN="" F S BPCSN=$O(^LRO(69,"C",BPCORDN,BPCODT,BPCSN)) Q:'BPCSN D
..I '$D(^LRO(69,BPCODT,1,BPCSN,0)) S ^TMP($J,1)=-1,^TMP($J,2)="LAB ORDER NOT SENT!" Q
..N BPCSAMP,BPCGOT S BPCGOT=0
..S BPCI=0 F S BPCI=$O(^LRO(69,BPCODT,1,BPCSN,2,BPCI)) Q:BPCI<1 I $D(^(BPCI,0)),'$P(^(0),"^",11) S BPCGOT=1 Q
..Q:'BPCGOT
..S BPCX=^LRO(69,BPCODT,1,BPCSN,0),BPCCSS=$S($D(^(4,1)):^(1,0),1:0),BPCLRDFN=$P(BPCX,U),(BPCSAMP,BPCCS)=$P(BPCX,U,3)
..S BPCLWC=$P(BPCX,U,4),BPCDTO=$P(BPCX,U,5),BPCPR=$P(BPCX,U,6),BPCLLOC=$P(BPCX,U,7),BPCORDTM=$P($P(BPCX,U,8),".",2),BPCDUZ=$P(BPCX,U,2)
..S BPCCSS=$S($D(^LAB(61,+BPCCSS,0)):$P(^(0),U),1:""),BPCCS=$S($D(^LAB(62,+BPCCS,0)):^(0),1:"")
..S BPCDPF=$P(^LR(BPCLRDFN,0),U,2),BPCDFN=$P(^(0),U,3),BPCX=^DIC(BPCDPF,0,"GL")_BPCDFN_",0)",BPCPNM=$S($D(@BPCX):$P(@BPCX,U),1:"UNKNOWN")
..S BPCSSN=$S($D(@BPCX):$P(@BPCX,U,9),1:"UNKNOWN") S BPCX=^DIC(BPCDPF,0,"GL")_BPCDFN_",.101)" S BPCBED=$S($D(@BPCX):^(.101),1:"")
..S LRDFN=BPCLRDFN
..D PT^LRX ;IHS/ANMC/CLS 08/18/96
..S BPCHRCN=HRCN,BPCDOB=DOB
..D:BPCSSN SSN^LRU
..S ^TMP($J,BPCCNTR)="",BPCCNTR=BPCCNTR+1
..S ^TMP($J,BPCCNTR)="",BPCCNTR=BPCCNTR+1
..S ^TMP($J,BPCCNTR)=$E(BPCSPC,1,25)_"LABORATORY: "_^DD("SITE") S BPCCNTR=BPCCNTR+1
..S ^TMP($J,BPCCNTR)="",BPCCNTR=BPCCNTR+1
..S ^TMP($J,BPCCNTR)="",BPCCNTR=BPCCNTR+1
..S Y=BPCODT D DD^LRX
..S ^TMP($J,BPCCNTR)=$E(BPCSPC,1,23)_$S(BPCLWC="SP":"Send Patient",BPCLWC="WC":"Ward/Clinic Collect",BPCLWC="I":"Immed Lab Collect ",1:"Lab Collect")_" ORDER FOR "_Y S BPCCNTR=BPCCNTR+1
..S ^TMP($J,BPCCNTR)=$E(BPCSPC,1,23)_"ORDER: "_$S($D(^LRO(69,BPCODT,1,BPCSN,.1)):^(.1),1:"")_BPCSPC
..S ^TMP($J,BPCCNTR)=$E(^TMP($J,BPCCNTR),1,40)_"LOCATION: "_BPCLLOC
..S:$L(BPCBED) ^TMP($J,BPCCNTR)=^TMP($J,BPCCNTR)_" BED: "_BPCBED
..S BPCCNTR=BPCCNTR+1
..S ^TMP($J,BPCCNTR)="",BPCCNTR=BPCCNTR+1
..S ^TMP($J,BPCCNTR)=BPCPNM_BPCSPC
..S ^TMP($J,BPCCNTR)=$E(^TMP($J,BPCCNTR),1,40)_BPCHRCN_BPCSPC
..S ^TMP($J,BPCCNTR)=$E(^TMP($J,BPCCNTR),1,51)_"DOB: "_BPCDOB,BPCCNTR=BPCCNTR+1
..S ^TMP($J,BPCCNTR)="ENTERED BY: "_$P($G(^VA(200,DUZ,0)),U,1)_BPCSPC
..S Y=BPCDTO D DD^LRX
..;S ^TMP($J,BPCCNTR)=$E(^TMP($J,BPCCNTR),1,40)_Y,BPCCNTR=BPCCNTR+1
..S ^TMP($J,BPCCNTR)=Y,BPCCNTR=BPCCNTR+1
..I $L(BPCPR) S ^TMP($J,BPCCNTR)="PRACTITIONER: "_$S($D(^VA(200,BPCPR,0)):$P(^(0),"^"),1:"UNKNOWN")_BPCSPC S ^TMP($J,BPCCNTR)=$E(^TMP($J,BPCCNTR),1,32)
..I BPCORDTM S Y=BPCODT_"."_BPCORDTM D DD^LRX
..I BPCORDTM S ^TMP($J,BPCCNTR)=^TMP($J,BPCCNTR)_$S(BPCLWC="I":"REQUESTED ",1:" Est.")_" Collect Time: "_Y
..S BPCCNTR=BPCCNTR+1
..S ^TMP($J,BPCCNTR)="Collection sample: "_$P(BPCCS,U)_" "_$P(BPCCS,U,3)_BPCSPC,^TMP($J,BPCCNTR)=$E(^TMP($J,BPCCNTR),1,32)
..S:$P(BPCCS,U)'[BPCCSS ^TMP($J,BPCCNTR)=" Site/Specimen: "_BPCCSS
..S BPCT=0 F S BPCT=$O(^LRO(69,BPCODT,1,BPCSN,2,BPCT)) Q:BPCT<1 S BPCTP=^(BPCT,0) D:'$P(BPCTP,"^",11) TEST
..S ^TMP($J,BPCCNTR)="",BPCCNTR=BPCCNTR+1
..S ^TMP($J,BPCCNTR)="",BPCCNTR=BPCCNTR+1
..S ^TMP($J,BPCCNTR)="",BPCCNTR=BPCCNTR+1
..S ^TMP($J,BPCCNTR)="DATE/TIME OF COLLECTION:__________"
..I $G(BPCLWC)="WC" S ^TMP($J,BPCCNTR)="",BPCCNTR=BPCCNTR+1,^TMP($J,BPCCNTR)="",BPCCNTR=BPCCNTR+1,^TMP($J,BPCCNTR)="COLLECTED BY:_____________________________"
..S BPCCNTR=BPCCNTR+1
..I $D(^LRO(69,BPCODT,1,BPCSN,6,0)) S ^TMP($J,BPCCNTR)="",BPCCNTR=BPCCNTR+1 D
...S ^TMP($J,BPCCNTR)="Order comment: " F BPCI=0:0 S BPCI=$O(^LRO(69,BPCODT,1,BPCSN,6,BPCI)) Q:BPCI<1 S ^TMP($J,BPCCNTR)=" "_^(BPCI,0),BPCCNTR=BPCCNTR+1
..I $G(BPCLWC)="SP" S ^TMP($J,BPCCNTR)="** PLEASE BRING THIS WITH YOU TO THE LAB **" S BPCCNTR=BPCCNTR+1
S ^TMP($J,.5)=BPCCNTR Q
;
TEST S ^TMP($J,BPCCNTR)="TEST/PROCEDURE: "_$P(^LAB(60,+BPCTP,0),U)_BPCSPC,^TMP($J,BPCCNTR)=$E(^TMP($J,BPCCNTR),1,48)
S BPCUR=+$P(BPCTP,U,2) S:BPCUR ^TMP($J,BPCCNTR)=^TMP($J,BPCCNTR)_$P(^LAB(62.05,BPCUR,0),U)
S BPCCNTR=BPCCNTR+1
I $D(^LAB(60,+BPCTP,3,"B",+BPCSAMP)) S BPCX=$O(^(+BPCSAMP,0)) I BPCX,$D(^LAB(60,+BPCTP,3,1,BPCX)) S BPCI=0 D
. S BPCCNTR=BPCCNTR+1,^TMP($J,BPCCNTR)="Ward Instructions:"
. F S BPCI=$O(^LAB(60,+BPCTP,3,1,BPCX,BPCI)) Q:BPCI<1 S BPCCNTR=BPCCNTR+1,^TMP($J,BPCCNTR)=" "_^(BPCI,0)
I $O(^LRO(69,BPCODT,1,BPCSN,2,BPCT,1,0)) S BPCCNTR=BPCCNTR,^TMP($J,BPCCNTR)="Ward Comments:" S BPCI=0 F S BPCI=$O(^LRO(69,BPCODT,1,BPCSN,2,BPCT,1,BPCI)) Q:BPCI<1 S BPCCNTR=BPCCNTR+1,^TMP($J,BPCCNTR)=" "_^(BPCI,0)
Q
BPCLOPRT ; IHS/OIT/MJL - PRINT LAB ORDERS FOR GUI ;
+1 ;;1.5;BPC;;MAY 26, 2005
+2 ;
PRTORD(BPCARRAY,BPCORDN) ;;EP REMOTE PROC: BPC PRINT LAB ORDER
+1 DO ENT
+2 KILL BPCBED,BPCCNTR,BPCCS,BPCCSS,BPCDFN,BPCDOB,BPCDPF,BPCDTO,BPCDUZ,BPCGOT,BPCGUI,BPCHRCN,BPCI,BPCLLOC,BPCLRDFN,BPCLWC,BPCODT,BPCORDTM,BPCPNM,BPCPR,BPCSAMP,BPCSN,BPCSPC,BPCSSN,BPCT,BPCTP,BPCUR,BPCX,DOB,HRCN,LRDFN,Y
+3 QUIT
+4 ;
ENT ;
+1 ;S BPCORDN=35970 ;USE THIS FOR TESTING
+2 DO ^XBKVAR
+3 SET BPCGUI=1
SET XWBWRAP=1
SET BPCX=""
KILL ^TMP($JOB)
+4 SET BPCARRAY="^TMP("_$JOB_")"
+5 SET BPCSPC=$JUSTIFY("",77)
+6 IF $GET(BPCORDN)=""
SET ^TMP($JOB,1)=-1
SET ^TMP($JOB,2)="LAB ORDER NOT SENT!"
QUIT
+7 SET BPCCNTR=1
+8 DO LAB
+9 KILL Y
+10 IF BPCCNTR=1
SET ^TMP($JOB,1)=1
SET ^TMP($JOB,2)="No Data Available"
QUIT
+11 QUIT
+12 ;
LAB IF '$DATA(^LRO(69,"C",BPCORDN))
SET ^TMP($JOB,1)=-1
SET ^TMP($JOB,2)="LAB ORDER NOT IN LAB ORDERS FILE"
QUIT
+1 SET BPCODT=""
FOR
SET BPCODT=$ORDER(^LRO(69,"C",BPCORDN,BPCODT))
IF 'BPCODT
QUIT
Begin DoDot:1
+2 SET BPCSN=""
FOR
SET BPCSN=$ORDER(^LRO(69,"C",BPCORDN,BPCODT,BPCSN))
IF 'BPCSN
QUIT
Begin DoDot:2
+3 IF '$DATA(^LRO(69,BPCODT,1,BPCSN,0))
SET ^TMP($JOB,1)=-1
SET ^TMP($JOB,2)="LAB ORDER NOT SENT!"
QUIT
+4 NEW BPCSAMP,BPCGOT
SET BPCGOT=0
+5 SET BPCI=0
FOR
SET BPCI=$ORDER(^LRO(69,BPCODT,1,BPCSN,2,BPCI))
IF BPCI<1
QUIT
IF $DATA(^(BPCI,0))
IF '$PIECE(^(0),"^",11)
SET BPCGOT=1
QUIT
+6 IF 'BPCGOT
QUIT
+7 SET BPCX=^LRO(69,BPCODT,1,BPCSN,0)
SET BPCCSS=$SELECT($DATA(^(4,1)):^(1,0),1:0)
SET BPCLRDFN=$PIECE(BPCX,U)
SET (BPCSAMP,BPCCS)=$PIECE(BPCX,U,3)
+8 SET BPCLWC=$PIECE(BPCX,U,4)
SET BPCDTO=$PIECE(BPCX,U,5)
SET BPCPR=$PIECE(BPCX,U,6)
SET BPCLLOC=$PIECE(BPCX,U,7)
SET BPCORDTM=$PIECE($PIECE(BPCX,U,8),".",2)
SET BPCDUZ=$PIECE(BPCX,U,2)
+9 SET BPCCSS=$SELECT($DATA(^LAB(61,+BPCCSS,0)):$PIECE(^(0),U),1:"")
SET BPCCS=$SELECT($DATA(^LAB(62,+BPCCS,0)):^(0),1:"")
+10 SET BPCDPF=$PIECE(^LR(BPCLRDFN,0),U,2)
SET BPCDFN=$PIECE(^(0),U,3)
SET BPCX=^DIC(BPCDPF,0,"GL")_BPCDFN_",0)"
SET BPCPNM=$SELECT($DATA(@BPCX):$PIECE(@BPCX,U),1:"UNKNOWN")
+11 SET BPCSSN=$SELECT($DATA(@BPCX):$PIECE(@BPCX,U,9),1:"UNKNOWN")
SET BPCX=^DIC(BPCDPF,0,"GL")_BPCDFN_",.101)"
SET BPCBED=$SELECT($DATA(@BPCX):^(.101),1:"")
+12 SET LRDFN=BPCLRDFN
+13 ;IHS/ANMC/CLS 08/18/96
DO PT^LRX
+14 SET BPCHRCN=HRCN
SET BPCDOB=DOB
+15 IF BPCSSN
DO SSN^LRU
+16 SET ^TMP($JOB,BPCCNTR)=""
SET BPCCNTR=BPCCNTR+1
+17 SET ^TMP($JOB,BPCCNTR)=""
SET BPCCNTR=BPCCNTR+1
+18 SET ^TMP($JOB,BPCCNTR)=$EXTRACT(BPCSPC,1,25)_"LABORATORY: "_^DD("SITE")
SET BPCCNTR=BPCCNTR+1
+19 SET ^TMP($JOB,BPCCNTR)=""
SET BPCCNTR=BPCCNTR+1
+20 SET ^TMP($JOB,BPCCNTR)=""
SET BPCCNTR=BPCCNTR+1
+21 SET Y=BPCODT
DO DD^LRX
+22 SET ^TMP($JOB,BPCCNTR)=$EXTRACT(BPCSPC,1,23)_$SELECT(BPCLWC="SP":"Send Patient",BPCLWC="WC":"Ward/Clinic Collect",BPCLWC="I":"Immed Lab Collect ",1:"Lab Collect")_" ORDER FOR "_Y
SET BPCCNTR=BPCCNTR+1
+23 SET ^TMP($JOB,BPCCNTR)=$EXTRACT(BPCSPC,1,23)_"ORDER: "_$SELECT($DATA(^LRO(69,BPCODT,1,BPCSN,.1)):^(.1),1:"")_BPCSPC
+24 SET ^TMP($JOB,BPCCNTR)=$EXTRACT(^TMP($JOB,BPCCNTR),1,40)_"LOCATION: "_BPCLLOC
+25 IF $LENGTH(BPCBED)
SET ^TMP($JOB,BPCCNTR)=^TMP($JOB,BPCCNTR)_" BED: "_BPCBED
+26 SET BPCCNTR=BPCCNTR+1
+27 SET ^TMP($JOB,BPCCNTR)=""
SET BPCCNTR=BPCCNTR+1
+28 SET ^TMP($JOB,BPCCNTR)=BPCPNM_BPCSPC
+29 SET ^TMP($JOB,BPCCNTR)=$EXTRACT(^TMP($JOB,BPCCNTR),1,40)_BPCHRCN_BPCSPC
+30 SET ^TMP($JOB,BPCCNTR)=$EXTRACT(^TMP($JOB,BPCCNTR),1,51)_"DOB: "_BPCDOB
SET BPCCNTR=BPCCNTR+1
+31 SET ^TMP($JOB,BPCCNTR)="ENTERED BY: "_$PIECE($GET(^VA(200,DUZ,0)),U,1)_BPCSPC
+32 SET Y=BPCDTO
DO DD^LRX
+33 ;S ^TMP($J,BPCCNTR)=$E(^TMP($J,BPCCNTR),1,40)_Y,BPCCNTR=BPCCNTR+1
+34 SET ^TMP($JOB,BPCCNTR)=Y
SET BPCCNTR=BPCCNTR+1
+35 IF $LENGTH(BPCPR)
SET ^TMP($JOB,BPCCNTR)="PRACTITIONER: "_$SELECT($DATA(^VA(200,BPCPR,0)):$PIECE(^(0),"^"),1:"UNKNOWN")_BPCSPC
SET ^TMP($JOB,BPCCNTR)=$EXTRACT(^TMP($JOB,BPCCNTR),1,32)
+36 IF BPCORDTM
SET Y=BPCODT_"."_BPCORDTM
DO DD^LRX
+37 IF BPCORDTM
SET ^TMP($JOB,BPCCNTR)=^TMP($JOB,BPCCNTR)_$SELECT(BPCLWC="I":"REQUESTED ",1:" Est.")_" Collect Time: "_Y
+38 SET BPCCNTR=BPCCNTR+1
+39 SET ^TMP($JOB,BPCCNTR)="Collection sample: "_$PIECE(BPCCS,U)_" "_$PIECE(BPCCS,U,3)_BPCSPC
SET ^TMP($JOB,BPCCNTR)=$EXTRACT(^TMP($JOB,BPCCNTR),1,32)
+40 IF $PIECE(BPCCS,U)'[BPCCSS
SET ^TMP($JOB,BPCCNTR)=" Site/Specimen: "_BPCCSS
+41 SET BPCT=0
FOR
SET BPCT=$ORDER(^LRO(69,BPCODT,1,BPCSN,2,BPCT))
IF BPCT<1
QUIT
SET BPCTP=^(BPCT,0)
IF '$PIECE(BPCTP,"^",11)
DO TEST
+42 SET ^TMP($JOB,BPCCNTR)=""
SET BPCCNTR=BPCCNTR+1
+43 SET ^TMP($JOB,BPCCNTR)=""
SET BPCCNTR=BPCCNTR+1
+44 SET ^TMP($JOB,BPCCNTR)=""
SET BPCCNTR=BPCCNTR+1
+45 SET ^TMP($JOB,BPCCNTR)="DATE/TIME OF COLLECTION:__________"
+46 IF $GET(BPCLWC)="WC"
SET ^TMP($JOB,BPCCNTR)=""
SET BPCCNTR=BPCCNTR+1
SET ^TMP($JOB,BPCCNTR)=""
SET BPCCNTR=BPCCNTR+1
SET ^TMP($JOB,BPCCNTR)="COLLECTED BY:_____________________________"
+47 SET BPCCNTR=BPCCNTR+1
+48 IF $DATA(^LRO(69,BPCODT,1,BPCSN,6,0))
SET ^TMP($JOB,BPCCNTR)=""
SET BPCCNTR=BPCCNTR+1
Begin DoDot:3
+49 SET ^TMP($JOB,BPCCNTR)="Order comment: "
FOR BPCI=0:0
SET BPCI=$ORDER(^LRO(69,BPCODT,1,BPCSN,6,BPCI))
IF BPCI<1
QUIT
SET ^TMP($JOB,BPCCNTR)=" "_^(BPCI,0)
SET BPCCNTR=BPCCNTR+1
End DoDot:3
+50 IF $GET(BPCLWC)="SP"
SET ^TMP($JOB,BPCCNTR)="** PLEASE BRING THIS WITH YOU TO THE LAB **"
SET BPCCNTR=BPCCNTR+1
End DoDot:2
End DoDot:1
+51 SET ^TMP($JOB,.5)=BPCCNTR
QUIT
+52 ;
TEST SET ^TMP($JOB,BPCCNTR)="TEST/PROCEDURE: "_$PIECE(^LAB(60,+BPCTP,0),U)_BPCSPC
SET ^TMP($JOB,BPCCNTR)=$EXTRACT(^TMP($JOB,BPCCNTR),1,48)
+1 SET BPCUR=+$PIECE(BPCTP,U,2)
IF BPCUR
SET ^TMP($JOB,BPCCNTR)=^TMP($JOB,BPCCNTR)_$PIECE(^LAB(62.05,BPCUR,0),U)
+2 SET BPCCNTR=BPCCNTR+1
+3 IF $DATA(^LAB(60,+BPCTP,3,"B",+BPCSAMP))
SET BPCX=$ORDER(^(+BPCSAMP,0))
IF BPCX
IF $DATA(^LAB(60,+BPCTP,3,1,BPCX))
SET BPCI=0
Begin DoDot:1
+4 SET BPCCNTR=BPCCNTR+1
SET ^TMP($JOB,BPCCNTR)="Ward Instructions:"
+5 FOR
SET BPCI=$ORDER(^LAB(60,+BPCTP,3,1,BPCX,BPCI))
IF BPCI<1
QUIT
SET BPCCNTR=BPCCNTR+1
SET ^TMP($JOB,BPCCNTR)=" "_^(BPCI,0)
End DoDot:1
+6 IF $ORDER(^LRO(69,BPCODT,1,BPCSN,2,BPCT,1,0))
SET BPCCNTR=BPCCNTR
SET ^TMP($JOB,BPCCNTR)="Ward Comments:"
SET BPCI=0
FOR
SET BPCI=$ORDER(^LRO(69,BPCODT,1,BPCSN,2,BPCT,1,BPCI))
IF BPCI<1
QUIT
SET BPCCNTR=BPCCNTR+1
SET ^TMP($JOB,BPCCNTR)=" "_^(BPCI,0)
+7 QUIT
