ORWLR ; SLC/KCM,ALB/MJK - Lab Calls ;7/20/96 15:02
;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,332**;Dec 17, 1997;Build 44
;
LIST(OROOT) ; -- return lists for list boxes
; RPC: ORWLR REPORT LIST
N EOF
S EOF="$$END",OROOT=$NA(^TMP($J,"ORLABLIST"))
K @OROOT
D GETRPTS(.OROOT,.EOF) ; -- get list of reports
D GETDT^ORWRP(.OROOT,.EOF) ; -- get list of date ranges
Q
GETRPTS(OROOT,EOF) ; -- get list of reports
N I,X,Z,Y,RPTDEF
S RPTDEF="^^Y^N^80"
D SETITEM^ORWRP(.OROOT,"[REPORT LIST]")
D GET64^LR7OSUM(.ORLIST)
S X="" F S X=$O(ORLIST(X)) Q:X="" D
. S Y=""
. F I=1:1 S Z=$P(X," ",I) Q:Z="" D
. . S Y=Y_$S($L(Z)>2:$E(Z)_$$LOW^XLFSTR($E(Z,2,999)),1:Z)_" "
. S $P(RPTDEF,U,1)=X,$P(RPTDEF,U,2)=Y
. D SETITEM^ORWRP(.OROOT,RPTDEF)
D SETITEM^ORWRP(.OROOT,.EOF)
Q
RPT(OROOT,DFN,RPTID,DTRANGE,SECTION) ; -- return cum report text
; RPC: ORWLR REPORT TEXT
IF $G(SECTION),$D(^TMP("ORLABDATA",$J,SECTION)) D G RPTQ
. S OROOT=$NA(^TMP("ORLABDATA",$J,SECTION))
N LINES,ORSUB
K ^TMP("ORLABDATA",$J)
D CUMB(DFN,RPTID,DTRANGE)
S LINES=$S($D(^TMP("LRH",$J,RPTID)):+^(RPTID),1:0)
IF LINES<241 D
. S OROOT=$NA(^TMP("LRC",$J))
. S @OROOT@(.001)="1^1"
ELSE D
. S ORSUB="ORLABDATA",OROOT=$NA(^TMP(ORSUB,$J,1))
. D BUILD
RPTQ Q
;
CUMB(DFN,RPTID,DTRANGE) ; -- build tmp global w/cumulative data
N X,X1,IOST,IOM,ORBEG,OREND,ORSBHEAD
K ^TMP("LRC",$J),^TMP("LRH",$J)
S IOST="C-",IOM=80,X1=DT
S X2=-$S(DTRANGE:DTRANGE-1,1:0)
D C^%DTC
S ORBEG=X-.7641,OREND=DT+.2359
IF RPTID'="ALL" D
. S ORSBHEAD=$NA(ORSBHEAD)
. S ORSBHEAD(RPTID)=""
D EN^LR7OSUM(.OROOT,DFN,ORBEG,OREND,"",IOM,.ORSBHEAD)
Q
BUILD ; -- build tmp global for report
N INC,CNT,MAX,SECTION,OROOT,ORI
S SECTION=0,MAX=20000
D INIT^ORWRP
S ORI=0
F S ORI=$O(^TMP("LRC",$J,ORI)) Q:'ORI S X=$G(^(ORI,0)) D
. I (CNT+250)>MAX D INIT^ORWRP
. S INC=INC+1,@OROOT@(INC)=X
. S CNT=CNT+$L(X)
D FINAL^ORWRP
Q
CUM(OROOT,DFN,DAYS,ALPHA,OMEGA) ; Return cumulative report
N I,X,X1,X2,C,LINES,IOST,IOM,ROOT
S ROOT=$$SET^ORWLRR()
S IOST="C-",IOM=80,OROOT=$NA(^TMP("LRC",$J))
K ^TMP("LRC",$J),^TMP("LRH",$J)
Q:'$G(DFN)
I $L($G(DAYS)),'$G(ALPHA) S ALPHA=$$FMADD^XLFDT(DT,-DAYS),OMEGA=$$NOW^XLFDT
Q:'$G(ALPHA) Q:'$G(OMEGA)
I $$REMOTE^ORWLRR(.DFN,.ROOT) D EN^LR7OSUM(.OROOT,DFN,ALPHA,OMEGA)
;S (I,C)=0 F S I=$O(^TMP("LRC",$J,I)) Q:I'>0 S C=C+$L(^(I,0))
S I=0
I $L($O(^TMP("LRH",$J,0))) S I=.001,^TMP("LRC",$J,I)="[HIDDEN TEXT]^" D
. S X="",C=2 F S X=$O(^TMP("LRH",$J,X)) Q:X="" S LINES(^(X))=X,C=C+1
. S $P(^TMP("LRC",$J,.001),"^",2)=C
. S X="" F S X=$O(LINES(X)) Q:X="" D
.. S I=I+.001,^TMP("LRC",$J,I)=X_"^"_LINES(X)
. S I=I+.001,^TMP("LRC",$J,I)="[REPORT TEXT]"
D CLEAN^ORWLRR(.OROOT,ROOT)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWLR 2771 printed Nov 22, 2024@17:46:31 Page 2
ORWLR ; SLC/KCM,ALB/MJK - Lab Calls ;7/20/96 15:02
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,332**;Dec 17, 1997;Build 44
+2 ;
LIST(OROOT) ; -- return lists for list boxes
+1 ; RPC: ORWLR REPORT LIST
+2 NEW EOF
+3 SET EOF="$$END"
SET OROOT=$NAME(^TMP($JOB,"ORLABLIST"))
+4 KILL @OROOT
+5 ; -- get list of reports
DO GETRPTS(.OROOT,.EOF)
+6 ; -- get list of date ranges
DO GETDT^ORWRP(.OROOT,.EOF)
+7 QUIT
GETRPTS(OROOT,EOF) ; -- get list of reports
+1 NEW I,X,Z,Y,RPTDEF
+2 SET RPTDEF="^^Y^N^80"
+3 DO SETITEM^ORWRP(.OROOT,"[REPORT LIST]")
+4 DO GET64^LR7OSUM(.ORLIST)
+5 SET X=""
FOR
SET X=$ORDER(ORLIST(X))
if X=""
QUIT
Begin DoDot:1
+6 SET Y=""
+7 FOR I=1:1
SET Z=$PIECE(X," ",I)
if Z=""
QUIT
Begin DoDot:2
+8 SET Y=Y_$SELECT($LENGTH(Z)>2:$EXTRACT(Z)_$$LOW^XLFSTR($EXTRACT(Z,2,999)),1:Z)_" "
End DoDot:2
+9 SET $PIECE(RPTDEF,U,1)=X
SET $PIECE(RPTDEF,U,2)=Y
+10 DO SETITEM^ORWRP(.OROOT,RPTDEF)
End DoDot:1
+11 DO SETITEM^ORWRP(.OROOT,.EOF)
+12 QUIT
RPT(OROOT,DFN,RPTID,DTRANGE,SECTION) ; -- return cum report text
+1 ; RPC: ORWLR REPORT TEXT
+2 IF $GET(SECTION)
IF $DATA(^TMP("ORLABDATA",$JOB,SECTION))
Begin DoDot:1
+3 SET OROOT=$NAME(^TMP("ORLABDATA",$JOB,SECTION))
End DoDot:1
GOTO RPTQ
+4 NEW LINES,ORSUB
+5 KILL ^TMP("ORLABDATA",$JOB)
+6 DO CUMB(DFN,RPTID,DTRANGE)
+7 SET LINES=$SELECT($DATA(^TMP("LRH",$JOB,RPTID)):+^(RPTID),1:0)
+8 IF LINES<241
Begin DoDot:1
+9 SET OROOT=$NAME(^TMP("LRC",$JOB))
+10 SET @OROOT@(.001)="1^1"
End DoDot:1
+11 IF '$TEST
Begin DoDot:1
+12 SET ORSUB="ORLABDATA"
SET OROOT=$NAME(^TMP(ORSUB,$JOB,1))
+13 DO BUILD
End DoDot:1
RPTQ QUIT
+1 ;
CUMB(DFN,RPTID,DTRANGE) ; -- build tmp global w/cumulative data
+1 NEW X,X1,IOST,IOM,ORBEG,OREND,ORSBHEAD
+2 KILL ^TMP("LRC",$JOB),^TMP("LRH",$JOB)
+3 SET IOST="C-"
SET IOM=80
SET X1=DT
+4 SET X2=-$SELECT(DTRANGE:DTRANGE-1,1:0)
+5 DO C^%DTC
+6 SET ORBEG=X-.7641
SET OREND=DT+.2359
+7 IF RPTID'="ALL"
Begin DoDot:1
+8 SET ORSBHEAD=$NAME(ORSBHEAD)
+9 SET ORSBHEAD(RPTID)=""
End DoDot:1
+10 DO EN^LR7OSUM(.OROOT,DFN,ORBEG,OREND,"",IOM,.ORSBHEAD)
+11 QUIT
BUILD ; -- build tmp global for report
+1 NEW INC,CNT,MAX,SECTION,OROOT,ORI
+2 SET SECTION=0
SET MAX=20000
+3 DO INIT^ORWRP
+4 SET ORI=0
+5 FOR
SET ORI=$ORDER(^TMP("LRC",$JOB,ORI))
if 'ORI
QUIT
SET X=$GET(^(ORI,0))
Begin DoDot:1
+6 IF (CNT+250)>MAX
DO INIT^ORWRP
+7 SET INC=INC+1
SET @OROOT@(INC)=X
+8 SET CNT=CNT+$LENGTH(X)
End DoDot:1
+9 DO FINAL^ORWRP
+10 QUIT
CUM(OROOT,DFN,DAYS,ALPHA,OMEGA) ; Return cumulative report
+1 NEW I,X,X1,X2,C,LINES,IOST,IOM,ROOT
+2 SET ROOT=$$SET^ORWLRR()
+3 SET IOST="C-"
SET IOM=80
SET OROOT=$NAME(^TMP("LRC",$JOB))
+4 KILL ^TMP("LRC",$JOB),^TMP("LRH",$JOB)
+5 if '$GET(DFN)
QUIT
+6 IF $LENGTH($GET(DAYS))
IF '$GET(ALPHA)
SET ALPHA=$$FMADD^XLFDT(DT,-DAYS)
SET OMEGA=$$NOW^XLFDT
+7 if '$GET(ALPHA)
QUIT
if '$GET(OMEGA)
QUIT
+8 IF $$REMOTE^ORWLRR(.DFN,.ROOT)
DO EN^LR7OSUM(.OROOT,DFN,ALPHA,OMEGA)
+9 ;S (I,C)=0 F S I=$O(^TMP("LRC",$J,I)) Q:I'>0 S C=C+$L(^(I,0))
+10 SET I=0
+11 IF $LENGTH($ORDER(^TMP("LRH",$JOB,0)))
SET I=.001
SET ^TMP("LRC",$JOB,I)="[HIDDEN TEXT]^"
Begin DoDot:1
+12 SET X=""
SET C=2
FOR
SET X=$ORDER(^TMP("LRH",$JOB,X))
if X=""
QUIT
SET LINES(^(X))=X
SET C=C+1
+13 SET $PIECE(^TMP("LRC",$JOB,.001),"^",2)=C
+14 SET X=""
FOR
SET X=$ORDER(LINES(X))
if X=""
QUIT
Begin DoDot:2
+15 SET I=I+.001
SET ^TMP("LRC",$JOB,I)=X_"^"_LINES(X)
End DoDot:2
+16 SET I=I+.001
SET ^TMP("LRC",$JOB,I)="[REPORT TEXT]"
End DoDot:1
+17 DO CLEAN^ORWLRR(.OROOT,ROOT)
+18 QUIT
