- 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 Mar 13, 2025@21:35:10 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
