- 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
