- LRBLJCK ; IHS/DIR/AAB - INVENTORY ABO/RH CK 7/30/95 15:38 ;
- ;;5.2;LR;**1002**;JUN 01, 1998
- ;;5.2;LAB SERVICE;**72**;Sep 27, 1994
- SD S Y(1)=Y+.99,Y=Y-.0001 F T=Y:0 S T=$O(^LRD(65,"A",T)) Q:'T!(T>Y(1)) F A=0:0 S A=$O(^LRD(65,"A",T,A)) Q:'A S X=^LRD(65,A,0) I $P(X,"^",3)=LRA,$P(^LAB(66,$P(X,"^",4),0),"^",19) S ^TMP($J,$P(X,"^"),A)=""
- Q
- ST F A=0:0 S A=$O(^LRD(65,"A",Y,A)) Q:'A S X=^LRD(65,A,0) I $P(X,"^",3)=LRA,$P(^LAB(66,$P(X,"^",4),0),"^",19) S ^TMP($J,$P(X,"^"),A)=""
- Q
- E S (LRW(10),LRW(11))="" R !!,"UNIT ID: ",X:DTIME G:X=""!(X["^") END
- I LR,$E(X,1,$L(LR(2)))=LR(2) D ^LRBLBU G:'$D(X) E
- X $P(^DD(65,.01,0),"^",5,99) I $D(X),X["?" K X
- I '$D(X) W !!,$C(7),$S($D(^DD(65,.01,3)):^(3),1:""),! X:$D(^(4)) ^(4) G E
- S DIC=65,DIC(0)="EFMXZ",DIC("S")="I $P(^(0),U,16)=DUZ(2)" D ^DIC K DIC I Y<1 W $C(7)," (NOT IN INVENTORY FILE)" G E
- S (DA,LRX)=+Y,DIE="^LRD(65,",DR="[LRBLIABRH]" D ^DIE D DT^LRBLU I LRCAPA D:LRW(10)]""&(LRW(10)'="ND") ABO D:LRW(11)]""&(LRW(11)'="ND") RH
- G E
- ;
- ABO K LRT S LRT=LRW("ABO") Q:$D(^LRD(65,LRX,99,LRT)) F A=0:0 S A=$O(LRW("ABO",A)) Q:'A S LRT(A)=""
- D:LRCAPA ^LRBLW Q
- RH K LRT S LRT=LRW("RH") Q:$D(^LRD(65,LRX,99,LRT)) F A=0:0 S A=$O(LRW("RH",A)) Q:'A S LRT(A)=""
- D:LRCAPA ^LRBLW Q
- EN ;
- D V^LRU,S^LRBLW S LR("M")=1,X="BLOOD BANK" D ^LRUTL G:Y=-1 END W !!?28,"Inventory ABO/Rh check",!!?15,"Division: ",LRAA(4) K LRE Q:'$D(DUZ)#2
- I LRCAPA F Y="ABO","RH" K LRT S X="UNIT "_Y_" RECHECK" D X^LRUWK G:'$D(X) END S LRW(Y)=LRT F A=0:0 S A=$O(LRT(A)) Q:'A S LRW(Y,A)=""
- K LRT D BAR^LRBLB W !!,"Enter TEST COMMENT(s) " S %=2 D YN^LRU G:%<1 END S:%=1 LRQ=1
- ASK W !!?14,"1) Enter by invoice# (batch)",!?14,"2) Entry by unit ID",!,"Select 1 or 2:" R X:DTIME G:X=""!(X[U) END
- I X<1!(X>2) W $C(7),!,"Enter a '1' to automatically request data entry for all units in a given invoice",!,"Enter a '2' to specify unit ID" G ASK
- S DIE=("NO")="OUTOK",LR(3)="" G:X=2 E
- I W !!,"Select ",$P(^DD(65,.03,0),"^"),": " R X:DTIME G:X=""!(X[U) END S:X["?" X="?" X $P(^(0),"^",5,99) I '$D(X) W:$D(^(3)) !,^(3) X:$D(^(4)) ^(4) G I
- S LRA=X
- S %DT="AETX",%DT("A")="Enter date received: ",%DT(0)="-N" D ^%DT K %DT G:Y<1 END S LRB=Y
- D WAIT^LRU D @($S(Y[".":"ST",1:"SD")) I '$D(^TMP($J)) W $C(7),!!,"There are no units in inventory for invoice# ",LRA," for " S Y=LRB D D^LRU W Y G ASK
- D DT^LRBLU S LRD(1)=0 F LRA=0:0 S LRD(1)=$O(^TMP($J,LRD(1))) Q:LRD(1)=""!($D(LRE)) F LRD=0:0 S LRD=$O(^TMP($J,LRD(1),LRD)) Q:'LRD!($D(LRE)) D A
- G:$D(LRE) E Q
- A S (LRW(10),LRW(11))="" W !!,LRD(1) S (DA,LRX)=LRD,DIE="^LRD(65,",DR="[LRBLIABRH]" D ^DIE I $D(Y) W !!,"WANT TO STOP LOOPING " S %=1 D YN^LRU S:%=1 LRE=1
- I LRCAPA D:LRW(10)]""&(LRW(10)'="ND") ABO D:LRW(11)]""&(LRW(11)'="ND") RH
- Q
- ;
- END D V^LRU Q
- LRBLJCK ; IHS/DIR/AAB - INVENTORY ABO/RH CK 7/30/95 15:38 ;
- +1 ;;5.2;LR;**1002**;JUN 01, 1998
- +2 ;;5.2;LAB SERVICE;**72**;Sep 27, 1994
- SD SET Y(1)=Y+.99
- SET Y=Y-.0001
- FOR T=Y:0
- SET T=$ORDER(^LRD(65,"A",T))
- IF 'T!(T>Y(1))
- QUIT
- FOR A=0:0
- SET A=$ORDER(^LRD(65,"A",T,A))
- IF 'A
- QUIT
- SET X=^LRD(65,A,0)
- IF $PIECE(X,"^",3)=LRA
- IF $PIECE(^LAB(66,$PIECE(X,"^",4),0),"^",19)
- SET ^TMP($JOB,$PIECE(X,"^"),A)=""
- +1 QUIT
- ST FOR A=0:0
- SET A=$ORDER(^LRD(65,"A",Y,A))
- IF 'A
- QUIT
- SET X=^LRD(65,A,0)
- IF $PIECE(X,"^",3)=LRA
- IF $PIECE(^LAB(66,$PIECE(X,"^",4),0),"^",19)
- SET ^TMP($JOB,$PIECE(X,"^"),A)=""
- +1 QUIT
- E SET (LRW(10),LRW(11))=""
- READ !!,"UNIT ID: ",X:DTIME
- IF X=""!(X["^")
- GOTO END
- +1 IF LR
- IF $EXTRACT(X,1,$LENGTH(LR(2)))=LR(2)
- DO ^LRBLBU
- IF '$DATA(X)
- GOTO E
- +2 XECUTE $PIECE(^DD(65,.01,0),"^",5,99)
- IF $DATA(X)
- IF X["?"
- KILL X
- +3 IF '$DATA(X)
- WRITE !!,$CHAR(7),$SELECT($DATA(^DD(65,.01,3)):^(3),1:""),!
- IF $DATA(^(4))
- XECUTE ^(4)
- GOTO E
- +4 SET DIC=65
- SET DIC(0)="EFMXZ"
- SET DIC("S")="I $P(^(0),U,16)=DUZ(2)"
- DO ^DIC
- KILL DIC
- IF Y<1
- WRITE $CHAR(7)," (NOT IN INVENTORY FILE)"
- GOTO E
- +5 SET (DA,LRX)=+Y
- SET DIE="^LRD(65,"
- SET DR="[LRBLIABRH]"
- DO ^DIE
- DO DT^LRBLU
- IF LRCAPA
- IF LRW(10)]""&(LRW(10)'="ND")
- DO ABO
- IF LRW(11)]""&(LRW(11)'="ND")
- DO RH
- +6 GOTO E
- +7 ;
- ABO KILL LRT
- SET LRT=LRW("ABO")
- IF $DATA(^LRD(65,LRX,99,LRT))
- QUIT
- FOR A=0:0
- SET A=$ORDER(LRW("ABO",A))
- IF 'A
- QUIT
- SET LRT(A)=""
- +1 IF LRCAPA
- DO ^LRBLW
- QUIT
- RH KILL LRT
- SET LRT=LRW("RH")
- IF $DATA(^LRD(65,LRX,99,LRT))
- QUIT
- FOR A=0:0
- SET A=$ORDER(LRW("RH",A))
- IF 'A
- QUIT
- SET LRT(A)=""
- +1 IF LRCAPA
- DO ^LRBLW
- QUIT
- EN ;
- +1 DO V^LRU
- DO S^LRBLW
- SET LR("M")=1
- SET X="BLOOD BANK"
- DO ^LRUTL
- IF Y=-1
- GOTO END
- WRITE !!?28,"Inventory ABO/Rh check",!!?15,"Division: ",LRAA(4)
- KILL LRE
- IF '$DATA(DUZ)#2
- QUIT
- +2 IF LRCAPA
- FOR Y="ABO","RH"
- KILL LRT
- SET X="UNIT "_Y_" RECHECK"
- DO X^LRUWK
- IF '$DATA(X)
- GOTO END
- SET LRW(Y)=LRT
- FOR A=0:0
- SET A=$ORDER(LRT(A))
- IF 'A
- QUIT
- SET LRW(Y,A)=""
- +3 KILL LRT
- DO BAR^LRBLB
- WRITE !!,"Enter TEST COMMENT(s) "
- SET %=2
- DO YN^LRU
- IF %<1
- GOTO END
- IF %=1
- SET LRQ=1
- ASK WRITE !!?14,"1) Enter by invoice# (batch)",!?14,"2) Entry by unit ID",!,"Select 1 or 2:"
- READ X:DTIME
- IF X=""!(X[U)
- GOTO END
- +1 IF X<1!(X>2)
- WRITE $CHAR(7),!,"Enter a '1' to automatically request data entry for all units in a given invoice",!,"Enter a '2' to specify unit ID"
- GOTO ASK
- +2 SET DIE=("NO")="OUTOK"
- SET LR(3)=""
- IF X=2
- GOTO E
- I WRITE !!,"Select ",$PIECE(^DD(65,.03,0),"^"),": "
- READ X:DTIME
- IF X=""!(X[U)
- GOTO END
- IF X["?"
- SET X="?"
- XECUTE $PIECE(^(0),"^",5,99)
- IF '$DATA(X)
- IF $DATA(^(3))
- WRITE !,^(3)
- IF $DATA(^(4))
- XECUTE ^(4)
- GOTO I
- +1 SET LRA=X
- +2 SET %DT="AETX"
- SET %DT("A")="Enter date received: "
- SET %DT(0)="-N"
- DO ^%DT
- KILL %DT
- IF Y<1
- GOTO END
- SET LRB=Y
- +3 DO WAIT^LRU
- DO @($SELECT(Y[".":"ST",1:"SD"))
- IF '$DATA(^TMP($JOB))
- WRITE $CHAR(7),!!,"There are no units in inventory for invoice# ",LRA," for "
- SET Y=LRB
- DO D^LRU
- WRITE Y
- GOTO ASK
- +4 DO DT^LRBLU
- SET LRD(1)=0
- FOR LRA=0:0
- SET LRD(1)=$ORDER(^TMP($JOB,LRD(1)))
- IF LRD(1)=""!($DATA(LRE))
- QUIT
- FOR LRD=0:0
- SET LRD=$ORDER(^TMP($JOB,LRD(1),LRD))
- IF 'LRD!($DATA(LRE))
- QUIT
- DO A
- +5 IF $DATA(LRE)
- GOTO E
- QUIT
- A SET (LRW(10),LRW(11))=""
- WRITE !!,LRD(1)
- SET (DA,LRX)=LRD
- SET DIE="^LRD(65,"
- SET DR="[LRBLIABRH]"
- DO ^DIE
- IF $DATA(Y)
- WRITE !!,"WANT TO STOP LOOPING "
- SET %=1
- DO YN^LRU
- IF %=1
- SET LRE=1
- +1 IF LRCAPA
- IF LRW(10)]""&(LRW(10)'="ND")
- DO ABO
- IF LRW(11)]""&(LRW(11)'="ND")
- DO RH
- +2 QUIT
- +3 ;
- END DO V^LRU
- QUIT
