LRBLPH.m

LRBLPH ; IHS/DIR/FJE - PATIENT DRUG LIST 09:44 ; [ 2/18/93 ]

 ;;5.2;LR;;NOV 01, 1997

 ;

 ;;5.2;LAB SERVICE;;Sep 27, 1994

 D V^LRU S LRDPAF=1 D ^LRDPA G:LRDFN<1 END I +LRDPF'=2 W $C(7),!,"Must be entry in Patient File (2)" G LRBLPH

 W ! S ZTRTN="QUE^LRBLPH" D BEG^LRUTL G:POP!($D(ZTSK)) END

QUE U IO K ^TMP($J) D L^LRU,S^LRU

 D H S LR("F")=1

 F X=0:0 S X=$O(^PS(55,DFN,"P",X)) Q:'X  I $D(^(X,0)) S Y=+^(0) I $D(^PSRX(Y,0)) S ^TMP($J,+$P(^(0),"^",6))=0

 F LRX=0:0 S LRX=$O(^TMP($J,LRX)) Q:'LRX  I $D(^PSDRUG(LRX,0)) D:$Y>(IOSL-6) H Q:LR("Q")  W !,"OUTPATIENT PHARMACY ITEM: ",$P(^PSDRUG(LRX,0),"^")

 G:LR("Q") OUT K ^TMP($J) F X=0:0 S X=$O(^PS(55,DFN,"IV",X)) Q:'X  F Y=0:0 S Y=$O(^PS(55,DFN,"IV",X,"AD",Y)) Q:'Y  S ^TMP($J,+^(Y,0))=""

 F LRX=0:0 S LRX=$O(^TMP($J,LRX)) Q:'LRX  I $D(^PS(52.6,LRX,0)) D:$Y>(IOSL-6) H Q:LR("Q")  W !,"IV DRUG: ",$P(^PS(52.6,LRX,0),"^")

 G:LR("Q") OUT K ^TMP($J) F X=0:0 S X=$O(^PS(55,DFN,5,X)) Q:'X  F Y=0:0 S Y=$O(^PS(55,DFN,5,X,1,Y)) Q:'Y  S ^TMP($J,+^(Y,0))=""

 F LRX=0:0 S LRX=$O(^TMP($J,LRX)) Q:'LRX  I $D(^PSDRUG(LRX,0)) D:$Y>(IOSL-6) H Q:LR("Q")  W !,"INPATIENT  PHARMACY ITEM: ",$P(^PSDRUG(LRX,0),"^")

OUT D END^LRUTL,END Q

 ;

H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")

 ;D F^LRU W !,"Medication List for ",PNM," ",SSN,!,LR("%") Q

 D F^LRU W !,"Medication List for ",PNM," ",HRCN,!,LR("%") Q  ;IHS/ANMC/CLS 11/1/95

 ;

END D V^LRU Q

LRBLPH    ; IHS/DIR/FJE - PATIENT DRUG LIST 09:44 ; [ 2/18/93 ]

 +1       ;;5.2;LR;;NOV 01, 1997

 +2       ;

 +3       ;;5.2;LAB SERVICE;;Sep 27, 1994

 +4        DO V^LRU

           SET LRDPAF=1

           DO ^LRDPA

           IF LRDFN<1

               GOTO END

           IF +LRDPF'=2

               WRITE $CHAR(7),!,"Must be entry in Patient File (2)"

               GOTO LRBLPH

 +5        WRITE !

           SET ZTRTN="QUE^LRBLPH"

           DO BEG^LRUTL

           IF POP!($DATA(ZTSK))

               GOTO END

QUE        USE IO

           KILL ^TMP($JOB)

           DO L^LRU

           DO S^LRU

 +1        DO H

           SET LR("F")=1

 +2        FOR X=0:0

               SET X=$ORDER(^PS(55,DFN,"P",X))

               IF 'X

                   QUIT 

               IF $DATA(^(X,0))

                   SET Y=+^(0)

                   IF $DATA(^PSRX(Y,0))

                       SET ^TMP($JOB,+$PIECE(^(0),"^",6))=0

 +3        FOR LRX=0:0

               SET LRX=$ORDER(^TMP($JOB,LRX))

               IF 'LRX

                   QUIT 

               IF $DATA(^PSDRUG(LRX,0))

                   IF $Y>(IOSL-6)

                       DO H

                   IF LR("Q")

                       QUIT 

                   WRITE !,"OUTPATIENT PHARMACY ITEM: ",$PIECE(^PSDRUG(LRX,0),"^")

 +4        IF LR("Q")

               GOTO OUT

           KILL ^TMP($JOB)

           FOR X=0:0

               SET X=$ORDER(^PS(55,DFN,"IV",X))

               IF 'X

                   QUIT 

               FOR Y=0:0

                   SET Y=$ORDER(^PS(55,DFN,"IV",X,"AD",Y))

                   IF 'Y

                       QUIT 

                   SET ^TMP($JOB,+^(Y,0))=""

 +5        FOR LRX=0:0

               SET LRX=$ORDER(^TMP($JOB,LRX))

               IF 'LRX

                   QUIT 

               IF $DATA(^PS(52.6,LRX,0))

                   IF $Y>(IOSL-6)

                       DO H

                   IF LR("Q")

                       QUIT 

                   WRITE !,"IV DRUG: ",$PIECE(^PS(52.6,LRX,0),"^")

 +6        IF LR("Q")

               GOTO OUT

           KILL ^TMP($JOB)

           FOR X=0:0

               SET X=$ORDER(^PS(55,DFN,5,X))

               IF 'X

                   QUIT 

               FOR Y=0:0

                   SET Y=$ORDER(^PS(55,DFN,5,X,1,Y))

                   IF 'Y

                       QUIT 

                   SET ^TMP($JOB,+^(Y,0))=""

 +7        FOR LRX=0:0

               SET LRX=$ORDER(^TMP($JOB,LRX))

               IF 'LRX

                   QUIT 

               IF $DATA(^PSDRUG(LRX,0))

                   IF $Y>(IOSL-6)

                       DO H

                   IF LR("Q")

                       QUIT 

                   WRITE !,"INPATIENT  PHARMACY ITEM: ",$PIECE(^PSDRUG(LRX,0),"^")

OUT        DO END^LRUTL

           DO END

           QUIT 

 +1       ;

H          IF $DATA(LR("F"))

               IF IOST?1"C".E

                   DO M^LRU

                   IF LR("Q")

                       QUIT 

 +1       ;D F^LRU W !,"Medication List for ",PNM," ",SSN,!,LR("%") Q

 +2       ;IHS/ANMC/CLS 11/1/95

           DO F^LRU

           WRITE !,"Medication List for ",PNM," ",HRCN,!,LR("%")

           QUIT 

 +3       ;

END        DO V^LRU

           QUIT