PSOLAB.m

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

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