PSOLAB ;BHAM ISC/JMB - prints most recent lab value on action profile ; 5/6/94
;;7.0;OUTPATIENT PHARMACY;**29**;DEC 1997
;External Ref. to ^LAB(60, is supp. by DBIA# 333
;External Ref. to ^LR(LRDFN,"CH", is supp. by DBIA# 844
;External Ref. to ^PSDRUG(MDRUG,"CLOZ", is supp. by DBIA# 221
PRINT ;
I '$D(^DPT(DFN,"LR")) W !,"*** NO LAB DATA ON FILE ***" Q
S LRDFN=+$P(^DPT(DFN,"LR"),"^") Q:'LRDFN
S MDRUG=+$P(RX0,"^",6),TST=+$P(^PSDRUG(MDRUG,"CLOZ"),"^"),MDAYS=+$P(^("CLOZ"),"^",2),TSTSP=+$P(^("CLOZ"),"^",3)
G:'TST!('MDAYS)!('TSTSP) CLEAN
S TSTN=$P($G(^LAB(60,TST,0)),"^"),LDN=$S($D(^(.2)):+^(.2),1:+$P($P($G(^(0)),"^",5),";",2))
I $G(^LAB(60,TST,.2))=""&($P($P($G(^LAB(60,TST,0)),"^",5),";",2)="") W !,"*** Results for a panel cannot be printed! Only a lab test result can be printed for marked drugs." G CLEAN
EDATE S X="T-"_MDAYS K %DT D ^%DT S EDT=Y,EDL=(9999999-EDT)_".999999",INDIC=0
BEG F BDL=0:0 S BDL=$O(^LR(LRDFN,"CH",BDL)) Q:BDL=""!(BDL>EDL) D Q:INDIC=1
.Q:'$D(^LR(LRDFN,"CH",BDL,LDN))!('$D(^(0)))
.Q:$P(^LR(LRDFN,"CH",BDL,0),"^",3)=""!($P(^(0),"^",5)'=TSTSP)
.S Y=$S(+$P($P(^LR(LRDFN,"CH",BDL,0),"^"),"."):+$P($P(^(0),"^"),"."),1:$P(^(0),"^",3))
.W !,"*** MOST RECENT "_$G(TSTN)_" PERFORMED "_$E(Y,4,5)_"-"_$E(Y,6,7)_"-"_$E(Y,2,3)_" = "_$P($G(^LR(LRDFN,"CH",BDL,LDN)),"^")_" "_$P($G(^LAB(60,TST,1,TSTSP,0)),"^",7) S INDIC=1
W:INDIC=0 !,"*** NO RESULTS FOR "_TSTN_" SINCE "_$E(EDT,4,5)_"-"_$E(EDT,6,7)_"-"_$E(EDT,2,3)
CLEAN K BDL,EDL,EDT,INDIC,LDN,LRDFN,MDAYS,MDRUG,TST,TSTN,TSTSP,X,Y
K DA,DIRUT,DR,DTOUT,DUOUT,IEN50,LIEN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOLAB 1575 printed Dec 13, 2024@02:30:18 Page 2
PSOLAB ;BHAM ISC/JMB - prints most recent lab value on action profile ; 5/6/94
+1 ;;7.0;OUTPATIENT PHARMACY;**29**;DEC 1997
+2 ;External Ref. to ^LAB(60, is supp. by DBIA# 333
+3 ;External Ref. to ^LR(LRDFN,"CH", is supp. by DBIA# 844
+4 ;External Ref. to ^PSDRUG(MDRUG,"CLOZ", is supp. by DBIA# 221
PRINT ;
+1 IF '$DATA(^DPT(DFN,"LR"))
WRITE !,"*** NO LAB DATA ON FILE ***"
QUIT
+2 SET LRDFN=+$PIECE(^DPT(DFN,"LR"),"^")
if 'LRDFN
QUIT
+3 SET MDRUG=+$PIECE(RX0,"^",6)
SET TST=+$PIECE(^PSDRUG(MDRUG,"CLOZ"),"^")
SET MDAYS=+$PIECE(^("CLOZ"),"^",2)
SET TSTSP=+$PIECE(^("CLOZ"),"^",3)
+4 if 'TST!('MDAYS)!('TSTSP)
GOTO CLEAN
+5 SET TSTN=$PIECE($GET(^LAB(60,TST,0)),"^")
SET LDN=$SELECT($DATA(^(.2)):+^(.2),1:+$PIECE($PIECE($GET(^(0)),"^",5),";",2))
+6 IF $GET(^LAB(60,TST,.2))=""&($PIECE($PIECE($GET(^LAB(60,TST,0)),"^",5),";",2)="")
WRITE !,"*** Results for a panel cannot be printed! Only a lab test result can be printed for marked drugs."
GOTO CLEAN
EDATE SET X="T-"_MDAYS
KILL %DT
DO ^%DT
SET EDT=Y
SET EDL=(9999999-EDT)_".999999"
SET INDIC=0
BEG FOR BDL=0:0
SET BDL=$ORDER(^LR(LRDFN,"CH",BDL))
if BDL=""!(BDL>EDL)
QUIT
Begin DoDot:1
+1 if '$DATA(^LR(LRDFN,"CH",BDL,LDN))!('$DATA(^(0)))
QUIT
+2 if $PIECE(^LR(LRDFN,"CH",BDL,0),"^",3)=""!($PIECE(^(0),"^",5)'=TSTSP)
QUIT
+3 SET Y=$SELECT(+$PIECE($PIECE(^LR(LRDFN,"CH",BDL,0),"^"),"."):+$PIECE($PIECE(^(0),"^"),"."),1:$PIECE(^(0),"^",3))
+4 WRITE !,"*** MOST RECENT "_$GET(TSTN)_" PERFORMED "_$EXTRACT(Y,4,5)_"-"_$EXTRACT(Y,6,7)_"-"_$EXTRACT(Y,2,3)_" = "_$PIECE($GET(^LR(LRDFN,"CH",BDL,LDN)),"^")_" "_$PIECE($GET(^LAB(60,TST,1,TSTSP,0)),"^",7)
SET INDIC=1
End DoDot:1
if INDIC=1
QUIT
+5 if INDIC=0
WRITE !,"*** NO RESULTS FOR "_TSTN_" SINCE "_$EXTRACT(EDT,4,5)_"-"_$EXTRACT(EDT,6,7)_"-"_$EXTRACT(EDT,2,3)
CLEAN KILL BDL,EDL,EDT,INDIC,LDN,LRDFN,MDAYS,MDRUG,TST,TSTN,TSTSP,X,Y
+1 KILL DA,DIRUT,DR,DTOUT,DUOUT,IEN50,LIEN
+2 QUIT
