- LRBLST ; IHS/DIR/FJE - BB SUPERVISOR 9/18/89 10:08 ;
- ;;5.2;LR;;NOV 01, 1997
- ;
- ;;5.2;LAB SERVICE;;Sep 27, 1994
- D B G:Y=-1 END W !!?5,"Edit TESTS TO BE ",$S(LR=1:"DISPLAYED ON PATIENT LOOK-UP",1:"PRINTED ON TRANSFUSION REPORT"),!
- I '$D(^LRO(69.2,LRAA,61,0)) S ^(0)="^69.61PA^^"
- S LRQ=$O(^LAB(61,"B","BLOOD",0)) I 'LRQ W !!,$C(7),"BLOOD must be an entry in the TOPOGRAPHY file !" G END
- I '$D(^LRO(69.2,LRAA,61,LRQ,0)) S X=^LRO(69.2,LRAA,61,0),^(0)="^69.61PA^"_LRQ_"^"_($P(X,"^",4)+1),^(LRQ,0)=LRQ
- I '$D(^LRO(69.2,LRAA,61,LRQ,LR,0)) S ^(0)=$S(LR=1:"^69.62PAI^^",1:"^69.63PAI^^")
- ASK W ! S DA(2)=LRAA,DA(1)=LRQ,DIC="^LRO(69.2,LRAA,61,LRQ,LR,",DIC(0)="AEQLM",DLAYGO=69 D ^DIC K DIC,DLAYGO G:X=""!(X[U) END S DA=+Y,X(1)=$P(Y,U,2)
- S X=$P(^LRO(69.2,LRAA,61,LRQ,LR,DA,0),U,2) I X,'$D(^LAB(60,X(1),1,X)) S $P(^LRO(69.2,LRAA,61,LRQ,LR,DA,0),U,2)=""
- S DIE("NO^")=1,DIE="^LRO(69.2,LRAA,61,LRQ,LR,",DR=".01;.02:99" D ^DIE K DIE,DR,DA G ASK
- ;
- L D B Q:Y=-1 S DA=LRAA,DIE="^LRO(69.2,",DR=.07 D ^DIE Q
- B S X="BLOOD BANK" D ^LRUTL Q:Y=-1
- I '$D(^LRO(69.2,LRAA,0)) S ^(0)=LRAA_"^"_LRAA(2),X=^LRO(69.2,0),^(0)=$P(X,"^",1,2)_"^"_LRAA_"^"_($P(X,"^",4)+1),^LRO(69.2,"B",LRAA,LRAA)=""
- Q
- ;
- END D V^LRU Q
- ;
- EN D V^LRU S LR=1 G LRBLST
- EN1 D V^LRU S LR=2 G LRBLST
- LRBLST ; IHS/DIR/FJE - BB SUPERVISOR 9/18/89 10:08 ;
- +1 ;;5.2;LR;;NOV 01, 1997
- +2 ;
- +3 ;;5.2;LAB SERVICE;;Sep 27, 1994
- +4 DO B
- IF Y=-1
- GOTO END
- WRITE !!?5,"Edit TESTS TO BE ",$SELECT(LR=1:"DISPLAYED ON PATIENT LOOK-UP",1:"PRINTED ON TRANSFUSION REPORT"),!
- +5 IF '$DATA(^LRO(69.2,LRAA,61,0))
- SET ^(0)="^69.61PA^^"
- +6 SET LRQ=$ORDER(^LAB(61,"B","BLOOD",0))
- IF 'LRQ
- WRITE !!,$CHAR(7),"BLOOD must be an entry in the TOPOGRAPHY file !"
- GOTO END
- +7 IF '$DATA(^LRO(69.2,LRAA,61,LRQ,0))
- SET X=^LRO(69.2,LRAA,61,0)
- SET ^(0)="^69.61PA^"_LRQ_"^"_($PIECE(X,"^",4)+1)
- SET ^(LRQ,0)=LRQ
- +8 IF '$DATA(^LRO(69.2,LRAA,61,LRQ,LR,0))
- SET ^(0)=$SELECT(LR=1:"^69.62PAI^^",1:"^69.63PAI^^")
- ASK WRITE !
- SET DA(2)=LRAA
- SET DA(1)=LRQ
- SET DIC="^LRO(69.2,LRAA,61,LRQ,LR,"
- SET DIC(0)="AEQLM"
- SET DLAYGO=69
- DO ^DIC
- KILL DIC,DLAYGO
- IF X=""!(X[U)
- GOTO END
- SET DA=+Y
- SET X(1)=$PIECE(Y,U,2)
- +1 SET X=$PIECE(^LRO(69.2,LRAA,61,LRQ,LR,DA,0),U,2)
- IF X
- IF '$DATA(^LAB(60,X(1),1,X))
- SET $PIECE(^LRO(69.2,LRAA,61,LRQ,LR,DA,0),U,2)=""
- +2 SET DIE("NO^")=1
- SET DIE="^LRO(69.2,LRAA,61,LRQ,LR,"
- SET DR=".01;.02:99"
- DO ^DIE
- KILL DIE,DR,DA
- GOTO ASK
- +3 ;
- L DO B
- IF Y=-1
- QUIT
- SET DA=LRAA
- SET DIE="^LRO(69.2,"
- SET DR=.07
- DO ^DIE
- QUIT
- B SET X="BLOOD BANK"
- DO ^LRUTL
- IF Y=-1
- QUIT
- +1 IF '$DATA(^LRO(69.2,LRAA,0))
- SET ^(0)=LRAA_"^"_LRAA(2)
- SET X=^LRO(69.2,0)
- SET ^(0)=$PIECE(X,"^",1,2)_"^"_LRAA_"^"_($PIECE(X,"^",4)+1)
- SET ^LRO(69.2,"B",LRAA,LRAA)=""
- +2 QUIT
- +3 ;
- END DO V^LRU
- QUIT
- +1 ;
- EN DO V^LRU
- SET LR=1
- GOTO LRBLST
- EN1 DO V^LRU
- SET LR=2
- GOTO LRBLST
