ORCXPND3 ; SLC/MKB,dcm - Expanded display of Reports ;08/31/09 09:35
;;3.0;ORDER ENTRY/RESULTS REPORTING;**25,30,43,85,172,243,280,527**;Dec 17, 1997;Build 19
;
AP ; -- Retrieve AP results for a specific date/time specimen taken
; [alert follow-up, from LABS^ORCXPND1]
N ORLRSS,ORDTSTKN S ORLRSS=$P($G(XQADATA),U),ORDTSTKN=$P($G(XQADATA),U,3)
I ORLRSS?1(1"SP",1"CY",1"EM",1"AU"),ORDTSTKN'="" D
. N ORLRDFN S ORLRDFN=$$LRDFN^LR7OR1(DFN) ;DBIA/ICR #2503
. K ^TMP("ORAP",$J) D EN^LR7OSAP4("^TMP(""ORAP"",$J)",ORLRDFN,ORLRSS,ORDTSTKN)
. I '$O(^TMP("ORAP",$J,0)) S ^TMP("ORAP",$J,1,0)="",^TMP("ORAP",$J,2,0)="No Anatomic Pathology report available..."
. N I S I=0 F S I=$O(^TMP("ORAP",$J,I)) Q:I<1 S X=^(I,0),LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X
. K ^TMP("ORAP",$J)
Q
;
LRA ; -- Anatomic Pathology Report
N DFN,Y,I,LRLLOC,LRQ
D TIT^ORCXPNDR("Anatomic Path Report") Q:$$OS^ORCXPNDR()
D PREP^ORCXPNDR
D RPT^ORWRP(.Y,ID,3)
D ITEM^ORCXPND("Anatomic Path Report")
S I=3 F S I=$O(^TMP("ORDATA",$J,1,I)) Q:I<1 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=^TMP("ORDATA",$J,1,I)
K ^TMP("ORDATA",$J)
Q
;
LRAA ; -- Alternate Anatomic Path Report
N DFN,Y,I,LRLLOC,LRQ
D TIT^ORCXPNDR("Alternate Anatomic Path Report") Q:$$OS^ORCXPNDR()
D PREP^ORCXPNDR I $$OS^ORCXPNDR() Q
D AP^LR7OSUM(ID)
D ITEM^ORCXPND("Anatomic Pathology Report")
I '$O(^TMP("LRC",$J,0)) S ^TMP("LRC",$J,1,0)="No Anatomic Pathology reports available..."
S I=0 F S I=$O(^TMP("LRC",$J,I)) Q:I<1 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=^TMP("LRC",$J,I,0)
K ^TMP("LRC",$J)
Q
;
LRB1 ; -- Blood Bank Report
N DFN,Y,I,LRBLOOD,LRCAPA,LRDT0,LRLABKY,LRLLOC,LRO,LRPCEVSO,LRPLASMA,LRSERUM,LRT,LRUNKNOW,LRURINE,LRVIDO,LRVIDOF
D TIT^ORCXPNDR("Blood Bank Report") Q:$$OS^ORCXPNDR()
D PREP^ORCXPNDR
D RPT^ORWRP(.Y,ID,2)
D ITEM^ORCXPND("Blood Bank Report")
S I=5 F S I=$O(^TMP("ORDATA",$J,1,I)) Q:I<1 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=^TMP("ORDATA",$J,1,I)
K ^TMP("ORDATA",$J)
Q
;
LRB ; -- A better Blood Bank Report
N DFN,ORY,I,SUBHEAD
D TIT^ORCXPNDR("Blood Bank Report")
S DFN=ID
D PREP^ORCXPNDR
I $$GET^XPAR("DIV^SYS^PKG","OR VBECS ON",1,"Q"),$L($T(EN^ORWLR1)),$L($T(CPRS^VBECA3B)) D Q ;Transition to VBEC's interface
. K ^TMP("ORLRC",$J)
. ;D EN^ORWLR1(DFN) ;RLM
. D EN^VBECRPT ;RLM
. I '$O(^TMP("ORLRC",$J,0)) S ^TMP("ORLRC",$J,1,0)="",^TMP("ORLRC",$J,2,0)="No Blood Bank report available..."
. D ITEM^ORCXPND("Blood Bank Report"),BLANK^ORCXPND
. S I=0 F S I=$O(^TMP("ORLRC",$J,I)) Q:I'>0 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=^TMP("ORLRC",$J,I,0)
. K ^TMP("ORLRC",$J)
S SUBHEAD("BLOOD BANK")=""
D EN^LR7OSUM(.ORY,DFN,,,,,.SUBHEAD)
I '$O(^TMP("LRC",$J,0)) S ^TMP("LRC",$J,1,0)="No Blood Bank report available..."
D ITEM^ORCXPND("Blood Bank Report"),BLANK^ORCXPND
S I=0 F S I=$O(^TMP("LRC",$J,I)) Q:I'>0 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=^TMP("LRC",$J,I,0)
K ^TMP("LRC",$J),^TMP("LRH",$J)
Q
;
LRC ; -- Lab Cumulative
N DFN,ORY,I,BEG,END,OREND,ORSSTRT,ORSSTOP
D TIT^ORCXPNDR("Lab Cumulative")
S DFN=ID
D RANGE($S($G(ORWARD):7,1:180)) Q:OREND S BEG=+ORSSTRT,END=+ORSSTOP
D PREP^ORCXPNDR
D EN^LR7OSUM(.ORY,DFN,BEG,END)
D ITEM^ORCXPND("Lab Cumulative"),BLANK^ORCXPND
S I=0 F S I=$O(^TMP("LRC",$J,I)) Q:I'>0 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=^TMP("LRC",$J,I,0)
K ^TMP("LRC",$J),^TMP("LRH",$J)
Q
;
LRG ; -- Graph Lab Tests
N DFN,Y,I,X,BCNT,LRSS,LRCW,LRFLAG,LRCTRL,LRNSET,N,LOW,LRPCEVSO,LRPRAC,LRRB,LRTREA,LRVIDO,LRVIDOF,OREND,ORSSTRT,ORSSTOP
D TIT^ORCXPNDR("Graph Lab Tests") Q:$$OS^ORCXPNDR()
D RANGE($S($G(ORWARD):7,1:180)) Q:OREND
S LRSS="CH",LRCW=8,LRFLAG="",LRCTRL=0,(LRNSET,N)=80
D L2^LRDIST4 Q:'$D(LRTEST)
D PREP^ORCXPNDR
D RPT^ORWRP(.Y,ID,8,,,,+ORSSTRT,+ORSSTOP)
D ITEM^ORCXPND("Lab Graph")
S I=4,BCNT=0
F S I=$O(^TMP("ORDATA",$J,1,I)) Q:I<1 S X=^(I) D
. I '$L(X) S BCNT=BCNT+1 I BCNT>1 Q
. S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X S:$L(X) BCNT=0
K ^TMP("ORDATA",$J)
Q
;
LRI ; -- Interim Lab Results
N ORX,DFN,Y,I,X,BCNT,LREDT,LRIDT,LRLLT,LRPCEVSO,LRPRAC,LRRB,LRTREA,LRVIDO,LRVIDOF,OREND,ORSSTRT,ORSSTOP
D TIT^ORCXPNDR("Lab Interim Results") Q:$$OS^ORCXPNDR()
D RANGE($S($G(ORWARD):7,1:180)) Q:OREND
D SET^LRRP4
D PREP^ORCXPNDR
D RPT^ORWRP(.Y,ID,3,,,,+ORSSTRT,+ORSSTOP)
D ITEM^ORCXPND("Lab Interim Report")
S I=0,BCNT=0
F S I=$O(^TMP("ORDATA",$J,1,I)) Q:I<1 S X=^(I) D
. I '$L(X) S BCNT=BCNT+1 I BCNT>1 Q
. S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X S:$L(X) BCNT=0
K ^TMP("ORDATA",$J)
Q
;
LRGEN ;Lab Results by Test
N DFN,Y,I,II,X,BCNT,LRPRETTY,LREDT,LRLLT,LRPCEVSO,LRPRAC,LRRB,LRTREA,LRVIDO,LRVIDOF,LRCW,LREND,LRTP,LRIX,LRWPL,LRIDT,LRSC,DIC,LRTSTS,LRORD,LRTEST,LRSUB,LRHDR,LRSSP,LRHI,LRLO
N LBL,LRBLOOD,LRDAT,LRDFN,LRDPF,LRDT0,LREX,LRFFLG,LRFOOT,LRLAB,LRLABKY,LRND,LRNG,LRNOP,LRNOTE,LRODT0,LRONESPC,LRONETST,LRPAGE,LRPARAM,LRPLASMA,LRPP,LRSERUM,LRPS,LRTN,LRUNKNOW,LRURINE,LRWRD,LRX,LRY
N AGE,I,INC,LRIDT1,LRSV,OREND,ORSSTRT,ORSSTOP
K ^TMP("LR",$J)
D TIT^ORCXPNDR("Lab Results by Test") Q:$$OS^ORCXPNDR()
D RANGE($S($G(ORWARD):7,1:180)) Q:OREND
D SET^LRGEN
Q:LREND!'LRTSTS
D PREP^ORCXPNDR
D RPT^ORWRP(.Y,ID,16,,,,+ORSSTRT,+ORSSTOP)
D ITEM^ORCXPND("Lab Results by Test")
S I=1,BCNT=0
F S I=$O(^TMP("ORDATA",$J,1,I)) Q:I<1 S X=^(I) D
. I '$L(X) S BCNT=BCNT+1 I BCNT>1 Q
. S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X S:$L(X) BCNT=0
K ^TMP("ORDATA",$J)
Q
;
STAT ; -- Lab test status
N DFN,Y,I,X,BCNT,OREND,ORSSTRT,ORSSTOP
D TIT^ORCXPNDR("Lab Test Status") Q:$$OS^ORCXPNDR()
D RANGE($S($G(ORWARD):7,1:180)) Q:$G(OREND)
D PREP^ORCXPNDR
D RPT^ORWRP(.Y,ID,9,,,,+ORSSTRT,+ORSSTOP)
D ITEM^ORCXPND("Lab Test Status")
S I=0,BCNT=0
F S I=$O(^TMP("ORDATA",$J,1,I)) Q:I<1 S X=$S($D(^(I))#2:^(I),$D(^(I,0))#2:^(0),1:"") D
. I '$L(X) S BCNT=BCNT+1 I BCNT>1 Q
. S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X S:$L(X) BCNT=0
K ^TMP("ORDATA",$J)
Q
;
RANGE(BEG) ;Get date range for report
;BEG=# of days (T-BEG) for start default
;Output: ORSSTRT=Start date/time
; ORSSTOP=Stop date/time
; OREND=1 if user '^'s out, so look for it!
S BEG=$$FMADD^XLFDT(DT,-$G(BEG)),END=$$NOW^XLFDT
D RANGE^ORPRS01(BEG,END)
Q
;
MED(MED) ; -- Medicine Summary of Patient Procedures
N DFN,Y,I,X,BCNT,OREND,PROCID
D TIT^ORCXPNDR("Summary of Patient Procedures") Q:$$OS^ORCXPNDR()
D PREP^ORCXPNDR
S DFN=+ID,PROCID=$P(MED,"~",2)
D RPT^ORWRP(.Y,DFN,19,,,PROCID)
D ITEM^ORCXPND("Summary of Patient Procedures")
S I=4,BCNT=0
F S I=$O(^TMP("ORDATA",$J,1,I)) Q:I<1 S X=^(I) D
. I '$L(X) S BCNT=BCNT+1 I BCNT>1 Q
. I $E(X,1,4)="Pg. " Q
. I X["PHYSICIANS' SIGNATURE" Q
. S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X S:$L(X) BCNT=0
K ^TMP("ORDATA",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCXPND3 6799 printed Jan 18, 2025@03:30:20 Page 2
ORCXPND3 ; SLC/MKB,dcm - Expanded display of Reports ;08/31/09 09:35
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**25,30,43,85,172,243,280,527**;Dec 17, 1997;Build 19
+2 ;
AP ; -- Retrieve AP results for a specific date/time specimen taken
+1 ; [alert follow-up, from LABS^ORCXPND1]
+2 NEW ORLRSS,ORDTSTKN
SET ORLRSS=$PIECE($GET(XQADATA),U)
SET ORDTSTKN=$PIECE($GET(XQADATA),U,3)
+3 IF ORLRSS?1(1"SP",1"CY",1"EM",1"AU")
IF ORDTSTKN'=""
Begin DoDot:1
+4 ;DBIA/ICR #2503
NEW ORLRDFN
SET ORLRDFN=$$LRDFN^LR7OR1(DFN)
+5 KILL ^TMP("ORAP",$JOB)
DO EN^LR7OSAP4("^TMP(""ORAP"",$J)",ORLRDFN,ORLRSS,ORDTSTKN)
+6 IF '$ORDER(^TMP("ORAP",$JOB,0))
SET ^TMP("ORAP",$JOB,1,0)=""
SET ^TMP("ORAP",$JOB,2,0)="No Anatomic Pathology report available..."
+7 NEW I
SET I=0
FOR
SET I=$ORDER(^TMP("ORAP",$JOB,I))
if I<1
QUIT
SET X=^(I,0)
SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)=X
+8 KILL ^TMP("ORAP",$JOB)
End DoDot:1
+9 QUIT
+10 ;
LRA ; -- Anatomic Pathology Report
+1 NEW DFN,Y,I,LRLLOC,LRQ
+2 DO TIT^ORCXPNDR("Anatomic Path Report")
if $$OS^ORCXPNDR()
QUIT
+3 DO PREP^ORCXPNDR
+4 DO RPT^ORWRP(.Y,ID,3)
+5 DO ITEM^ORCXPND("Anatomic Path Report")
+6 SET I=3
FOR
SET I=$ORDER(^TMP("ORDATA",$JOB,1,I))
if I<1
QUIT
SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)=^TMP("ORDATA",$JOB,1,I)
+7 KILL ^TMP("ORDATA",$JOB)
+8 QUIT
+9 ;
LRAA ; -- Alternate Anatomic Path Report
+1 NEW DFN,Y,I,LRLLOC,LRQ
+2 DO TIT^ORCXPNDR("Alternate Anatomic Path Report")
if $$OS^ORCXPNDR()
QUIT
+3 DO PREP^ORCXPNDR
IF $$OS^ORCXPNDR()
QUIT
+4 DO AP^LR7OSUM(ID)
+5 DO ITEM^ORCXPND("Anatomic Pathology Report")
+6 IF '$ORDER(^TMP("LRC",$JOB,0))
SET ^TMP("LRC",$JOB,1,0)="No Anatomic Pathology reports available..."
+7 SET I=0
FOR
SET I=$ORDER(^TMP("LRC",$JOB,I))
if I<1
QUIT
SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)=^TMP("LRC",$JOB,I,0)
+8 KILL ^TMP("LRC",$JOB)
+9 QUIT
+10 ;
LRB1 ; -- Blood Bank Report
+1 NEW DFN,Y,I,LRBLOOD,LRCAPA,LRDT0,LRLABKY,LRLLOC,LRO,LRPCEVSO,LRPLASMA,LRSERUM,LRT,LRUNKNOW,LRURINE,LRVIDO,LRVIDOF
+2 DO TIT^ORCXPNDR("Blood Bank Report")
if $$OS^ORCXPNDR()
QUIT
+3 DO PREP^ORCXPNDR
+4 DO RPT^ORWRP(.Y,ID,2)
+5 DO ITEM^ORCXPND("Blood Bank Report")
+6 SET I=5
FOR
SET I=$ORDER(^TMP("ORDATA",$JOB,1,I))
if I<1
QUIT
SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)=^TMP("ORDATA",$JOB,1,I)
+7 KILL ^TMP("ORDATA",$JOB)
+8 QUIT
+9 ;
LRB ; -- A better Blood Bank Report
+1 NEW DFN,ORY,I,SUBHEAD
+2 DO TIT^ORCXPNDR("Blood Bank Report")
+3 SET DFN=ID
+4 DO PREP^ORCXPNDR
+5 ;Transition to VBEC's interface
IF $$GET^XPAR("DIV^SYS^PKG","OR VBECS ON",1,"Q")
IF $LENGTH($TEXT(EN^ORWLR1))
IF $LENGTH($TEXT(CPRS^VBECA3B))
Begin DoDot:1
+6 KILL ^TMP("ORLRC",$JOB)
+7 ;D EN^ORWLR1(DFN) ;RLM
+8 ;RLM
DO EN^VBECRPT
+9 IF '$ORDER(^TMP("ORLRC",$JOB,0))
SET ^TMP("ORLRC",$JOB,1,0)=""
SET ^TMP("ORLRC",$JOB,2,0)="No Blood Bank report available..."
+10 DO ITEM^ORCXPND("Blood Bank Report")
DO BLANK^ORCXPND
+11 SET I=0
FOR
SET I=$ORDER(^TMP("ORLRC",$JOB,I))
if I'>0
QUIT
SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)=^TMP("ORLRC",$JOB,I,0)
+12 KILL ^TMP("ORLRC",$JOB)
End DoDot:1
QUIT
+13 SET SUBHEAD("BLOOD BANK")=""
+14 DO EN^LR7OSUM(.ORY,DFN,,,,,.SUBHEAD)
+15 IF '$ORDER(^TMP("LRC",$JOB,0))
SET ^TMP("LRC",$JOB,1,0)="No Blood Bank report available..."
+16 DO ITEM^ORCXPND("Blood Bank Report")
DO BLANK^ORCXPND
+17 SET I=0
FOR
SET I=$ORDER(^TMP("LRC",$JOB,I))
if I'>0
QUIT
SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)=^TMP("LRC",$JOB,I,0)
+18 KILL ^TMP("LRC",$JOB),^TMP("LRH",$JOB)
+19 QUIT
+20 ;
LRC ; -- Lab Cumulative
+1 NEW DFN,ORY,I,BEG,END,OREND,ORSSTRT,ORSSTOP
+2 DO TIT^ORCXPNDR("Lab Cumulative")
+3 SET DFN=ID
+4 DO RANGE($SELECT($GET(ORWARD):7,1:180))
if OREND
QUIT
SET BEG=+ORSSTRT
SET END=+ORSSTOP
+5 DO PREP^ORCXPNDR
+6 DO EN^LR7OSUM(.ORY,DFN,BEG,END)
+7 DO ITEM^ORCXPND("Lab Cumulative")
DO BLANK^ORCXPND
+8 SET I=0
FOR
SET I=$ORDER(^TMP("LRC",$JOB,I))
if I'>0
QUIT
SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)=^TMP("LRC",$JOB,I,0)
+9 KILL ^TMP("LRC",$JOB),^TMP("LRH",$JOB)
+10 QUIT
+11 ;
LRG ; -- Graph Lab Tests
+1 NEW DFN,Y,I,X,BCNT,LRSS,LRCW,LRFLAG,LRCTRL,LRNSET,N,LOW,LRPCEVSO,LRPRAC,LRRB,LRTREA,LRVIDO,LRVIDOF,OREND,ORSSTRT,ORSSTOP
+2 DO TIT^ORCXPNDR("Graph Lab Tests")
if $$OS^ORCXPNDR()
QUIT
+3 DO RANGE($SELECT($GET(ORWARD):7,1:180))
if OREND
QUIT
+4 SET LRSS="CH"
SET LRCW=8
SET LRFLAG=""
SET LRCTRL=0
SET (LRNSET,N)=80
+5 DO L2^LRDIST4
if '$DATA(LRTEST)
QUIT
+6 DO PREP^ORCXPNDR
+7 DO RPT^ORWRP(.Y,ID,8,,,,+ORSSTRT,+ORSSTOP)
+8 DO ITEM^ORCXPND("Lab Graph")
+9 SET I=4
SET BCNT=0
+10 FOR
SET I=$ORDER(^TMP("ORDATA",$JOB,1,I))
if I<1
QUIT
SET X=^(I)
Begin DoDot:1
+11 IF '$LENGTH(X)
SET BCNT=BCNT+1
IF BCNT>1
QUIT
+12 SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)=X
if $LENGTH(X)
SET BCNT=0
End DoDot:1
+13 KILL ^TMP("ORDATA",$JOB)
+14 QUIT
+15 ;
LRI ; -- Interim Lab Results
+1 NEW ORX,DFN,Y,I,X,BCNT,LREDT,LRIDT,LRLLT,LRPCEVSO,LRPRAC,LRRB,LRTREA,LRVIDO,LRVIDOF,OREND,ORSSTRT,ORSSTOP
+2 DO TIT^ORCXPNDR("Lab Interim Results")
if $$OS^ORCXPNDR()
QUIT
+3 DO RANGE($SELECT($GET(ORWARD):7,1:180))
if OREND
QUIT
+4 DO SET^LRRP4
+5 DO PREP^ORCXPNDR
+6 DO RPT^ORWRP(.Y,ID,3,,,,+ORSSTRT,+ORSSTOP)
+7 DO ITEM^ORCXPND("Lab Interim Report")
+8 SET I=0
SET BCNT=0
+9 FOR
SET I=$ORDER(^TMP("ORDATA",$JOB,1,I))
if I<1
QUIT
SET X=^(I)
Begin DoDot:1
+10 IF '$LENGTH(X)
SET BCNT=BCNT+1
IF BCNT>1
QUIT
+11 SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)=X
if $LENGTH(X)
SET BCNT=0
End DoDot:1
+12 KILL ^TMP("ORDATA",$JOB)
+13 QUIT
+14 ;
LRGEN ;Lab Results by Test
+1 NEW DFN,Y,I,II,X,BCNT,LRPRETTY,LREDT,LRLLT,LRPCEVSO,LRPRAC,LRRB,LRTREA,LRVIDO,LRVIDOF,LRCW,LREND,LRTP,LRIX,LRWPL,LRIDT,LRSC,DIC,LRTSTS,LRORD,LRTEST,LRSUB,LRHDR,LRSSP,LRHI,LRLO
+2 NEW LBL,LRBLOOD,LRDAT,LRDFN,LRDPF,LRDT0,LREX,LRFFLG,LRFOOT,LRLAB,LRLABKY,LRND,LRNG,LRNOP,LRNOTE,LRODT0,LRONESPC,LRONETST,LRPAGE,LRPARAM,LRPLASMA,LRPP,LRSERUM,LRPS,LRTN,LRUNKNOW,LRURINE,LRWRD,LRX,LRY
+3 NEW AGE,I,INC,LRIDT1,LRSV,OREND,ORSSTRT,ORSSTOP
+4 KILL ^TMP("LR",$JOB)
+5 DO TIT^ORCXPNDR("Lab Results by Test")
if $$OS^ORCXPNDR()
QUIT
+6 DO RANGE($SELECT($GET(ORWARD):7,1:180))
if OREND
QUIT
+7 DO SET^LRGEN
+8 if LREND!'LRTSTS
QUIT
+9 DO PREP^ORCXPNDR
+10 DO RPT^ORWRP(.Y,ID,16,,,,+ORSSTRT,+ORSSTOP)
+11 DO ITEM^ORCXPND("Lab Results by Test")
+12 SET I=1
SET BCNT=0
+13 FOR
SET I=$ORDER(^TMP("ORDATA",$JOB,1,I))
if I<1
QUIT
SET X=^(I)
Begin DoDot:1
+14 IF '$LENGTH(X)
SET BCNT=BCNT+1
IF BCNT>1
QUIT
+15 SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)=X
if $LENGTH(X)
SET BCNT=0
End DoDot:1
+16 KILL ^TMP("ORDATA",$JOB)
+17 QUIT
+18 ;
STAT ; -- Lab test status
+1 NEW DFN,Y,I,X,BCNT,OREND,ORSSTRT,ORSSTOP
+2 DO TIT^ORCXPNDR("Lab Test Status")
if $$OS^ORCXPNDR()
QUIT
+3 DO RANGE($SELECT($GET(ORWARD):7,1:180))
if $GET(OREND)
QUIT
+4 DO PREP^ORCXPNDR
+5 DO RPT^ORWRP(.Y,ID,9,,,,+ORSSTRT,+ORSSTOP)
+6 DO ITEM^ORCXPND("Lab Test Status")
+7 SET I=0
SET BCNT=0
+8 FOR
SET I=$ORDER(^TMP("ORDATA",$JOB,1,I))
if I<1
QUIT
SET X=$SELECT($DATA(^(I))#2:^(I),$DATA(^(I,0))#2:^(0),1:"")
Begin DoDot:1
+9 IF '$LENGTH(X)
SET BCNT=BCNT+1
IF BCNT>1
QUIT
+10 SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)=X
if $LENGTH(X)
SET BCNT=0
End DoDot:1
+11 KILL ^TMP("ORDATA",$JOB)
+12 QUIT
+13 ;
RANGE(BEG) ;Get date range for report
+1 ;BEG=# of days (T-BEG) for start default
+2 ;Output: ORSSTRT=Start date/time
+3 ; ORSSTOP=Stop date/time
+4 ; OREND=1 if user '^'s out, so look for it!
+5 SET BEG=$$FMADD^XLFDT(DT,-$GET(BEG))
SET END=$$NOW^XLFDT
+6 DO RANGE^ORPRS01(BEG,END)
+7 QUIT
+8 ;
MED(MED) ; -- Medicine Summary of Patient Procedures
+1 NEW DFN,Y,I,X,BCNT,OREND,PROCID
+2 DO TIT^ORCXPNDR("Summary of Patient Procedures")
if $$OS^ORCXPNDR()
QUIT
+3 DO PREP^ORCXPNDR
+4 SET DFN=+ID
SET PROCID=$PIECE(MED,"~",2)
+5 DO RPT^ORWRP(.Y,DFN,19,,,PROCID)
+6 DO ITEM^ORCXPND("Summary of Patient Procedures")
+7 SET I=4
SET BCNT=0
+8 FOR
SET I=$ORDER(^TMP("ORDATA",$JOB,1,I))
if I<1
QUIT
SET X=^(I)
Begin DoDot:1
+9 IF '$LENGTH(X)
SET BCNT=BCNT+1
IF BCNT>1
QUIT
+10 IF $EXTRACT(X,1,4)="Pg. "
QUIT
+11 IF X["PHYSICIANS' SIGNATURE"
QUIT
+12 SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)=X
if $LENGTH(X)
SET BCNT=0
End DoDot:1
+13 KILL ^TMP("ORDATA",$JOB)
+14 QUIT
