LRBLPE1 ; IHS/DIR/AAB - PATIENT DRUG LIST 15:41 ; [ 6/13/96 ]
;;5.2;LR;**1002**;JUN 01, 1998
;;5.2;LAB SERVICE;**72**;Sep 27, 1994
K ^TMP($J) S R="" W @IOF,$C(7),$P(LRP,"^"),?30,$P(LRP,"^",9),!,"Patient has positive direct AHG(BS) test MEDICATIONS:" S A(1)=$Y+21
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 X=0:0 S X=$O(^TMP($J,X)) Q:'X I $D(^PSDRUG(X,0)) D:$Y>A(1)!'$Y R Q:R[U W !,"OUTPATIENT PHARMACY ITEM: ",$P(^(0),"^")
K ^TMP($J) F X=0:0 S X=$O(^PS(55,DFN,"IV",X)) Q:'X!(R[U) F Y=0:0 S Y=$O(^PS(55,DFN,"IV",X,"AD",Y)) Q:'Y!(R[U) S ^TMP($J,+^(Y,0))=""
F X=0:0 S X=$O(^TMP($J,X)) Q:'X I $D(^PS(52.6,X,0)) D:$Y>A(1)!'$Y R Q:R[U W !,"IV DRUG: ",$P(^(0),"^")
K ^TMP($J) F X=0:0 S X=$O(^PS(55,DFN,5,X)) Q:'X!(R[U) F Y=0:0 S Y=$O(^PS(55,DFN,5,X,1,Y)) Q:'Y!(R[U) S ^TMP($J,+^(Y,0))=""
F X=0:0 S X=$O(^TMP($J,X)) Q:'X I $D(^PSDRUG(X,0)) D:$Y>A(1)!'$Y R Q:R[U W !,"INPATIENT PHARMACY ITEM: ",$P(^(0),"^")
Q
R R !,"'^' TO STOP ",R:DTIME S:'$T R="^" Q:R["^"
S A(1)=A(1)+21 S:$Y<22 A(1)=$Y+21 W $C(13),$J("",15),$C(13) Q
;
EN D V^LRU S X="BLOOD BANK" D ^LRUTL G:Y=-1 END S LRW(0,86250)=$O(^LAM("E","86250.0000",0)) I 'LRW(0,86250) W $C(7),!!,"Enter 86250.0000 as 'Antihuman Globulin Test' in WKLD CODE file (#64)" G END
W !!?6,"Division: ",LRAA(4),!,"Accession Area: ",LRO(68)
W !!,LRAA(1)," Patient data entry for ",LRH(0)," " S %=1 D YN^LRU G:%<1 END I %=2 S %DT="AEX",%DT(0)="-N" D ^%DT K %DT G:Y<1 END S LRAD=Y D D^LRU S LRH(0)=Y
I '$D(^LRO(68,LRAA,1,LRAD,0)) W $C(7),!!,"NO ",LRAA(1)," ACCESSIONS IN FILE FOR ",LRH(0),!! G END
S LRC=1 W !,"Enter TEST COMMENT(s) " S %=2 D YN^LRU G:%<1 END I %=1 K LRC
I $D(^XUSEC("LRBLSUPER",DUZ)) S LRE=1 W !,"Edit SPECIMEN COMMENT(s) " S %=2 D YN^LRU G:%<1 END I %=1 K LRE
K LRS D L^LRU D:'$D(^LAB(69.9,1,8,3,0)) C^LRBLS S X=$P(^LAB(69.9,1,8,3,0),"^",2) S:'X LRS=1 Q
;
K L +^LRO(68,LRAA,1,LRAD,1,LRAN,4):5 I '$T W $C(7),!!,"I can't uncount this workload now 'cause someone else is editing this record. ",!!,"Use the Workload manual input option to delete workload data ",!! Q
K ^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,0),^LRO(68,LRAA,1,LRAD,1,LRAN,4,"B",LRT,LRT)
S Y=0 F A=0:1 S Y=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,Y)) Q:'Y
S X=^LRO(68,LRAA,1,LRAD,1,LRAN,4,0),X(1)=$O(^(0)),^(0)=$P(X,"^",1,2)_"^"_X(1)_"^"_$S(X(1)="":"",1:A) L -^LRO(68,LRAA,1,LRAD,1,LRAN,4) Q
;
END D V^LRU Q
LRBLPE1 ; IHS/DIR/AAB - PATIENT DRUG LIST 15:41 ; [ 6/13/96 ]
+1 ;;5.2;LR;**1002**;JUN 01, 1998
+2 ;;5.2;LAB SERVICE;**72**;Sep 27, 1994
+3 KILL ^TMP($JOB)
SET R=""
WRITE @IOF,$CHAR(7),$PIECE(LRP,"^"),?30,$PIECE(LRP,"^",9),!,"Patient has positive direct AHG(BS) test MEDICATIONS:"
SET A(1)=$Y+21
+4 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
+5 FOR X=0:0
SET X=$ORDER(^TMP($JOB,X))
IF 'X
QUIT
IF $DATA(^PSDRUG(X,0))
IF $Y>A(1)!'$Y
DO R
IF R[U
QUIT
WRITE !,"OUTPATIENT PHARMACY ITEM: ",$PIECE(^(0),"^")
+6 KILL ^TMP($JOB)
FOR X=0:0
SET X=$ORDER(^PS(55,DFN,"IV",X))
IF 'X!(R[U)
QUIT
FOR Y=0:0
SET Y=$ORDER(^PS(55,DFN,"IV",X,"AD",Y))
IF 'Y!(R[U)
QUIT
SET ^TMP($JOB,+^(Y,0))=""
+7 FOR X=0:0
SET X=$ORDER(^TMP($JOB,X))
IF 'X
QUIT
IF $DATA(^PS(52.6,X,0))
IF $Y>A(1)!'$Y
DO R
IF R[U
QUIT
WRITE !,"IV DRUG: ",$PIECE(^(0),"^")
+8 KILL ^TMP($JOB)
FOR X=0:0
SET X=$ORDER(^PS(55,DFN,5,X))
IF 'X!(R[U)
QUIT
FOR Y=0:0
SET Y=$ORDER(^PS(55,DFN,5,X,1,Y))
IF 'Y!(R[U)
QUIT
SET ^TMP($JOB,+^(Y,0))=""
+9 FOR X=0:0
SET X=$ORDER(^TMP($JOB,X))
IF 'X
QUIT
IF $DATA(^PSDRUG(X,0))
IF $Y>A(1)!'$Y
DO R
IF R[U
QUIT
WRITE !,"INPATIENT PHARMACY ITEM: ",$PIECE(^(0),"^")
+10 QUIT
R READ !,"'^' TO STOP ",R:DTIME
IF '$TEST
SET R="^"
IF R["^"
QUIT
+1 SET A(1)=A(1)+21
IF $Y<22
SET A(1)=$Y+21
WRITE $CHAR(13),$JUSTIFY("",15),$CHAR(13)
QUIT
+2 ;
EN DO V^LRU
SET X="BLOOD BANK"
DO ^LRUTL
IF Y=-1
GOTO END
SET LRW(0,86250)=$ORDER(^LAM("E","86250.0000",0))
IF 'LRW(0,86250)
WRITE $CHAR(7),!!,"Enter 86250.0000 as 'Antihuman Globulin Test' in WKLD CODE file (#64)"
GOTO END
+1 WRITE !!?6,"Division: ",LRAA(4),!,"Accession Area: ",LRO(68)
+2 WRITE !!,LRAA(1)," Patient data entry for ",LRH(0)," "
SET %=1
DO YN^LRU
IF %<1
GOTO END
IF %=2
SET %DT="AEX"
SET %DT(0)="-N"
DO ^%DT
KILL %DT
IF Y<1
GOTO END
SET LRAD=Y
DO D^LRU
SET LRH(0)=Y
+3 IF '$DATA(^LRO(68,LRAA,1,LRAD,0))
WRITE $CHAR(7),!!,"NO ",LRAA(1)," ACCESSIONS IN FILE FOR ",LRH(0),!!
GOTO END
+4 SET LRC=1
WRITE !,"Enter TEST COMMENT(s) "
SET %=2
DO YN^LRU
IF %<1
GOTO END
IF %=1
KILL LRC
+5 IF $DATA(^XUSEC("LRBLSUPER",DUZ))
SET LRE=1
WRITE !,"Edit SPECIMEN COMMENT(s) "
SET %=2
DO YN^LRU
IF %<1
GOTO END
IF %=1
KILL LRE
+6 KILL LRS
DO L^LRU
IF '$DATA(^LAB(69.9,1,8,3,0))
DO C^LRBLS
SET X=$PIECE(^LAB(69.9,1,8,3,0),"^",2)
IF 'X
SET LRS=1
QUIT
+7 ;
K LOCK +^LRO(68,LRAA,1,LRAD,1,LRAN,4):5
IF '$TEST
WRITE $CHAR(7),!!,"I can't uncount this workload now 'cause someone else is editing this record. ",!!,"Use the Workload manual input option to delete workload data ",!!
QUIT
+1 KILL ^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,0),^LRO(68,LRAA,1,LRAD,1,LRAN,4,"B",LRT,LRT)
+2 SET Y=0
FOR A=0:1
SET Y=$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN,4,Y))
IF 'Y
QUIT
+3 SET X=^LRO(68,LRAA,1,LRAD,1,LRAN,4,0)
SET X(1)=$ORDER(^(0))
SET ^(0)=$PIECE(X,"^",1,2)_"^"_X(1)_"^"_$SELECT(X(1)="":"",1:A)
LOCK -^LRO(68,LRAA,1,LRAD,1,LRAN,4)
QUIT
+4 ;
END DO V^LRU
QUIT
