- ORWLR ; SLC/KCM,ALB/MJK - Lab Calls ;7/20/96 15:02
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85**;Dec 17, 1997
- ;
- 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
- ORWLR ; SLC/KCM,ALB/MJK - Lab Calls ;7/20/96 15:02
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85**;Dec 17, 1997
- +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 SET (I,C)=0
- FOR
- SET I=$ORDER(^TMP("LRC",$JOB,I))
- IF I'>0
- QUIT
- SET C=C+$LENGTH(^(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
