- LRBLPBR ; IHS/DIR/FJE - BB TESTS REPORT 3/28/94 11:59 ;
- ;;5.2;LR;;NOV 01, 1997
- ;
- ;;5.2;LAB SERVICE;;Sep 27, 1994
- GETP D:'$D(LRAA) A G:'$D(LRAA) END W ! K DIC D ^LRDPA G:LRDFN<1 END I '$D(^LR(LRDFN,"BB")) W $C(7),!?3,"No blood bank data for ",LRP G GETP
- I '$D(^LRO(69.2,LRAA,3,LRDFN,0)) S ^(0)=LRDFN_"^"_LRLLOC,^LRO(69.2,LRAA,3,"C",LRLLOC,LRDFN)="" L +^LRO(69.2,LRAA,3) S X=^LRO(69.2,LRAA,3,0),^(0)=$P(X,"^",1,2)_"^"_LRDFN_"^"_($P(X,"^",4)+1) L -^LRO(69.2,LRAA,3)
- G GETP
- ;
- CH D A G:'$D(LRAA) END D L G:'G END S LRAPX=1 D C W !!,"Save reports for reprinting " S %=2 D YN^LRU G:%<1 END S:%=1 LRSAV=1
- DEV W !!,"Print component requests " S %=2 D YN^LRU Q:%<1 S:%=1 LRN(2)=1
- W ! S ZTRTN="QUE^LRBLPBR" D BEG^LRUTL G:POP!($D(ZTSK)) END
- ;
- QUE U IO K ^TMP("LRBL",$J) D L^LRU,S^LRU F X=2.91,8,10.3,11.3 S LRN(X)=$P(^DD(63.01,X,0),"^")
- I $D(LR("S")) D SET G LST
- S LRLLOC=0 F A=0:0 S LRLLOC=$O(^LRO(69.2,LRAA,3,"C",LRLLOC)) Q:LRLLOC="" F LRDFN=0:0 S LRDFN=$O(^LRO(69.2,LRAA,3,"C",LRLLOC,LRDFN)) Q:'LRDFN D SET
- LST S G=0
- F S G=$O(^TMP("LRBL",$J,G)) Q:G=""!(LR("Q")) S N=0 F S N=$O(^TMP("LRBL",$J,G,N)) Q:N=""!(LR("Q")) S LRDFN=0 F S LRDFN=$O(^TMP("LRBL",$J,G,N,LRDFN)) Q:'LRDFN!(LR("Q")) S LR=^(LRDFN) D ^LRBLPBR1
- I '$D(LRSAV) K ^LRO(69.2,LRAA,3) S ^LRO(69.2,LRAA,3,0)="^69.29A^^"
- W:IOST'?1"C".E @IOF K ^TMP("LRBL",$J) D END^LRUTL,END Q
- ;
- SET ;S W=^LR(LRDFN,0),Y=$P(W,"^",3),(LRDPF,P)=$P(W,"^",2),X=^DIC(P,0,"GL"),X=@(X_Y_",0)"),Z=+$G(^(.104)),Z(1)="^"_$P($G(^DD(P,.104,0)),"^",3),SSN=$P(X,"^",9) D SSN^LRU
- S W=^LR(LRDFN,0),(DFN,Y)=$P(W,"^",3),(LRDPF,P)=$P(W,"^",2),X=^DIC(P,0,"GL"),X=@(X_Y_",0)"),Z=+$G(^(.104)),Z(1)="^"_$P($G(^DD(P,.104,0)),"^",3),SSN=$P(X,"^",9) D SSN^LRU ;IHS/ANMC/CLS 11/1/95
- I Z,$D(@(Z(1)_Z_",0)")) S LRMD=$P(^(0),"^")
- I 'Z S Z=$S($D(^LR(LRDFN,.2)):+^(.2),1:"") I Z,$D(^VA(200,Z,0)) S LRMD=$P(^(0),"^")
- ;S ^TMP("LRBL",$J,LRLLOC,$P(X,"^"),LRDFN)=$P(X,"^",3)_"^"_SSN_"^"_$P(W,"^",5)_"^"_$P(W,"^",6)_"^"_LRMD Q
- S ^TMP("LRBL",$J,LRLLOC,$P(X,"^"),LRDFN)=$P(X,"^",3)_"^"_HRCN_"^"_$P(W,"^",5)_"^"_$P(W,"^",6)_"^"_LRMD Q ;IHS/ANMC/CLS 11/1/95
- ;
- SGL D:'$D(LRAA) A G:'$D(LRAA) END K DIC S LRDPAF=1 W ! D ^LRDPA G:LRDFN<1 END I '$D(^LR(LRDFN,"BB")) W $C(7),!?3,"No blood bank data for ",LRP G SGL
- S:LRLLOC="" LRLLOC="???"
- S (LRSAV,LR("S"))=1 G DEV
- ;
- DEL D A G:Y=-1 END D L G:'G END D C W $C(7),!!,"OK TO DELETE THE ",LRAA(1)," TEST REPORT QUEUE LIST" S %=2 D YN^LRU I %=1 K ^LRO(69.2,LRAA,3) S ^LRO(69.2,LRAA,3,0)="^69.29A^0^0" W $C(7),!,"LIST DELETED !" D END Q
- W !!,"FINE, LET'S FORGET IT",! Q
- C S X=$P(^LRO(69.2,LRAA,3,0),U,4) W !?30,"(",X," patient",$S(X>1:"s",1:""),")" Q
- ;
- L S G=$O(^LRO(69.2,LRAA,3,0)) I 'G W $C(7),!!,"NO BLOOD BANK PATIENTS ON THE TEST REPORT QUEUE",!! Q
- Q
- ;
- A D END S X="BLOOD BANK" D ^LRUTL Q
- ;
- END D V^LRU Q
- LRBLPBR ; IHS/DIR/FJE - BB TESTS REPORT 3/28/94 11:59 ;
- +1 ;;5.2;LR;;NOV 01, 1997
- +2 ;
- +3 ;;5.2;LAB SERVICE;;Sep 27, 1994
- GETP IF '$DATA(LRAA)
- DO A
- IF '$DATA(LRAA)
- GOTO END
- WRITE !
- KILL DIC
- DO ^LRDPA
- IF LRDFN<1
- GOTO END
- IF '$DATA(^LR(LRDFN,"BB"))
- WRITE $CHAR(7),!?3,"No blood bank data for ",LRP
- GOTO GETP
- +1 IF '$DATA(^LRO(69.2,LRAA,3,LRDFN,0))
- SET ^(0)=LRDFN_"^"_LRLLOC
- SET ^LRO(69.2,LRAA,3,"C",LRLLOC,LRDFN)=""
- LOCK +^LRO(69.2,LRAA,3)
- SET X=^LRO(69.2,LRAA,3,0)
- SET ^(0)=$PIECE(X,"^",1,2)_"^"_LRDFN_"^"_($PIECE(X,"^",4)+1)
- LOCK -^LRO(69.2,LRAA,3)
- +2 GOTO GETP
- +3 ;
- CH DO A
- IF '$DATA(LRAA)
- GOTO END
- DO L
- IF 'G
- GOTO END
- SET LRAPX=1
- DO C
- WRITE !!,"Save reports for reprinting "
- SET %=2
- DO YN^LRU
- IF %<1
- GOTO END
- IF %=1
- SET LRSAV=1
- DEV WRITE !!,"Print component requests "
- SET %=2
- DO YN^LRU
- IF %<1
- QUIT
- IF %=1
- SET LRN(2)=1
- +1 WRITE !
- SET ZTRTN="QUE^LRBLPBR"
- DO BEG^LRUTL
- IF POP!($DATA(ZTSK))
- GOTO END
- +2 ;
- QUE USE IO
- KILL ^TMP("LRBL",$JOB)
- DO L^LRU
- DO S^LRU
- FOR X=2.91,8,10.3,11.3
- SET LRN(X)=$PIECE(^DD(63.01,X,0),"^")
- +1 IF $DATA(LR("S"))
- DO SET
- GOTO LST
- +2 SET LRLLOC=0
- FOR A=0:0
- SET LRLLOC=$ORDER(^LRO(69.2,LRAA,3,"C",LRLLOC))
- IF LRLLOC=""
- QUIT
- FOR LRDFN=0:0
- SET LRDFN=$ORDER(^LRO(69.2,LRAA,3,"C",LRLLOC,LRDFN))
- IF 'LRDFN
- QUIT
- DO SET
- LST SET G=0
- +1 FOR
- SET G=$ORDER(^TMP("LRBL",$JOB,G))
- IF G=""!(LR("Q"))
- QUIT
- SET N=0
- FOR
- SET N=$ORDER(^TMP("LRBL",$JOB,G,N))
- IF N=""!(LR("Q"))
- QUIT
- SET LRDFN=0
- FOR
- SET LRDFN=$ORDER(^TMP("LRBL",$JOB,G,N,LRDFN))
- IF 'LRDFN!(LR("Q"))
- QUIT
- SET LR=^(LRDFN)
- DO ^LRBLPBR1
- +2 IF '$DATA(LRSAV)
- KILL ^LRO(69.2,LRAA,3)
- SET ^LRO(69.2,LRAA,3,0)="^69.29A^^"
- +3 IF IOST'?1"C".E
- WRITE @IOF
- KILL ^TMP("LRBL",$JOB)
- DO END^LRUTL
- DO END
- QUIT
- +4 ;
- SET ;S W=^LR(LRDFN,0),Y=$P(W,"^",3),(LRDPF,P)=$P(W,"^",2),X=^DIC(P,0,"GL"),X=@(X_Y_",0)"),Z=+$G(^(.104)),Z(1)="^"_$P($G(^DD(P,.104,0)),"^",3),SSN=$P(X,"^",9) D SSN^LRU
- +1 ;IHS/ANMC/CLS 11/1/95
- SET W=^LR(LRDFN,0)
- SET (DFN,Y)=$PIECE(W,"^",3)
- SET (LRDPF,P)=$PIECE(W,"^",2)
- SET X=^DIC(P,0,"GL")
- SET X=@(X_Y_",0)")
- SET Z=+$GET(^(.104))
- SET Z(1)="^"_$PIECE($GET(^DD(P,.104,0)),"^",3)
- SET SSN=$PIECE(X,"^",9)
- DO SSN^LRU
- +2 IF Z
- IF $DATA(@(Z(1)_Z_",0)"))
- SET LRMD=$PIECE(^(0),"^")
- +3 IF 'Z
- SET Z=$SELECT($DATA(^LR(LRDFN,.2)):+^(.2),1:"")
- IF Z
- IF $DATA(^VA(200,Z,0))
- SET LRMD=$PIECE(^(0),"^")
- +4 ;S ^TMP("LRBL",$J,LRLLOC,$P(X,"^"),LRDFN)=$P(X,"^",3)_"^"_SSN_"^"_$P(W,"^",5)_"^"_$P(W,"^",6)_"^"_LRMD Q
- +5 ;IHS/ANMC/CLS 11/1/95
- SET ^TMP("LRBL",$JOB,LRLLOC,$PIECE(X,"^"),LRDFN)=$PIECE(X,"^",3)_"^"_HRCN_"^"_$PIECE(W,"^",5)_"^"_$PIECE(W,"^",6)_"^"_LRMD
- QUIT
- +6 ;
- SGL IF '$DATA(LRAA)
- DO A
- IF '$DATA(LRAA)
- GOTO END
- KILL DIC
- SET LRDPAF=1
- WRITE !
- DO ^LRDPA
- IF LRDFN<1
- GOTO END
- IF '$DATA(^LR(LRDFN,"BB"))
- WRITE $CHAR(7),!?3,"No blood bank data for ",LRP
- GOTO SGL
- +1 IF LRLLOC=""
- SET LRLLOC="???"
- +2 SET (LRSAV,LR("S"))=1
- GOTO DEV
- +3 ;
- DEL DO A
- IF Y=-1
- GOTO END
- DO L
- IF 'G
- GOTO END
- DO C
- WRITE $CHAR(7),!!,"OK TO DELETE THE ",LRAA(1)," TEST REPORT QUEUE LIST"
- SET %=2
- DO YN^LRU
- IF %=1
- KILL ^LRO(69.2,LRAA,3)
- SET ^LRO(69.2,LRAA,3,0)="^69.29A^0^0"
- WRITE $CHAR(7),!,"LIST DELETED !"
- DO END
- QUIT
- +1 WRITE !!,"FINE, LET'S FORGET IT",!
- QUIT
- C SET X=$PIECE(^LRO(69.2,LRAA,3,0),U,4)
- WRITE !?30,"(",X," patient",$SELECT(X>1:"s",1:""),")"
- QUIT
- +1 ;
- L SET G=$ORDER(^LRO(69.2,LRAA,3,0))
- IF 'G
- WRITE $CHAR(7),!!,"NO BLOOD BANK PATIENTS ON THE TEST REPORT QUEUE",!!
- QUIT
- +1 QUIT
- +2 ;
- A DO END
- SET X="BLOOD BANK"
- DO ^LRUTL
- QUIT
- +1 ;
- END DO V^LRU
- QUIT
