LR7OSBR ;slc/dcm - Silent BB report ;8/11/97
;;5.2T9;LR;**1018**;Nov 17, 2004
;;5.2;LAB SERVICE;**121,230**;Sep 27, 1994
EN ;
I '$D(^LR(LRDFN,"BB"))&($O(^LR(LRDFN,.99))>3!($O(^LR(LRDFN,.99))<1)) Q
S (LRN(2),LRSAV,LR("S"))=1,LRSS="BB"
K ^TMP("LRBL",$J)
F X=2.91,8,10.3,11.3 S LRN(X)=$P(^DD(63.01,X,0),"^")
D SET
N LRDFN
S G=0
F S G=$O(^TMP("LRBL",$J,G)) Q:G="" S N=0 F S N=$O(^TMP("LRBL",$J,G,N)) Q:N="" S LRDFN=0 F S LRDFN=$O(^TMP("LRBL",$J,G,N,LRDFN)) Q:'LRDFN S LR=^(LRDFN) D ^LR7OSBR1
K ^TMP("LRBL",$J)
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 LRMD=""
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
;
C ;
S X=$P(^LRO(69.2,LRAA,3,0),U,4)
W !?30,"(",X," patient",$S(X>1:"s",1:""),")"
Q
;
A ;
S X="BLOOD BANK",DIC=68,DIC(0)="MOXZ"
D ^DIC Q:Y<1
S LRAA=+Y,LRAA(1)=$P(Y,"^",2),LRAA(2)=$P(Y(0),"^",2),LRABV=$P(Y(0),"^",11),LRSS=$P(Y(0),"^",2)
Q
;
EN1(DFN) ;Process formatted Blood Bank Report
;Return formated report in ^TMP("LRC",$J)
Q:'$D(^TMP("LRRR",$J,+$G(DFN),"BB"))
N LBL,LCNT,LRAA,LRACC,LRAD,LRAN,LRCMNT,LRDFN,LRDPF,LRIDT,LRJ02,LRLLT,LRPG,LRSB
N LRONESPC,LREND,LRONETST,LRLLOC,GCNT,GIOM,LREND,CCNT,CT1,COUNT,LRIN,SEX,SSN,CT1
K ^TMP("LRC",$J)
S (LRONETST,LRONESPC)="",CCNT=1,COUNT=99,(LREND,LRIN,CT1,GCNT)=0,GIOSL=999999,GIOM=80,LROUT=9999999
Q:'$G(DFN)
S LRDFN=$$LRDFN^LR7OR1(DFN)
Q:'LRDFN
S LRDPF="2^DPT(",LRLLOC=$S($L($G(ORL(0))):ORL(0),1:"unknown")
S SEX=$P($G(@("^"_$P(LRDPF,"^",2)_+DFN_",0)")),"^",2),SSN=$P(^(0),"^",9)
S LRIDT=0 F S LRIDT=$O(^TMP("LRRR",$J,DFN,"BB",LRIDT)) Q:LRIDT<1 D
. N DFN
. D EN
Q
LR7OSBR ;slc/dcm - Silent BB report ;8/11/97
+1 ;;5.2T9;LR;**1018**;Nov 17, 2004
+2 ;;5.2;LAB SERVICE;**121,230**;Sep 27, 1994
EN ;
+1 IF '$DATA(^LR(LRDFN,"BB"))&($ORDER(^LR(LRDFN,.99))>3!($ORDER(^LR(LRDFN,.99))<1))
QUIT
+2 SET (LRN(2),LRSAV,LR("S"))=1
SET LRSS="BB"
+3 KILL ^TMP("LRBL",$JOB)
+4 FOR X=2.91,8,10.3,11.3
SET LRN(X)=$PIECE(^DD(63.01,X,0),"^")
+5 DO SET
+6 NEW LRDFN
+7 SET G=0
+8 FOR
SET G=$ORDER(^TMP("LRBL",$JOB,G))
IF G=""
QUIT
SET N=0
FOR
SET N=$ORDER(^TMP("LRBL",$JOB,G,N))
IF N=""
QUIT
SET LRDFN=0
FOR
SET LRDFN=$ORDER(^TMP("LRBL",$JOB,G,N,LRDFN))
IF 'LRDFN
QUIT
SET LR=^(LRDFN)
DO ^LR7OSBR1
+9 KILL ^TMP("LRBL",$JOB)
+10 QUIT
+11 ;
SET ;
+1 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)
+2 DO SSN^LRU
+3 SET LRMD=""
+4 IF Z
IF $DATA(@(Z(1)_Z_",0)"))
SET LRMD=$PIECE(^(0),"^")
+5 IF 'Z
SET Z=$SELECT($DATA(^LR(LRDFN,.2)):+^(.2),1:"")
IF Z
IF $DATA(^VA(200,Z,0))
SET LRMD=$PIECE(^(0),"^")
+6 SET ^TMP("LRBL",$JOB,LRLLOC,$PIECE(X,"^"),LRDFN)=$PIECE(X,"^",3)_"^"_SSN_"^"_$PIECE(W,"^",5)_"^"_$PIECE(W,"^",6)_"^"_LRMD
+7 QUIT
+8 ;
C ;
+1 SET X=$PIECE(^LRO(69.2,LRAA,3,0),U,4)
+2 WRITE !?30,"(",X," patient",$SELECT(X>1:"s",1:""),")"
+3 QUIT
+4 ;
A ;
+1 SET X="BLOOD BANK"
SET DIC=68
SET DIC(0)="MOXZ"
+2 DO ^DIC
IF Y<1
QUIT
+3 SET LRAA=+Y
SET LRAA(1)=$PIECE(Y,"^",2)
SET LRAA(2)=$PIECE(Y(0),"^",2)
SET LRABV=$PIECE(Y(0),"^",11)
SET LRSS=$PIECE(Y(0),"^",2)
+4 QUIT
+5 ;
EN1(DFN) ;Process formatted Blood Bank Report
+1 ;Return formated report in ^TMP("LRC",$J)
+2 IF '$DATA(^TMP("LRRR",$JOB,+$GET(DFN),"BB"))
QUIT
+3 NEW LBL,LCNT,LRAA,LRACC,LRAD,LRAN,LRCMNT,LRDFN,LRDPF,LRIDT,LRJ02,LRLLT,LRPG,LRSB
+4 NEW LRONESPC,LREND,LRONETST,LRLLOC,GCNT,GIOM,LREND,CCNT,CT1,COUNT,LRIN,SEX,SSN,CT1
+5 KILL ^TMP("LRC",$JOB)
+6 SET (LRONETST,LRONESPC)=""
SET CCNT=1
SET COUNT=99
SET (LREND,LRIN,CT1,GCNT)=0
SET GIOSL=999999
SET GIOM=80
SET LROUT=9999999
+7 IF '$GET(DFN)
QUIT
+8 SET LRDFN=$$LRDFN^LR7OR1(DFN)
+9 IF 'LRDFN
QUIT
+10 SET LRDPF="2^DPT("
SET LRLLOC=$SELECT($LENGTH($GET(ORL(0))):ORL(0),1:"unknown")
+11 SET SEX=$PIECE($GET(@("^"_$PIECE(LRDPF,"^",2)_+DFN_",0)")),"^",2)
SET SSN=$PIECE(^(0),"^",9)
+12 SET LRIDT=0
FOR
SET LRIDT=$ORDER(^TMP("LRRR",$JOB,DFN,"BB",LRIDT))
IF LRIDT<1
QUIT
Begin DoDot:1
+13 NEW DFN
+14 DO EN
End DoDot:1
+15 QUIT
