LR7OSUM3 ;DALOI/STAFF - Silent Patient cum cont. ;02/20/13 16:5
;;5.2;LAB SERVICE;**121,201,187,228,250,350,427**;Sep 27, 1994;Build 33
;
N GIOM,LRPF,LRI
S GIOM=$G(LRGIOM)
I GIOM="" D
. S GIOM=$$GET^XPAR("USR^DIV^PKG","LR CH GUI REPORT RIGHT MARGIN",1,"Q")
. I GIOM="" S GIOM=80
S LRAG=0,LRYESCOM=0,LRIL=0,LRFULL=0
;
; Print header with name of facility printing report.
I $$GET^XPAR("DIV^PKG","LR REPORTS FACILITY PRINT",1,"Q")>1 D PFAC
;
D LRMH S LRMH="MISC"
G PRE^LR7OSUM6
;
LRMH S LRMH=0
F S LRMH=$O(^TMP($J,LRDFN,LRMH)) Q:LRMH<1 S X=^(LRMH) D MH1
Q
;
;
MH1 S LRMHN=$P(X,U,1),LRSH=0
S LRPG=1
D TOP^LR7OSUM6
S LROFMT="",LRFDE=0 D LRSH
D:'LRFDE LRBOT^LR7OSUM6
K LRTM,^TMP($J,"TM")
S LRFULL=0,LRTM=0,LROFMT="",LRFDE=0
Q
;
;
LRSH ;from LR7OSUM4, LR7OSUM5
S LRSH=$O(^TMP($J,LRDFN,LRMH,LRSH)) Q:LRSH<1 G:$D(^(LRSH))'=11 LRSH S X=^(LRSH),LRSHN=$P(X,U,1),LRTOPP=$P(X,U,2),LRSHD=$P(X,U,3),LRFMT=$P(X,U,4),LRFMT(1)=$E(LRFMT,1),LROFMT(1)=$E(LROFMT,1)
Q:$S('$D(SUBHEAD):0,1:'$D(SUBHEAD(LRSHN)))
I (LROFMT["V"&(LRFMT["V"))!(LROFMT'=""&(LRFMT(1)'=LROFMT(1))) S LROFMT="" D HEAD^LR7OSUM6
S LROFMT=LRFMT,LRTOPP=$E($P(^LAB(61,LRTOPP,0),U,1),1,13),LRTOT=0,LRPL=1,LRACT=0,LRJS=0,LRTS=0,LRFDE=0
S LRNP=0,LRFDT=0,LRLFDT=0,LRFFDT=0 D LRNP
;
LOOP ;from LR7OSUM5
I LRACT<LRPL S LRFDT=LRFFDT G:LRFMT["H" TS^LR7OSUM5 I LRFMT["V" S LRMULT=99999,LRMU=0 G BS^LR7OSUM4
D TXT1^LR7OSUM5
I LRCTR'<LRLNS S LRFULL=1 S:'LRFDT LRFED=1 D:LRFDE LRBOT^LR7OSUM6 D:'LRFDT HEAD^LR7OSUM6 S LRFULL=0 G LRSH
G LRSH
;
;
LRNP ;from LR7OSUM4
S I=0 F S I=$O(^LAB(64.5,1,1,LRMH,1,LRSH,1,I)) Q:I<1 D
. N LRCW
. S LRCW=$P(^LAB(64.5,1,1,LRMH,1,LRSH,1,I,0),U,2)
. I LRCW<1 S LRCW=15
. S LRTOT=LRTOT+LRCW
. I LRTOT>(GIOM-25) S LRPL=LRPL+1,LRTOT=LRCW
LRLNS ;from LR7OSUM5
K LRTM,^TMP($J,"TM") S LRTM=0
S LRLNS=((GIOSL-18)-(GCNT+(6*LRPL)))\LRPL
S LRCL=(GIOM/2)-(5+($L(LRSHN)/2)) S GCNT=GCNT+1,CCNT=1,^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(LRCL,CCNT,"---- "_LRSHN_" ----")
S ^TMP("LRH",$J,LRSHN)=GCNT ;Set x-ref of minor headers with data
S LRACT=0,LRJS=0,LRNP=1
Q
;
;
UDT ;from LR7OSUM4, LR7OSUM5
N LRBDT,LREAL
S LRBDT=LRFDT
; If inexact date/time then suppress any pseudo time.
S LREAL=+$P(^TMP($J,LRDFN,LRMH,LRSH,LRFDT,0),U,6)
; Forces all formats to be inverse date/time regardless of parameter in file 64.5
S LRFDT=$P(^TMP($J,LRDFN,LRMH,LRSH,LRFDT,0),U,2) ;,LRTIM=$E(LRFDT,9,12)
;F I=0:0 Q:$L(LRTIM)=4 S LRTIM=LRTIM_0
;S LRTIM=$S(LRTIM?4"0":" ",1:$E(LRTIM,1,2)_":"_$E(LRTIM,3,4))
;S LRUDT=$E($$Y2K^LRX($P(LRFDT,".")),1,5)_" "_$J(LRTIM,4)_" "
S LRFDT=LRBDT D:LRTM LRTM
Q
;
;
LRTM ;
S LRNXSW=0 S:'$D(LRTM(0)) LRTM(0)=96
I $D(^TMP($J,"TM",LRFDT)) S LRNXSW=1
E I $D(^TMP($J,LRDFN,LRMH,LRSH,LRFDT,"TX")) D
. S ^TMP($J,"TM",LRFDT)=^TMP("LRCMTINDX",$J,LRFDT),LRNXSW=1
. S I=0 F S I=$O(^TMP($J,LRDFN,LRMH,LRSH,LRFDT,"TX",I)) Q:I<1 S ^TMP($J,"TM",LRFDT,I)=^(I,0)
N LRUDT7
;S LRUDT7=$$Y2K^LRX(9999999-LRFDT)
;S LRUDT7=$$FMTE^XLFDT(9999999-LRFDT,"1"_$S(LREAL:"D",1:"M"))
S LRUDT7=$$LRUDT^LR7OSUM6(9999999-LRFDT,LREAL)
S LRUDT=$P(LRUDT7,"@")_" "_$E($P(LRUDT7,"@",2),1,5)
;S:LRNXSW I=$P(^TMP($J,"TM",LRFDT),"^"),LRUDT=I_$E(" ",1,$S(I'="":1,1:2))_LRUDT
I LRNXSW D
. S I=$P(^TMP($J,"TM",LRFDT),"^")
. I I'="" S I="["_I_"]"
. S LRUDT=$$LJ^XLFSTR(I,5)_LRUDT_" "
Q
;
;
PFAC ; Print header with name of facility printing report.
;
D PFAC^LRRP1(DUZ(2),0,1,.LRPF)
I ($O(^TMP($J,LRDFN,0))!($O(^TMP($J,LRDFN,"MISC",0)))),$D(LRPF) D
. S LRI=0
. F S LRI=$O(LRPF(LRI)) Q:'LRI D LN^LR7OSUM4 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(CCNT,CCNT,LRPF(LRI))
. D LINE^LR7OSUM4 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(CCNT,CCNT,"As of: "_$$HTE^XLFDT($H,"1M"))
. D LINE^LR7OSUM4,LINE^LR7OSUM4
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR7OSUM3 3804 printed Dec 13, 2024@02:05:43 Page 2
LR7OSUM3 ;DALOI/STAFF - Silent Patient cum cont. ;02/20/13 16:5
+1 ;;5.2;LAB SERVICE;**121,201,187,228,250,350,427**;Sep 27, 1994;Build 33
+2 ;
+3 NEW GIOM,LRPF,LRI
+4 SET GIOM=$GET(LRGIOM)
+5 IF GIOM=""
Begin DoDot:1
+6 SET GIOM=$$GET^XPAR("USR^DIV^PKG","LR CH GUI REPORT RIGHT MARGIN",1,"Q")
+7 IF GIOM=""
SET GIOM=80
End DoDot:1
+8 SET LRAG=0
SET LRYESCOM=0
SET LRIL=0
SET LRFULL=0
+9 ;
+10 ; Print header with name of facility printing report.
+11 IF $$GET^XPAR("DIV^PKG","LR REPORTS FACILITY PRINT",1,"Q")>1
DO PFAC
+12 ;
+13 DO LRMH
SET LRMH="MISC"
+14 GOTO PRE^LR7OSUM6
+15 ;
LRMH SET LRMH=0
+1 FOR
SET LRMH=$ORDER(^TMP($JOB,LRDFN,LRMH))
if LRMH<1
QUIT
SET X=^(LRMH)
DO MH1
+2 QUIT
+3 ;
+4 ;
MH1 SET LRMHN=$PIECE(X,U,1)
SET LRSH=0
+1 SET LRPG=1
+2 DO TOP^LR7OSUM6
+3 SET LROFMT=""
SET LRFDE=0
DO LRSH
+4 if 'LRFDE
DO LRBOT^LR7OSUM6
+5 KILL LRTM,^TMP($JOB,"TM")
+6 SET LRFULL=0
SET LRTM=0
SET LROFMT=""
SET LRFDE=0
+7 QUIT
+8 ;
+9 ;
LRSH ;from LR7OSUM4, LR7OSUM5
+1 SET LRSH=$ORDER(^TMP($JOB,LRDFN,LRMH,LRSH))
if LRSH<1
QUIT
if $DATA(^(LRSH))'=11
GOTO LRSH
SET X=^(LRSH)
SET LRSHN=$PIECE(X,U,1)
SET LRTOPP=$PIECE(X,U,2)
SET LRSHD=$PIECE(X,U,3)
SET LRFMT=$PIECE(X,U,4)
SET LRFMT(1)=$EXTRACT(LRFMT,1)
SET LROFMT(1)=$EXTRACT(LROFMT,1)
+2 if $SELECT('$DATA(SUBHEAD)
QUIT
+3 IF (LROFMT["V"&(LRFMT["V"))!(LROFMT'=""&(LRFMT(1)'=LROFMT(1)))
SET LROFMT=""
DO HEAD^LR7OSUM6
+4 SET LROFMT=LRFMT
SET LRTOPP=$EXTRACT($PIECE(^LAB(61,LRTOPP,0),U,1),1,13)
SET LRTOT=0
SET LRPL=1
SET LRACT=0
SET LRJS=0
SET LRTS=0
SET LRFDE=0
+5 SET LRNP=0
SET LRFDT=0
SET LRLFDT=0
SET LRFFDT=0
DO LRNP
+6 ;
LOOP ;from LR7OSUM5
+1 IF LRACT<LRPL
SET LRFDT=LRFFDT
if LRFMT["H"
GOTO TS^LR7OSUM5
IF LRFMT["V"
SET LRMULT=99999
SET LRMU=0
GOTO BS^LR7OSUM4
+2 DO TXT1^LR7OSUM5
+3 IF LRCTR'<LRLNS
SET LRFULL=1
if 'LRFDT
SET LRFED=1
if LRFDE
DO LRBOT^LR7OSUM6
if 'LRFDT
DO HEAD^LR7OSUM6
SET LRFULL=0
GOTO LRSH
+4 GOTO LRSH
+5 ;
+6 ;
LRNP ;from LR7OSUM4
+1 SET I=0
FOR
SET I=$ORDER(^LAB(64.5,1,1,LRMH,1,LRSH,1,I))
if I<1
QUIT
Begin DoDot:1
+2 NEW LRCW
+3 SET LRCW=$PIECE(^LAB(64.5,1,1,LRMH,1,LRSH,1,I,0),U,2)
+4 IF LRCW<1
SET LRCW=15
+5 SET LRTOT=LRTOT+LRCW
+6 IF LRTOT>(GIOM-25)
SET LRPL=LRPL+1
SET LRTOT=LRCW
End DoDot:1
LRLNS ;from LR7OSUM5
+1 KILL LRTM,^TMP($JOB,"TM")
SET LRTM=0
+2 SET LRLNS=((GIOSL-18)-(GCNT+(6*LRPL)))\LRPL
+3 SET LRCL=(GIOM/2)-(5+($LENGTH(LRSHN)/2))
SET GCNT=GCNT+1
SET CCNT=1
SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(LRCL,CCNT,"---- "_LRSHN_" ----")
+4 ;Set x-ref of minor headers with data
SET ^TMP("LRH",$JOB,LRSHN)=GCNT
+5 SET LRACT=0
SET LRJS=0
SET LRNP=1
+6 QUIT
+7 ;
+8 ;
UDT ;from LR7OSUM4, LR7OSUM5
+1 NEW LRBDT,LREAL
+2 SET LRBDT=LRFDT
+3 ; If inexact date/time then suppress any pseudo time.
+4 SET LREAL=+$PIECE(^TMP($JOB,LRDFN,LRMH,LRSH,LRFDT,0),U,6)
+5 ; Forces all formats to be inverse date/time regardless of parameter in file 64.5
+6 ;,LRTIM=$E(LRFDT,9,12)
SET LRFDT=$PIECE(^TMP($JOB,LRDFN,LRMH,LRSH,LRFDT,0),U,2)
+7 ;F I=0:0 Q:$L(LRTIM)=4 S LRTIM=LRTIM_0
+8 ;S LRTIM=$S(LRTIM?4"0":" ",1:$E(LRTIM,1,2)_":"_$E(LRTIM,3,4))
+9 ;S LRUDT=$E($$Y2K^LRX($P(LRFDT,".")),1,5)_" "_$J(LRTIM,4)_" "
+10 SET LRFDT=LRBDT
if LRTM
DO LRTM
+11 QUIT
+12 ;
+13 ;
LRTM ;
+1 SET LRNXSW=0
if '$DATA(LRTM(0))
SET LRTM(0)=96
+2 IF $DATA(^TMP($JOB,"TM",LRFDT))
SET LRNXSW=1
+3 IF '$TEST
IF $DATA(^TMP($JOB,LRDFN,LRMH,LRSH,LRFDT,"TX"))
Begin DoDot:1
+4 SET ^TMP($JOB,"TM",LRFDT)=^TMP("LRCMTINDX",$JOB,LRFDT)
SET LRNXSW=1
+5 SET I=0
FOR
SET I=$ORDER(^TMP($JOB,LRDFN,LRMH,LRSH,LRFDT,"TX",I))
if I<1
QUIT
SET ^TMP($JOB,"TM",LRFDT,I)=^(I,0)
End DoDot:1
+6 NEW LRUDT7
+7 ;S LRUDT7=$$Y2K^LRX(9999999-LRFDT)
+8 ;S LRUDT7=$$FMTE^XLFDT(9999999-LRFDT,"1"_$S(LREAL:"D",1:"M"))
+9 SET LRUDT7=$$LRUDT^LR7OSUM6(9999999-LRFDT,LREAL)
+10 SET LRUDT=$PIECE(LRUDT7,"@")_" "_$EXTRACT($PIECE(LRUDT7,"@",2),1,5)
+11 ;S:LRNXSW I=$P(^TMP($J,"TM",LRFDT),"^"),LRUDT=I_$E(" ",1,$S(I'="":1,1:2))_LRUDT
+12 IF LRNXSW
Begin DoDot:1
+13 SET I=$PIECE(^TMP($JOB,"TM",LRFDT),"^")
+14 IF I'=""
SET I="["_I_"]"
+15 SET LRUDT=$$LJ^XLFSTR(I,5)_LRUDT_" "
End DoDot:1
+16 QUIT
+17 ;
+18 ;
PFAC ; Print header with name of facility printing report.
+1 ;
+2 DO PFAC^LRRP1(DUZ(2),0,1,.LRPF)
+3 IF ($ORDER(^TMP($JOB,LRDFN,0))!($ORDER(^TMP($JOB,LRDFN,"MISC",0))))
IF $DATA(LRPF)
Begin DoDot:1
+4 SET LRI=0
+5 FOR
SET LRI=$ORDER(LRPF(LRI))
if 'LRI
QUIT
DO LN^LR7OSUM4
SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(CCNT,CCNT,LRPF(LRI))
+6 DO LINE^LR7OSUM4
SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(CCNT,CCNT,"As of: "_$$HTE^XLFDT($HOROLOG,"1M"))
+7 DO LINE^LR7OSUM4
DO LINE^LR7OSUM4
End DoDot:1
+8 QUIT
