- LRBLPBR ;AVAMC/REG - BB TESTS REPORT ;3/28/94 11:59 ;
- ;;5.2;LAB SERVICE;**247**;Sep 27, 1994
- ;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
- 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)) D
- . S ^LRO(69.2,LRAA,3,LRDFN,0)=LRDFN_"^"_LRLLOC,^LRO(69.2,LRAA,3,"C",LRLLOC,LRDFN)=""
- . L +^LRO(69.2,LRAA,3):5 I '$T G GETP
- . 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 D FIELD^DID(63.01,X,"","LABEL","LRN") S LRN(X)=LRN("LABEL") K LRN("LABEL")
- 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
- 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),"^")
- I 'Z S LRMD="UNKNOWN"
- S ^TMP("LRBL",$J,LRLLOC,$P(X,"^"),LRDFN)=$P(X,"^",3)_"^"_SSN_"^"_$P(W,"^",5)_"^"_$P(W,"^",6)_"^"_LRMD Q
- ;
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRBLPBR 2714 printed Feb 18, 2025@23:37:33 Page 2
- LRBLPBR ;AVAMC/REG - BB TESTS REPORT ;3/28/94 11:59 ;
- +1 ;;5.2;LAB SERVICE;**247**;Sep 27, 1994
- +2 ;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
- GETP if '$DATA(LRAA)
- DO A
- +1 if '$DATA(LRAA)
- GOTO END
- +2 WRITE !
- KILL DIC
- DO ^LRDPA
- if LRDFN<1
- GOTO END
- +3 IF '$DATA(^LR(LRDFN,"BB"))
- WRITE $CHAR(7),!?3,"No blood bank data for ",LRP
- GOTO GETP
- +4 IF '$DATA(^LRO(69.2,LRAA,3,LRDFN,0))
- Begin DoDot:1
- +5 SET ^LRO(69.2,LRAA,3,LRDFN,0)=LRDFN_"^"_LRLLOC
- SET ^LRO(69.2,LRAA,3,"C",LRLLOC,LRDFN)=""
- +6 LOCK +^LRO(69.2,LRAA,3):5
- IF '$TEST
- GOTO GETP
- +7 SET X=^LRO(69.2,LRAA,3,0)
- SET ^(0)=$PIECE(X,"^",1,2)_"^"_LRDFN_"^"_($PIECE(X,"^",4)+1)
- +8 LOCK -^LRO(69.2,LRAA,3)
- End DoDot:1
- +9 GOTO GETP
- +10 ;
- CH DO A
- if '$DATA(LRAA)
- GOTO END
- +1 DO L
- if 'G
- GOTO END
- +2 SET LRAPX=1
- DO C
- +3 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)
- +1 DO L^LRU
- DO S^LRU
- +2 FOR X=2.91,8,10.3,11.3
- DO FIELD^DID(63.01,X,"","LABEL","LRN")
- SET LRN(X)=LRN("LABEL")
- KILL LRN("LABEL")
- +3 IF $DATA(LR("S"))
- DO SET
- GOTO LST
- +4 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 SET W=^LR(LRDFN,0)
- SET 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)
- +1 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 IF 'Z
- SET LRMD="UNKNOWN"
- +5 SET ^TMP("LRBL",$JOB,LRLLOC,$PIECE(X,"^"),LRDFN)=$PIECE(X,"^",3)_"^"_SSN_"^"_$PIECE(W,"^",5)_"^"_$PIECE(W,"^",6)_"^"_LRMD
- QUIT
- +6 ;
- SGL if '$DATA(LRAA)
- DO A
- +1 if '$DATA(LRAA)
- GOTO END
- +2 KILL DIC
- SET LRDPAF=1
- WRITE !
- DO ^LRDPA
- if LRDFN<1
- GOTO END
- +3 IF '$DATA(^LR(LRDFN,"BB"))
- WRITE $CHAR(7),!?3,"No blood bank data for ",LRP
- GOTO SGL
- +4 if LRLLOC=""
- SET LRLLOC="???"
- +5 SET (LRSAV,LR("S"))=1
- GOTO DEV
- +6 ;
- DEL DO A
- if Y=-1
- GOTO END
- +1 DO L
- if 'G
- GOTO END
- +2 DO C
- WRITE $CHAR(7),!!,"OK TO DELETE THE ",LRAA(1)," TEST REPORT QUEUE LIST"
- +3 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
- +4 WRITE !!,"FINE, LET'S FORGET IT",!
- QUIT
- C SET X=$PIECE(^LRO(69.2,LRAA,3,0),U,4)
- +1 WRITE !?30,"(",X," patient",$SELECT(X>1:"s",1:""),")"
- QUIT
- +2 ;
- 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