- LR7OSBR ;slc/dcm - Silent BB report ;8/11/97
- ;;5.2;LAB SERVICE;**121,230,387,535**;Sep 27, 1994;Build 16
- EN ;
- I '$D(DFN) S DFN=$P(^LR(LRDFN,0),"^",3)
- I $$GET^XPAR("DIV^SYS^PKG","OR VBECS ON",1,"Q"),$L($T(EN^ORWLR1)),$L($T(CPRS^VBECA3B)) D Q
- . D VBECS
- . I $$GET^XPAR("DIV^SYS^PKG","OR VBECS LEGACY REPORT",1,"Q") D
- .. D LINE^LR7OSUM4
- .. D LN S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(20,CCNT,"*** [LEGACY VISTA BLOOD BANK REPORT] ***")
- .. D LN S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(4,CCNT,"The following historical information comes from the Legacy VISTA Blood Bank System")
- .. D LN S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(4,CCNT,"It represents data collected prior to the installation of VBECS. Some of the information")
- .. D LN S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(4,CCNT,"in this report may have been duplicated in the VBECS report above (if available).")
- .. D LINE^LR7OSUM4
- .. D LEGACY
- D LEGACY
- Q
- LEGACY ;VISTA Legacy Blood Bank Report
- 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
- VBECS ;;Gets Blood Bank Report from VBECS
- N CNT,LRI
- K ^TMP("ORLRC",$J)
- ;D EN^ORWLR1(DFN),LN
- D EN^VBECRPT,LN
- I '$O(^TMP("ORLRC",$J,0)) S ^TMP("ORLRC",$J,1,0)="",^TMP("ORLRC",$J,2,0)="No Blood Bank report available..."
- S CNT=$O(^TMP("LRC",$J,9999999999),-1),LRI="",^TMP("LRH",$J,"BLOOD BANK")=$S(CNT>0:CNT,1:1)
- F S LRI=$O(^TMP("ORLRC",$J,LRI)) Q:LRI="" S X=^(LRI,0),CNT=CNT+1,^TMP("LRC",$J,CNT,0)=X
- S GCNT=CNT
- K ^TMP("ORLRC",$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
- LN ;
- S GCNT=GCNT+1,CCNT=1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR7OSBR 3234 printed Feb 18, 2025@23:31:23 Page 2
- LR7OSBR ;slc/dcm - Silent BB report ;8/11/97
- +1 ;;5.2;LAB SERVICE;**121,230,387,535**;Sep 27, 1994;Build 16
- EN ;
- +1 IF '$DATA(DFN)
- SET DFN=$PIECE(^LR(LRDFN,0),"^",3)
- +2 IF $$GET^XPAR("DIV^SYS^PKG","OR VBECS ON",1,"Q")
- IF $LENGTH($TEXT(EN^ORWLR1))
- IF $LENGTH($TEXT(CPRS^VBECA3B))
- Begin DoDot:1
- +3 DO VBECS
- +4 IF $$GET^XPAR("DIV^SYS^PKG","OR VBECS LEGACY REPORT",1,"Q")
- Begin DoDot:2
- +5 DO LINE^LR7OSUM4
- +6 DO LN
- SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(20,CCNT,"*** [LEGACY VISTA BLOOD BANK REPORT] ***")
- +7 DO LN
- SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(4,CCNT,"The following historical information comes from the Legacy VISTA Blood Bank System")
- +8 DO LN
- SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(4,CCNT,"It represents data collected prior to the installation of VBECS. Some of the information")
- +9 DO LN
- SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(4,CCNT,"in this report may have been duplicated in the VBECS report above (if available).")
- +10 DO LINE^LR7OSUM4
- +11 DO LEGACY
- End DoDot:2
- End DoDot:1
- QUIT
- +12 DO LEGACY
- +13 QUIT
- LEGACY ;VISTA Legacy Blood Bank Report
- +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
- VBECS ;;Gets Blood Bank Report from VBECS
- +1 NEW CNT,LRI
- +2 KILL ^TMP("ORLRC",$JOB)
- +3 ;D EN^ORWLR1(DFN),LN
- +4 DO EN^VBECRPT
- DO LN
- +5 IF '$ORDER(^TMP("ORLRC",$JOB,0))
- SET ^TMP("ORLRC",$JOB,1,0)=""
- SET ^TMP("ORLRC",$JOB,2,0)="No Blood Bank report available..."
- +6 SET CNT=$ORDER(^TMP("LRC",$JOB,9999999999),-1)
- SET LRI=""
- SET ^TMP("LRH",$JOB,"BLOOD BANK")=$SELECT(CNT>0:CNT,1:1)
- +7 FOR
- SET LRI=$ORDER(^TMP("ORLRC",$JOB,LRI))
- if LRI=""
- QUIT
- SET X=^(LRI,0)
- SET CNT=CNT+1
- SET ^TMP("LRC",$JOB,CNT,0)=X
- +8 SET GCNT=CNT
- +9 KILL ^TMP("ORLRC",$JOB)
- +10 QUIT
- 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
- LN ;
- +1 SET GCNT=GCNT+1
- SET CCNT=1
- +2 QUIT