ORCXPNDR ; SLC/MKB,dcm - Expanded display of Reports ;2/12/97 13:48
;;3.0;ORDER ENTRY/RESULTS REPORTING;**25,85,215**;Dec 17, 1997
EN ; -- build body of report
N TYPE S TYPE=$P($G(^TMP("OR",$J,ORTAB,"IDX",NUM)),U,4)
I '$L(TYPE)!(+TYPE) D XRAYS^ORCXPND1 Q ;TYPE=case# or null
I $L(TYPE),$E(TYPE,1,4)="MED~" D MED(TYPE) Q ;TYPE=MED~procedure ID
I $L($T(@TYPE)) D @TYPE
Q
PREP ;
W !," ... hold on...building report..."
K ^TMP("ORDATA",$J)
Q
DAYS(NUM) ;
;NUM=# of days (default=7)
;Returns -1 if user aborts, otherwise # of days entered.
D1 N X
S:'$G(NUM) NUM=7
W !,"Enter # of days to look back: "_NUM_"// " R X:DTIME Q:$E(X)="^" -1
S:X="" X=NUM S:X?1"T-"1N.N X=$E(X,3,99)
I $E(X)="?"!(X'?1N.N) W !,"Enter the number of days to look back for data." G D1
Q X
TIT(HDR) ;
;HDR=name of header to display
S:'$D(HDR) HDR=""
D FULL^VALM1 S VALMBCK="R"
W !!,"For "_HDR
Q
;
GMTSS ; -- Health Summary
N DFN,Y,I,DIC,X,GMTYP
D TIT("Health Summary") Q:$$OS()
D SELTYP^ORPRS13 I '$G(GMTYP(1)) Q
D PREP
D RPT^ORWRP(.Y,ID,1,+GMTYP(1))
D ITEM^ORCXPND("Health Summary")
S I=1 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
;
GMTSA ; -- Ad Hoc Health Summary
N DFN,Y,I,DIC,X,GMTSTYP,GMTSTITL,GMTSQIT
D TIT("Adhoc Health Summary") Q:$$OS()
S X="GMTS HS ADHOC",DIC=142,DIZ(0)="ZF" D ^DIC Q:Y'>0 S GMTSTYP=+Y
S GMTSTITL="AD HOC" D BUILD^GMTSADOR
Q:$D(GMTSQIT)
D PREP
D RPT^ORWRP(.Y,ID,15,GMTSTYP)
D ITEM^ORCXPND("Adhoc Health Summary")
S I=1 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
;
GMRVC ; -- Vitals Cumulative Report
N DFN,Y,I,X,BCNT
D TIT("Vitals Cumulative Report") Q:$$OS()
S X=$$DAYS(7) Q:X=-1
D PREP
D RPT^ORWRP(.Y,ID,5,,X,"VITCUM")
D ITEM^ORCXPND("Vitals Cumulative Report")
S I=3,BCNT=0
F S I=$O(^TMP("ORDATA",$J,1,I)) Q:I<1 S X=^(I) D Q:X["No cumulative vitals data for this patient"
. 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
FHP ; -- Dietetics profile
N X,I S X=$$P^FHWOR71(+ORVP)
D ITEM^ORCXPND("Dietetics Profile"),BLANK^ORCXPND
I +X'>0 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=$P(X,U,2) Q ; no rpt
S I=0 F S I=$O(^TMP($J,"FHPROF",+ORVP,I)) Q:I'>0 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=^TMP($J,"FHPROF",+ORVP,I)
K ^TMP($J,"FHPROF",+ORVP)
Q
;
FHA ; -- Nurtritional Assessments
N X,I S ID=$P(ID,";",2),X=$$FHWORASM^FHWORA(+ORVP,ID)
D ITEM^ORCXPND("Nutritional Assessment on "_ID),BLANK^ORCXPND
I X'>0 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=$P(X,U,2) Q ; no rpt
S I=0 F S I=$O(^TMP($J,"FHASM",+ORVP,I)) Q:I'>0 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=^TMP($J,"FHASM",+ORVP,I)
K ^TMP($J,"FHASM",+ORVP)
Q
;
ORS ; -- Daily Order Summary
N DFN,Y,I,BCNT
D TIT("Daily Order Summary") Q:$$OS()
D PREP
D RPT^ORWRP(.Y,ID,10,,1)
D ITEM^ORCXPND("Daily Order Summary")
S I=3,BCNT=0
F S I=$O(^TMP("ORDATA",$J,1,I)) Q:I<1 S X=^(I) D Q:X["* END OF ORDERS *"
. 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
;
ORD ; -- Order Summary for Date Range
N DFN,Y,I,BCNT,OREND,ORSSTRT,ORSSTOP
D TIT("Order summary for Date Range") Q:$$OS()
D RANGE^ORCXPND3($S($G(ORWARD):7,1:180)) Q:OREND
D PREP
D RPT^ORWRP(.Y,ID,11,,,,+ORSSTRT,+ORSSTOP)
D ITEM^ORCXPND("Order Summary for Date Range")
S I=3,BCNT=0
F S I=$O(^TMP("ORDATA",$J,1,I)) Q:I<1 S X=^(I) D Q:X["* END OF ORDERS *"
. 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
ORC ; -- Customized order summary
N DFN,Y,I,BCNT,ORDG,ORPRES,ORSSTRT,ORSSTOP,OREND
D TIT("Custom Order Summary") Q:$$OS()
D RANGE^ORCXPND3($S($G(ORWARD):7,1:180)) Q:OREND
D CUSTOM^ORPRS01 Q:$G(OREND)
D PREP
D RPT^ORWRP(.Y,ID,14,,,,+ORSSTRT,+ORSSTOP)
D ITEM^ORCXPND("Custom order summary")
S I=3,BCNT=0
F S I=$O(^TMP("ORDATA",$J,1,I)) Q:I<1 S X=^(I) D Q:X["* END OF ORDERS *"
. 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
ORP ; -- Print Chart Copy Summary
N DFN,Y,I,BCNT,ORSSTRT,ORSSTOP,OREND
D TIT("Chart Copy Summary") Q:$$OS()
D RANGE^ORCXPND3($S($G(ORWARD):7,1:180)) Q:OREND
D PREP
D RPT^ORWRP(.Y,ID,12,,,,+ORSSTRT,+ORSSTOP)
D ITEM^ORCXPND("Chart Copy Summary")
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
PSO ; -- Outpatient Pharmacy Action Profile
N DFN,Y,I,BCNT
D TIT("Outpatient Pharmacy Action Profile") Q:$$OS()
D PREP
D RPT^ORWRP(.Y,ID,13)
D ITEM^ORCXPND("Outpatient Pharmacy Action Profile")
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
OS() ; Check OS- Temporary disabled for OpenM
Q 0 ;Open M check disabled - remove if Wally's fix fixed.
I $G(^%ZOSF("OS"))["OpenM" W !!,$C(7),"This report is currently unavailable from this menu.",!,"Please use 'OR Other Reports ...' to get this report." D READ^ORUTL
Q $G(^%ZOSF("OS"))["OpenM"
LRA ;AP Report
D LRA^ORCXPND3
Q
LRAA ;AP Report (alt)
D LRAA^ORCXPND3
Q
LRB1 ;BB Report
D LRB1^ORCXPND3
Q
LRB ;BB Report (alt)
D LRB^ORCXPND3
Q
LRC ;Lab cumulative
D LRC^ORCXPND3
Q
LRG ;Lab Graph
D LRG^ORCXPND3
Q
LRI ;Lab Interim by Day
D LRI^ORCXPND3
Q
LRGEN ;Lab results by test
D LRGEN^ORCXPND3
Q
STAT ;Lab order status
D STAT^ORCXPND3
Q
MED(TYPE) ;Medicine Patient Procedure Summary
D MED^ORCXPND3(TYPE)
Q
ORCXPNDR ; SLC/MKB,dcm - Expanded display of Reports ;2/12/97 13:48
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**25,85,215**;Dec 17, 1997
EN ; -- build body of report
+1 NEW TYPE
SET TYPE=$PIECE($GET(^TMP("OR",$JOB,ORTAB,"IDX",NUM)),U,4)
+2 ;TYPE=case# or null
IF '$LENGTH(TYPE)!(+TYPE)
DO XRAYS^ORCXPND1
QUIT
+3 ;TYPE=MED~procedure ID
IF $LENGTH(TYPE)
IF $EXTRACT(TYPE,1,4)="MED~"
DO MED(TYPE)
QUIT
+4 IF $LENGTH($TEXT(@TYPE))
DO @TYPE
+5 QUIT
PREP ;
+1 WRITE !," ... hold on...building report..."
+2 KILL ^TMP("ORDATA",$JOB)
+3 QUIT
DAYS(NUM) ;
+1 ;NUM=# of days (default=7)
+2 ;Returns -1 if user aborts, otherwise # of days entered.
D1 NEW X
+1 IF '$GET(NUM)
SET NUM=7
+2 WRITE !,"Enter # of days to look back: "_NUM_"// "
READ X:DTIME
IF $EXTRACT(X)="^"
QUIT -1
+3 IF X=""
SET X=NUM
IF X?1"T-"1N.N
SET X=$EXTRACT(X,3,99)
+4 IF $EXTRACT(X)="?"!(X'?1N.N)
WRITE !,"Enter the number of days to look back for data."
GOTO D1
+5 QUIT X
TIT(HDR) ;
+1 ;HDR=name of header to display
+2 IF '$DATA(HDR)
SET HDR=""
+3 DO FULL^VALM1
SET VALMBCK="R"
+4 WRITE !!,"For "_HDR
+5 QUIT
+6 ;
GMTSS ; -- Health Summary
+1 NEW DFN,Y,I,DIC,X,GMTYP
+2 DO TIT("Health Summary")
IF $$OS()
QUIT
+3 DO SELTYP^ORPRS13
IF '$GET(GMTYP(1))
QUIT
+4 DO PREP
+5 DO RPT^ORWRP(.Y,ID,1,+GMTYP(1))
+6 DO ITEM^ORCXPND("Health Summary")
+7 SET I=1
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)
+8 KILL ^TMP("ORDATA",$JOB)
+9 QUIT
+10 ;
GMTSA ; -- Ad Hoc Health Summary
+1 NEW DFN,Y,I,DIC,X,GMTSTYP,GMTSTITL,GMTSQIT
+2 DO TIT("Adhoc Health Summary")
IF $$OS()
QUIT
+3 SET X="GMTS HS ADHOC"
SET DIC=142
SET DIZ(0)="ZF"
DO ^DIC
IF Y'>0
QUIT
SET GMTSTYP=+Y
+4 SET GMTSTITL="AD HOC"
DO BUILD^GMTSADOR
+5 IF $DATA(GMTSQIT)
QUIT
+6 DO PREP
+7 DO RPT^ORWRP(.Y,ID,15,GMTSTYP)
+8 DO ITEM^ORCXPND("Adhoc Health Summary")
+9 SET I=1
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)
+10 KILL ^TMP("ORDATA",$JOB)
+11 QUIT
+12 ;
GMRVC ; -- Vitals Cumulative Report
+1 NEW DFN,Y,I,X,BCNT
+2 DO TIT("Vitals Cumulative Report")
IF $$OS()
QUIT
+3 SET X=$$DAYS(7)
IF X=-1
QUIT
+4 DO PREP
+5 DO RPT^ORWRP(.Y,ID,5,,X,"VITCUM")
+6 DO ITEM^ORCXPND("Vitals Cumulative Report")
+7 SET I=3
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 SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)=X
IF $LENGTH(X)
SET BCNT=0
End DoDot:1
IF X["No cumulative vitals data for this patient"
QUIT
+11 KILL ^TMP("ORDATA",$JOB)
+12 QUIT
FHP ; -- Dietetics profile
+1 NEW X,I
SET X=$$P^FHWOR71(+ORVP)
+2 DO ITEM^ORCXPND("Dietetics Profile")
DO BLANK^ORCXPND
+3 ; no rpt
IF +X'>0
SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)=$PIECE(X,U,2)
QUIT
+4 SET I=0
FOR
SET I=$ORDER(^TMP($JOB,"FHPROF",+ORVP,I))
IF I'>0
QUIT
SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)=^TMP($JOB,"FHPROF",+ORVP,I)
+5 KILL ^TMP($JOB,"FHPROF",+ORVP)
+6 QUIT
+7 ;
FHA ; -- Nurtritional Assessments
+1 NEW X,I
SET ID=$PIECE(ID,";",2)
SET X=$$FHWORASM^FHWORA(+ORVP,ID)
+2 DO ITEM^ORCXPND("Nutritional Assessment on "_ID)
DO BLANK^ORCXPND
+3 ; no rpt
IF X'>0
SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)=$PIECE(X,U,2)
QUIT
+4 SET I=0
FOR
SET I=$ORDER(^TMP($JOB,"FHASM",+ORVP,I))
IF I'>0
QUIT
SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)=^TMP($JOB,"FHASM",+ORVP,I)
+5 KILL ^TMP($JOB,"FHASM",+ORVP)
+6 QUIT
+7 ;
ORS ; -- Daily Order Summary
+1 NEW DFN,Y,I,BCNT
+2 DO TIT("Daily Order Summary")
IF $$OS()
QUIT
+3 DO PREP
+4 DO RPT^ORWRP(.Y,ID,10,,1)
+5 DO ITEM^ORCXPND("Daily Order Summary")
+6 SET I=3
SET BCNT=0
+7 FOR
SET I=$ORDER(^TMP("ORDATA",$JOB,1,I))
IF I<1
QUIT
SET X=^(I)
Begin DoDot:1
+8 IF '$LENGTH(X)
SET BCNT=BCNT+1
IF BCNT>1
QUIT
+9 SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)=X
IF $LENGTH(X)
SET BCNT=0
End DoDot:1
IF X["* END OF ORDERS *"
QUIT
+10 KILL ^TMP("ORDATA",$JOB)
+11 QUIT
+12 ;
ORD ; -- Order Summary for Date Range
+1 NEW DFN,Y,I,BCNT,OREND,ORSSTRT,ORSSTOP
+2 DO TIT("Order summary for Date Range")
IF $$OS()
QUIT
+3 DO RANGE^ORCXPND3($SELECT($GET(ORWARD):7,1:180))
IF OREND
QUIT
+4 DO PREP
+5 DO RPT^ORWRP(.Y,ID,11,,,,+ORSSTRT,+ORSSTOP)
+6 DO ITEM^ORCXPND("Order Summary for Date Range")
+7 SET I=3
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 SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)=X
IF $LENGTH(X)
SET BCNT=0
End DoDot:1
IF X["* END OF ORDERS *"
QUIT
+11 KILL ^TMP("ORDATA",$JOB)
+12 QUIT
ORC ; -- Customized order summary
+1 NEW DFN,Y,I,BCNT,ORDG,ORPRES,ORSSTRT,ORSSTOP,OREND
+2 DO TIT("Custom Order Summary")
IF $$OS()
QUIT
+3 DO RANGE^ORCXPND3($SELECT($GET(ORWARD):7,1:180))
IF OREND
QUIT
+4 DO CUSTOM^ORPRS01
IF $GET(OREND)
QUIT
+5 DO PREP
+6 DO RPT^ORWRP(.Y,ID,14,,,,+ORSSTRT,+ORSSTOP)
+7 DO ITEM^ORCXPND("Custom order summary")
+8 SET I=3
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
IF X["* END OF ORDERS *"
QUIT
+12 KILL ^TMP("ORDATA",$JOB)
+13 QUIT
ORP ; -- Print Chart Copy Summary
+1 NEW DFN,Y,I,BCNT,ORSSTRT,ORSSTOP,OREND
+2 DO TIT("Chart Copy Summary")
IF $$OS()
QUIT
+3 DO RANGE^ORCXPND3($SELECT($GET(ORWARD):7,1:180))
IF OREND
QUIT
+4 DO PREP
+5 DO RPT^ORWRP(.Y,ID,12,,,,+ORSSTRT,+ORSSTOP)
+6 DO ITEM^ORCXPND("Chart Copy Summary")
+7 SET I=.1
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 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
PSO ; -- Outpatient Pharmacy Action Profile
+1 NEW DFN,Y,I,BCNT
+2 DO TIT("Outpatient Pharmacy Action Profile")
IF $$OS()
QUIT
+3 DO PREP
+4 DO RPT^ORWRP(.Y,ID,13)
+5 DO ITEM^ORCXPND("Outpatient Pharmacy Action Profile")
+6 SET I=.1
SET BCNT=0
+7 FOR
SET I=$ORDER(^TMP("ORDATA",$JOB,1,I))
IF I<1
QUIT
SET X=^(I)
Begin DoDot:1
+8 IF '$LENGTH(X)
SET BCNT=BCNT+1
IF BCNT>1
QUIT
+9 SET LCNT=LCNT+1
SET ^TMP("ORXPND",$JOB,LCNT,0)=X
IF $LENGTH(X)
SET BCNT=0
End DoDot:1
+10 KILL ^TMP("ORDATA",$JOB)
+11 QUIT
OS() ; Check OS- Temporary disabled for OpenM
+1 ;Open M check disabled - remove if Wally's fix fixed.
QUIT 0
+2 IF $GET(^%ZOSF("OS"))["OpenM"
WRITE !!,$CHAR(7),"This report is currently unavailable from this menu.",!,"Please use 'OR Other Reports ...' to get this report."
DO READ^ORUTL
+3 QUIT $GET(^%ZOSF("OS"))["OpenM"
LRA ;AP Report
+1 DO LRA^ORCXPND3
+2 QUIT
LRAA ;AP Report (alt)
+1 DO LRAA^ORCXPND3
+2 QUIT
LRB1 ;BB Report
+1 DO LRB1^ORCXPND3
+2 QUIT
LRB ;BB Report (alt)
+1 DO LRB^ORCXPND3
+2 QUIT
LRC ;Lab cumulative
+1 DO LRC^ORCXPND3
+2 QUIT
LRG ;Lab Graph
+1 DO LRG^ORCXPND3
+2 QUIT
LRI ;Lab Interim by Day
+1 DO LRI^ORCXPND3
+2 QUIT
LRGEN ;Lab results by test
+1 DO LRGEN^ORCXPND3
+2 QUIT
STAT ;Lab order status
+1 DO STAT^ORCXPND3
+2 QUIT
MED(TYPE) ;Medicine Patient Procedure Summary
+1 DO MED^ORCXPND3(TYPE)
+2 QUIT
