- 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
