51 lines
3.0 KiB
Mathematica
51 lines
3.0 KiB
Mathematica
LRAC3 ;SLC/DCM - PRINT CUMULATIVE REPORT ;3/3/88 13:23 ;
|
|
;;5.2;LAB SERVICE;**201,225**;Sep 27, 1994
|
|
LRSH ;from LRAC5, LRAC5
|
|
S LRSH=$O(^LAC(LRXLR,LRDFN,1,LRMH,1,LRSH)) Q:LRSH=""
|
|
I $O(^LAC(LRXLR,LRDFN,1,LRMH,1,LRSH,1,0))="" K ^LAC(LRXLR,LRDFN,1,LRMH,1,LRSH) G LRSH
|
|
I $O(^LAC(LRXLR,LRDFN,1,LRMH,1,LRSH,0))="" K ^(0) G LRSH
|
|
S X=^LAC(LRXLR,LRDFN,1,LRMH,1,LRSH,0),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)
|
|
I (LROFMT["V"&(LRFMT["V"))!(LROFMT(1)'=""&(LRFMT(1)'=LROFMT(1))) S LROFMT="" D HEAD1^LRAC6,HEAD^LRAC6
|
|
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,LRNP=0,LRFDT=0,LRLFDT=0,LRFFDT=0 D LRNP
|
|
LOOP ;from LRAC5
|
|
I LRACT<LRPL S LRFDT=LRFFDT G:LRFMT["H" TS^LRAC5 I LRFMT["V" S LRMULT=1,LRMU=0 D MUL G BS^LRAC4
|
|
D TXT1^LRAC9 I LRCTR'<LRLNS!(IOSL-18<$Y) S LRFULL=1 S:'LRFDT LRFDE=1 D HEAD1^LRAC6 D:LRFDE LRBOT^LRAC6 D:'LRFDE HEAD^LRAC6 S LRFULL=0 G LRSH
|
|
G LRSH
|
|
MUL F I=0:0 Q:LRMULT*(LRSHD+15)>(IOSL-9) S LRMULT=LRMULT+1
|
|
Q
|
|
LRNP ;from LRAC3
|
|
S I=0 F S I=$O(^LAB(64.5,1,1,LRMH,1,LRSH,1,I)) Q:I<1 S LRTOT=LRTOT+$P(^(I,0),U,2) I LRTOT>(IOM-20) S LRPL=LRPL+1,LRTOT=$P(^(0),U,2)
|
|
LRLNS ;from LRAC5
|
|
K LRTM,^TMP($J,"TM") S LRTM=0,LRLNS=((IOSL-18)-($Y+(6*LRPL)))\LRPL,LRCL=(IOM/2)-(5+($L(LRSHN)/2)),LRACT=0,LRJS=0,LRNP=1 W !!?LRCL,"----",LRSHN,"----"
|
|
Q
|
|
MH1 I LRXLR="LRAC"&(LRPERM=0) Q:'$D(^LAC("LGOT",LRDFN,LRMH))
|
|
S LRMHN=$P(X,U,1),LRSH=0
|
|
I '$D(LRPG1) S LRPG=$S($L($P(X,U,2))&LRRE:$P(X,U,2),$D(^LR(LRDFN,"PG",LRMH)):$P(^(LRMH),U,2),1:0) S:'$L($P(X,U,2))!('LRRE) $P(^LAC(LRXLR,LRDFN,1,LRMH,0),U,2)=LRPG S LRPG=LRPG+1
|
|
D TOP^LRAC6 S LROFMT="",LRFDE=0 D LRSH,HEAD1^LRAC6,LRBOT^LRAC6:'LRFDE K LRTM,^TMP($J,"TM") S LRFULL=0,LRTM=0,LROFMT="",LRFDE=0
|
|
Q
|
|
ENT ;from LRAC1,LRACM2
|
|
K ^TMP($J,"K"),LRMISC S LRAG=0,LRYESCOM=0,LRIL=0,LRFULL=0 D LRMH S LRMH="MISC" G PRE^LRAC6
|
|
LRMH S LRMH=0 F S LRMH=$O(^LAC(LRXLR,LRDFN,1,LRMH)) Q:LRMH<1 S X=^(LRMH,0) D MH1
|
|
Q
|
|
UDT ;from LRAC4, LRAC9
|
|
S LRBDT=LRFDT,LRFDT=$S($P(^LAB(64.5,1,1,LRMH,1,LRSH,0),U,3)["I":$P(^LAC(LRXLR,LRDFN,1,LRMH,1,LRSH,1,LRFDT,0),U,1),1:LRFDT),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(^LAC(LRXLR,LRDFN,1,LRMH,1,LRSH,1,LRFDT,"TX")) S LRTM(0)=LRTM(0)+1,LRNX=$C(LRTM(0)),^TMP($J,"TM",LRFDT)=LRNX,LRNXSW=1 S I=0 F S I=$O(^LAC(LRXLR,LRDFN,1,LRMH,1,LRSH,1,LRFDT,"TX",I)) Q:'I S ^TMP($J,"TM",LRFDT,I)=^(I,0)
|
|
;
|
|
;
|
|
Y2KALT ;
|
|
;03/03/1998@14:58:07
|
|
;S:LRNXSW LRUDT=$P(^TMP($J,"TM",LRFDT),U,1)_" "_LRUDT
|
|
;S LRUDT7=$$Y2K^LRX(LRFDT) ;Removed to prevent 4 digit year
|
|
S LRUDT7=$$FMTE^XLFDT(LRFDT,"2Z")
|
|
S LRUDT7=$P(LRUDT7,"@")_" "_$E($P(LRUDT7,"@",2),1,5)
|
|
S LRUDT=$S(LRNXSW:$P(^TMP($J,"TM",LRFDT),U,1)_" ",1:"")_LRUDT7
|
|
;S:LRNXSW LRUDT=$P(^TMP($J,"TM",LRFDT),U,1)_" "_LRUDT7
|
|
;I LRUDT'=LRUDT7 S LRUDT=LRUDT7
|
|
Q
|