ORCHTAB1 ;SLC/MKB-Build Chart-tabs cont ;6/14/02 12:49
;;3.0;ORDER ENTRY/RESULTS REPORTING;**2,27,58,72,141,189**;Dec 17, 1997
EN ; -- rebuild ORTAB listing
Q:'$L($T(@ORTAB)) G @ORTAB
Q
;
DT(X) ; -- Returns FM date for X
N Y,%DT S %DT="T",Y="" D:X'="" ^%DT
Q Y
;
COVER ; -- cover sheet
N LBL,X
F LBL="GMRA","CWAD","GMRV","IMM","SC" D @(LBL_"^ORCHTAB2"),BLANK^ORCHTAB
S ORMENU="ORCHART COVER MENU",DEFCXT=1
S ORTITLE="Cover Sheet",ORACTNS="ORC COVER ACTIONS",ORRM=81
S ORCAPTN("ITEM")="Item",ORCAPTN("DATA")="Entered",ORCAPTN("MORE")=""
Q
;
NOTES ; -- progress notes
N BEG,END,STS,AUTHOR,ORY,ORI,ORX,OCCLIM,SUBJ
I '$L(CONTEXT) S CONTEXT=$$GET^XPAR("ALL","ORCH CONTEXT NOTES"),DEFCXT=1,OCCLIM=$P($$PERSPRF^TIULE(DUZ),U,10) S:+OCCLIM>0 $P(CONTEXT,";",5)=OCCLIM
S BEG=$$DT($P(CONTEXT,";")),END=$$DT($P(CONTEXT,";",2)),STS=$P(CONTEXT,";",3),AUTHOR=$P(CONTEXT,";",4),OCCLIM=$P(CONTEXT,";",5),SUBJ=$P(CONTEXT,";",6)
D CONTEXT^TIUSRVLO(.ORY,3,STS,+ORVP,BEG,END,AUTHOR,OCCLIM) S ORI=0
I $L($G(ORY)) F S ORI=$O(@ORY@(ORI)) Q:ORI'>0 S ORX=@ORY@(ORI) D NOTE^ORCHTAB2
S ORTITLE=$S(STS=2:"Unsigned",STS=3:"Uncosigned",1:"Signed")_" Notes"_$S(AUTHOR:" by "_$$LNAMEF^ORCHTAB(AUTHOR),1:"")
S ORCAPTN("ITEM")="Title",ORCAPTN("DATA")="Written Author SigSt",ORCAPTN("MORE")=""
S ORACTNS="ORC TIU ACTIONS",ORCHANGE="ORCHANGE NOTES",ORRM=81
S ORMENU="ORCHART NOTES MENU" K @ORY
Q
;
SUMMRIES ; -- discharge summary
N BEG,END,STS,AUTHOR,ORY,ORI,ORX
S:'$L(CONTEXT) CONTEXT=$$GET^XPAR("ALL","ORCH CONTEXT SUMMRIES"),DEFCXT=1
S BEG=$$DT($P(CONTEXT,";")),END=$$DT($P(CONTEXT,";",2)),STS=$P(CONTEXT,";",3),AUTHOR=$P(CONTEXT,";",4)
D CONTEXT^TIUSRVLO(.ORY,244,STS,+ORVP,BEG,END,AUTHOR) S ORI=0
I $L($G(ORY)) F S ORI=$O(@ORY@(ORI)) Q:ORI'>0 S ORX=@ORY@(ORI) D SUMM^ORCHTAB2
S ORCAPTN("ITEM")="Title",ORCAPTN("DATA")="Ref Date Author SigSt",ORCAPTN("MORE")="Admitted Discharged "
S ORACTNS="ORC TIU ACTIONS",ORMENU="ORCHART SUMMARIES MENU",ORCHANGE="ORCHANGE NOTES",ORRM=114
S ORTITLE=$S(STS=2:"Unsigned",STS=3:"Uncosigned",1:"Signed")_" D/C Summaries"_$S(AUTHOR:" by "_$$LNAMEF^ORCHTAB(AUTHOR),1:"") K @ORY
Q
;
PROBLEMS ; -- problem list
N COMM,ST,ORY,ORI,ORX
S:'$L(CONTEXT) CONTEXT=$$GET^XPAR("ALL","ORCH CONTEXT PROBLEMS"),DEFCXT=1
S ST=$P(CONTEXT,";",3),COMM=$P(CONTEXT,";",4) ;,PROV=$P(CONTEXT,";",5)
D LIST^GMPLUTL2(.ORY,+ORVP,ST,COMM)
S ORI=0 F S ORI=$O(ORY(ORI)) Q:ORI'>0 S ORX=ORY(ORI) D PROB^ORCHTAB2
S ORCAPTN("ITEM")="Problem",ORCAPTN("DATA")="Onset Updated Status",ORCAPTN("MORE")=""
S ORTITLE=$S(ST="A":"Active",ST="I":"Inactive",1:"All")_" Problems"
S ORACTNS="ORC PROBLEM ACTIONS",ORCHANGE="ORCHANGE PROBLEMS",ORRM=81
S ORMENU="ORCHART PROBLEMS MENU"
Q
;
NEW ; -- new orders in ORNEW()
N OREVENT S CONTEXT=";;19;ALL;L",DEFCXT=1 G ORDERS
DELAY ; -- delayed orders [from ORCACT3]
N OREVENT S CONTEXT=";;24;ALL;L",DEFCXT=1 G ORDERS
;
ORDERS ; -- orders
N DGRP,STS,BEG,END,ORLIST,ORIFN,ORI,MULT,ORYD,FRMT,DELAY,EVT
S:'$L(CONTEXT) CONTEXT=$$GET^XPAR("ALL","ORCH CONTEXT ORDERS"),DEFCXT=1
S BEG=$$DT($P(CONTEXT,";")),END=$$DT($P(CONTEXT,";",2))
S DGRP=$P(CONTEXT,";",4),FRMT=$P(CONTEXT,";",5),EVT=$P(CONTEXT,";",8)
S:'$L(DGRP) DGRP="ALL" S DGRP=+$O(^ORD(100.98,"B",DGRP,0))
S STS=+$P(CONTEXT,";",3),DELAY=$S("^15^16^17^24^25^26^"[(U_STS_U):1,'EVT:0,$P($G(^ORE(100.2,+EVT,1)),U,5):1,$O(^ORE(100.2,"DAD",+EVT,0)):1,1:0)
S MULT=$S("^1^6^8^9^10^11^13^14^20^22^"[(U_STS_U):1,1:0)
S ORTITLE=$$STATUS(STS,EVT)_$S(DGRP>1:" "_$P($G(^ORD(100.98,+DGRP,0)),U,2),1:"")_" Orders",ORRM=114
S ORCAPTN("ITEM")="Item Ordered",ORCAPTN("MORE")="NRS CLK Chart "
S:FRMT="S" ORCAPTN("DATA")="Start Date Order Status"
S:FRMT'="S" ORCAPTN("DATA")="Provider Start Stop Sts"
D EN^ORQ1(ORVP,DGRP,+STS,,BEG,END,,MULT,,1,EVT),ORYD^ORDD100 ;Get list
S ORI=0 F S ORI=$O(^TMP("ORR",$J,ORLIST,ORI)) Q:ORI'>0 S ORIFN=$G(^(ORI)) D ORDER^ORCHTAB3:'DELAY,DELAYED^ORCHTAB3:DELAY
S DELAY=$S("^15^16^17^24^25^26^"[(U_STS_U):1,$G(OREVENT):1,1:0)
S ORACTNS="ORC "_$S(ORTAB="NEW":"NEW",DELAY:"DELAYED ORDER",$D(^XUSEC("ORES",DUZ)):"ORES ORDER",$D(^XUSEC("ORELSE",DUZ)):"ORELSE ORDER",$D(^XUSEC("OREMAS",DUZ)):"OREMAS ORDER",1:"ORDER")_" ACTIONS"
I ORTAB'="NEW" S ORCHANGE="ORCHANGE ORDERS "_$S(FRMT="L":"LONG",1:"SHORT")
K ^TMP("ORR",$J,ORLIST)
Q
;
STATUS(X,Y) ; -- Return name of context/status number
N Z I $G(Y) S Z=$$NAME^OREVNTX(Y),Z=$$LOWER^VALM1(Z) Q Z ;Event
S Z="All^Active^Discontinued^Completed/Expired^Expiring^Recent^Pending^Unverified^Unverified^Unverified^Unsigned^Flagged^Verbal^Unsigned Verbal^Admission^Discharge^Transfer^Held^New^Unverified^^Lapsed^Current^Delayed^O.R.^Delayed"
Q $P(Z,U,+X)
;
MEDS ; -- medications
N BEG,END,INPT,ORI,ORJ,ORX
S:'$L(CONTEXT) CONTEXT=$$GET^XPAR("ALL","ORCH CONTEXT MEDS"),DEFCXT=1
S BEG=$$DT($P(CONTEXT,";")),END=$$DT($P(CONTEXT,";",2))
S INPT=$P(CONTEXT,";",3) S:'$L(INPT) INPT=$S($G(ORWARD):1,1:0)
D OCL^PSOORRL(+ORVP,BEG,END),SORT^ORCHTAB3(INPT)
S ORJ=0 F S ORJ=$O(^TMP("ORPS",$J,ORJ)) Q:ORJ'>0 S ORI=0 F S ORI=$O(^TMP("ORPS",$J,ORJ,ORI)) Q:ORI'>0 S ORX=$G(^TMP("PS",$J,ORI,0)) D MEDS^ORCHTAB3
S ORCAPTN("ITEM")="Medication",ORCAPTN("MORE")="",ORRM=81
S:INPT ORCAPTN("DATA")="Start Stop Status"
S:'INPT ORCAPTN("DATA")="Requestor Expires Status"
S ORACTNS="ORC "_$S(INPT:"IN",1:"OUT")_"PT MED ACTIONS",ORMENU="ORCHART MEDS MENU"
S ORCHANGE="ORCHANGE MEDS "_$S(INPT:"INPT",1:"OUTPT")
S ORTITLE=$S($L(BEG)!$L(END):"",1:"Active ")_$S(INPT:"In",1:"Out")_"patient Medications"
K ^TMP("PS",$J),^TMP("ORPS",$J)
Q
;
LABS ; -- laboratory
N BEG,END,TYPE,SUB,X
I '$L(CONTEXT) S CONTEXT=$$GET^XPAR("ALL","ORCH CONTEXT "_$S($G(ORWARD):"IN",1:"OUT")_"PT LABS"),DEFCXT=1
S BEG=$$DT($P(CONTEXT,";")),END=$$DT($P(CONTEXT,";",2)),TYPE=$P(CONTEXT,";",3),ORRM=81
I TYPE="C" D LRCUM^ORCHTAB4 Q ; cum
D RR^LR7OR1(+ORVP,,BEG,END)
S SUB="CH" D LABS^ORCHTAB4,BLANK^ORCHTAB ; MI,AP,BB ??
S ORTITLE="Lab Tests" ;,ORACTNS="ORC LAB ACTIONS"
S ORCAPTN("ITEM")="Test Result Units Range"
S ORCAPTN("DATA")="Collected Accession Sts",ORCAPTN("MORE")=""
S ORCHANGE="ORCHANGE LAB LIST",ORMENU="ORCHART LABS MENU"
K ^TMP("LRRR",$J)
Q
;
XRAYS ; -- radiology
N BEG,END,MAX,ORI,ORX
S:'$L(CONTEXT) CONTEXT=$$GET^XPAR("ALL","ORCH CONTEXT XRAYS"),DEFCXT=1
S BEG=$$DT($P(CONTEXT,";")),END=$$DT($P(CONTEXT,";",2)),MAX=$P(CONTEXT,";",5)
S ORX=$L($T(EN1^RAO7PC1),",") D EN1^RAO7PC1(+ORVP,BEG,END,MAX):ORX=4
D EN1^RAO7PC1(+ORVP,BEG,END,MAX,1):ORX>4 ;incl cancelled exams
S ORI=0 F S ORI=$O(^TMP($J,"RAE1",+ORVP,ORI)) Q:ORI'>0 S ORX=$G(^(ORI)) D XRAY^ORCHTAB4
S ORCAPTN("ITEM")="Procedure",ORCAPTN("DATA")="Exam Date Case Report Sts",ORCAPTN("MORE")=""
S ORACTNS="ORC XRAY ACTIONS",ORCHANGE="ORCHANGE XRAYS",ORRM=81
S ORTITLE="Imaging Procedures",ORMENU="ORCHART XRAYS MENU"
K ^TMP($J,"RAE1")
Q
;
CONSULTS ; -- consults
N BEG,END,STS,SERV,ORI,ORX
S:'$L(CONTEXT) CONTEXT=$$GET^XPAR("ALL","ORCH CONTEXT CONSULTS"),DEFCXT=1
S BEG=$$DT($P(CONTEXT,";")),END=$$DT($P(CONTEXT,";",2)),STS=$P(CONTEXT,";",3),SERV=$P(CONTEXT,";",4)
S ORTITLE=$S($L(STS,",")>1:"Selected",STS:$$LOWER^VALM1($P(^ORD(100.01,+STS,0),U)),1:"All")_" "_$S('SERV:"",$L($G(^GMR(123.5,+SERV,.1))):^(.1)_" ",1:$P($G(^GMR(123.5,+SERV,0)),U)_" ")_"Consults"
D OER^GMRCSLM1(+ORVP,SERV,BEG,END,STS)
S ORI=0 F S ORI=$O(^TMP("GMRCR",$J,"CS",ORI)) Q:ORI'>0 S ORX=$G(^(ORI,0)) Q:$E(ORX)="<" D CSLT^ORCHTAB4
S ORCAPTN("ITEM")="Consult/Procedure",ORCAPTN("DATA")="Requested No. Status",ORCAPTN("MORE")=""
S ORACTNS="ORC CONSULT ACTIONS",ORCHANGE="ORCHANGE CONSULTS",ORRM=81
S ORMENU="ORCHART CONSULTS MENU"
K ^TMP("GMRCR",$J)
Q
;
REPORTS ; -- patient profiles
N X,BEG,END,MAX D RPT^ORCHTAB4
S:'$L(CONTEXT) CONTEXT=$$GET^XPAR("ALL","ORCH CONTEXT REPORTS"),DEFCXT=1 S X="Radiology"
S BEG=$$DT($P(CONTEXT,";")),END=$$DT($P(CONTEXT,";",2)),MAX=$P(CONTEXT,";",5)
S X="Imaging ("_$$DATE^ORCHTAB(BEG)_" to "_$$DATE^ORCHTAB(END)_$S(MAX:", limit "_MAX,1:"")_")"
D BLANK^ORCHTAB,SUBHDR^ORCHTAB(X),XRAYS
I $L($T(EN^MCARPS2)) D BLANK^ORCHTAB,SUBHDR^ORCHTAB("Summary of Patient Procedures"),MED^ORCHTAB5
S ORCAPTN("ITEM")="Report",ORCAPTN("DATA")="Date Case Status",ORCAPTN("MORE")=""
S ORACTNS="ORC REPORT ACTIONS",ORMENU="ORCHART REPORTS MENU",ORRM=81
S ORCHANGE="ORCHANGE REPORTS",ORTITLE="Reports"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCHTAB1 8522 printed Apr 09, 2024@21:36:50 Page 2
ORCHTAB1 ;SLC/MKB-Build Chart-tabs cont ;6/14/02 12:49
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**2,27,58,72,141,189**;Dec 17, 1997
EN ; -- rebuild ORTAB listing
+1 if '$LENGTH($TEXT(@ORTAB))
QUIT
GOTO @ORTAB
+2 QUIT
+3 ;
DT(X) ; -- Returns FM date for X
+1 NEW Y,%DT
SET %DT="T"
SET Y=""
if X'=""
DO ^%DT
+2 QUIT Y
+3 ;
COVER ; -- cover sheet
+1 NEW LBL,X
+2 FOR LBL="GMRA","CWAD","GMRV","IMM","SC"
DO @(LBL_"^ORCHTAB2")
DO BLANK^ORCHTAB
+3 SET ORMENU="ORCHART COVER MENU"
SET DEFCXT=1
+4 SET ORTITLE="Cover Sheet"
SET ORACTNS="ORC COVER ACTIONS"
SET ORRM=81
+5 SET ORCAPTN("ITEM")="Item"
SET ORCAPTN("DATA")="Entered"
SET ORCAPTN("MORE")=""
+6 QUIT
+7 ;
NOTES ; -- progress notes
+1 NEW BEG,END,STS,AUTHOR,ORY,ORI,ORX,OCCLIM,SUBJ
+2 IF '$LENGTH(CONTEXT)
SET CONTEXT=$$GET^XPAR("ALL","ORCH CONTEXT NOTES")
SET DEFCXT=1
SET OCCLIM=$PIECE($$PERSPRF^TIULE(DUZ),U,10)
if +OCCLIM>0
SET $PIECE(CONTEXT,";",5)=OCCLIM
+3 SET BEG=$$DT($PIECE(CONTEXT,";"))
SET END=$$DT($PIECE(CONTEXT,";",2))
SET STS=$PIECE(CONTEXT,";",3)
SET AUTHOR=$PIECE(CONTEXT,";",4)
SET OCCLIM=$PIECE(CONTEXT,";",5)
SET SUBJ=$PIECE(CONTEXT,";",6)
+4 DO CONTEXT^TIUSRVLO(.ORY,3,STS,+ORVP,BEG,END,AUTHOR,OCCLIM)
SET ORI=0
+5 IF $LENGTH($GET(ORY))
FOR
SET ORI=$ORDER(@ORY@(ORI))
if ORI'>0
QUIT
SET ORX=@ORY@(ORI)
DO NOTE^ORCHTAB2
+6 SET ORTITLE=$SELECT(STS=2:"Unsigned",STS=3:"Uncosigned",1:"Signed")_" Notes"_$SELECT(AUTHOR:" by "_$$LNAMEF^ORCHTAB(AUTHOR),1:"")
+7 SET ORCAPTN("ITEM")="Title"
SET ORCAPTN("DATA")="Written Author SigSt"
SET ORCAPTN("MORE")=""
+8 SET ORACTNS="ORC TIU ACTIONS"
SET ORCHANGE="ORCHANGE NOTES"
SET ORRM=81
+9 SET ORMENU="ORCHART NOTES MENU"
KILL @ORY
+10 QUIT
+11 ;
SUMMRIES ; -- discharge summary
+1 NEW BEG,END,STS,AUTHOR,ORY,ORI,ORX
+2 if '$LENGTH(CONTEXT)
SET CONTEXT=$$GET^XPAR("ALL","ORCH CONTEXT SUMMRIES")
SET DEFCXT=1
+3 SET BEG=$$DT($PIECE(CONTEXT,";"))
SET END=$$DT($PIECE(CONTEXT,";",2))
SET STS=$PIECE(CONTEXT,";",3)
SET AUTHOR=$PIECE(CONTEXT,";",4)
+4 DO CONTEXT^TIUSRVLO(.ORY,244,STS,+ORVP,BEG,END,AUTHOR)
SET ORI=0
+5 IF $LENGTH($GET(ORY))
FOR
SET ORI=$ORDER(@ORY@(ORI))
if ORI'>0
QUIT
SET ORX=@ORY@(ORI)
DO SUMM^ORCHTAB2
+6 SET ORCAPTN("ITEM")="Title"
SET ORCAPTN("DATA")="Ref Date Author SigSt"
SET ORCAPTN("MORE")="Admitted Discharged "
+7 SET ORACTNS="ORC TIU ACTIONS"
SET ORMENU="ORCHART SUMMARIES MENU"
SET ORCHANGE="ORCHANGE NOTES"
SET ORRM=114
+8 SET ORTITLE=$SELECT(STS=2:"Unsigned",STS=3:"Uncosigned",1:"Signed")_" D/C Summaries"_$SELECT(AUTHOR:" by "_$$LNAMEF^ORCHTAB(AUTHOR),1:"")
KILL @ORY
+9 QUIT
+10 ;
PROBLEMS ; -- problem list
+1 NEW COMM,ST,ORY,ORI,ORX
+2 if '$LENGTH(CONTEXT)
SET CONTEXT=$$GET^XPAR("ALL","ORCH CONTEXT PROBLEMS")
SET DEFCXT=1
+3 ;,PROV=$P(CONTEXT,";",5)
SET ST=$PIECE(CONTEXT,";",3)
SET COMM=$PIECE(CONTEXT,";",4)
+4 DO LIST^GMPLUTL2(.ORY,+ORVP,ST,COMM)
+5 SET ORI=0
FOR
SET ORI=$ORDER(ORY(ORI))
if ORI'>0
QUIT
SET ORX=ORY(ORI)
DO PROB^ORCHTAB2
+6 SET ORCAPTN("ITEM")="Problem"
SET ORCAPTN("DATA")="Onset Updated Status"
SET ORCAPTN("MORE")=""
+7 SET ORTITLE=$SELECT(ST="A":"Active",ST="I":"Inactive",1:"All")_" Problems"
+8 SET ORACTNS="ORC PROBLEM ACTIONS"
SET ORCHANGE="ORCHANGE PROBLEMS"
SET ORRM=81
+9 SET ORMENU="ORCHART PROBLEMS MENU"
+10 QUIT
+11 ;
NEW ; -- new orders in ORNEW()
+1 NEW OREVENT
SET CONTEXT=";;19;ALL;L"
SET DEFCXT=1
GOTO ORDERS
DELAY ; -- delayed orders [from ORCACT3]
+1 NEW OREVENT
SET CONTEXT=";;24;ALL;L"
SET DEFCXT=1
GOTO ORDERS
+2 ;
ORDERS ; -- orders
+1 NEW DGRP,STS,BEG,END,ORLIST,ORIFN,ORI,MULT,ORYD,FRMT,DELAY,EVT
+2 if '$LENGTH(CONTEXT)
SET CONTEXT=$$GET^XPAR("ALL","ORCH CONTEXT ORDERS")
SET DEFCXT=1
+3 SET BEG=$$DT($PIECE(CONTEXT,";"))
SET END=$$DT($PIECE(CONTEXT,";",2))
+4 SET DGRP=$PIECE(CONTEXT,";",4)
SET FRMT=$PIECE(CONTEXT,";",5)
SET EVT=$PIECE(CONTEXT,";",8)
+5 if '$LENGTH(DGRP)
SET DGRP="ALL"
SET DGRP=+$ORDER(^ORD(100.98,"B",DGRP,0))
+6 SET STS=+$PIECE(CONTEXT,";",3)
SET DELAY=$SELECT("^15^16^17^24^25^26^"[(U_STS_U):1,'EVT:0,$PIECE($GET(^ORE(100.2,+EVT,1)),U,5):1,$ORDER(^ORE(100.2,"DAD",+EVT,0)):1,1:0)
+7 SET MULT=$SELECT("^1^6^8^9^10^11^13^14^20^22^"[(U_STS_U):1,1:0)
+8 SET ORTITLE=$$STATUS(STS,EVT)_$SELECT(DGRP>1:" "_$PIECE($GET(^ORD(100.98,+DGRP,0)),U,2),1:"")_" Orders"
SET ORRM=114
+9 SET ORCAPTN("ITEM")="Item Ordered"
SET ORCAPTN("MORE")="NRS CLK Chart "
+10 if FRMT="S"
SET ORCAPTN("DATA")="Start Date Order Status"
+11 if FRMT'="S"
SET ORCAPTN("DATA")="Provider Start Stop Sts"
+12 ;Get list
DO EN^ORQ1(ORVP,DGRP,+STS,,BEG,END,,MULT,,1,EVT)
DO ORYD^ORDD100
+13 SET ORI=0
FOR
SET ORI=$ORDER(^TMP("ORR",$JOB,ORLIST,ORI))
if ORI'>0
QUIT
SET ORIFN=$GET(^(ORI))
if 'DELAY
DO ORDER^ORCHTAB3
if DELAY
DO DELAYED^ORCHTAB3
+14 SET DELAY=$SELECT("^15^16^17^24^25^26^"[(U_STS_U):1,$GET(OREVENT):1,1:0)
+15 SET ORACTNS="ORC "_$SELECT(ORTAB="NEW":"NEW",DELAY:"DELAYED ORDER",$DATA(^XUSEC("ORES",DUZ)):"ORES ORDER",$DATA(^XUSEC("ORELSE",DUZ)):"ORELSE ORDER",$DATA(^XUSEC("OREMAS",DUZ)):"OREMAS ORDER",1:"ORDER")_" ACTIONS"
+16 IF ORTAB'="NEW"
SET ORCHANGE="ORCHANGE ORDERS "_$SELECT(FRMT="L":"LONG",1:"SHORT")
+17 KILL ^TMP("ORR",$JOB,ORLIST)
+18 QUIT
+19 ;
STATUS(X,Y) ; -- Return name of context/status number
+1 ;Event
NEW Z
IF $GET(Y)
SET Z=$$NAME^OREVNTX(Y)
SET Z=$$LOWER^VALM1(Z)
QUIT Z
+2 SET Z="All^Active^Discontinued^Completed/Expired^Expiring^Recent^Pending^Unverified^Unverified^Unverified^Unsigned^Flagged^Verbal^Unsigned Verbal^Admission^Discharge^Transfer^Held^New^Unverified^^Lapsed^Current^Delayed^O.R.^Delayed"
+3 QUIT $PIECE(Z,U,+X)
+4 ;
MEDS ; -- medications
+1 NEW BEG,END,INPT,ORI,ORJ,ORX
+2 if '$LENGTH(CONTEXT)
SET CONTEXT=$$GET^XPAR("ALL","ORCH CONTEXT MEDS")
SET DEFCXT=1
+3 SET BEG=$$DT($PIECE(CONTEXT,";"))
SET END=$$DT($PIECE(CONTEXT,";",2))
+4 SET INPT=$PIECE(CONTEXT,";",3)
if '$LENGTH(INPT)
SET INPT=$SELECT($GET(ORWARD):1,1:0)
+5 DO OCL^PSOORRL(+ORVP,BEG,END)
DO SORT^ORCHTAB3(INPT)
+6 SET ORJ=0
FOR
SET ORJ=$ORDER(^TMP("ORPS",$JOB,ORJ))
if ORJ'>0
QUIT
SET ORI=0
FOR
SET ORI=$ORDER(^TMP("ORPS",$JOB,ORJ,ORI))
if ORI'>0
QUIT
SET ORX=$GET(^TMP("PS",$JOB,ORI,0))
DO MEDS^ORCHTAB3
+7 SET ORCAPTN("ITEM")="Medication"
SET ORCAPTN("MORE")=""
SET ORRM=81
+8 if INPT
SET ORCAPTN("DATA")="Start Stop Status"
+9 if 'INPT
SET ORCAPTN("DATA")="Requestor Expires Status"
+10 SET ORACTNS="ORC "_$SELECT(INPT:"IN",1:"OUT")_"PT MED ACTIONS"
SET ORMENU="ORCHART MEDS MENU"
+11 SET ORCHANGE="ORCHANGE MEDS "_$SELECT(INPT:"INPT",1:"OUTPT")
+12 SET ORTITLE=$SELECT($LENGTH(BEG)!$LENGTH(END):"",1:"Active ")_$SELECT(INPT:"In",1:"Out")_"patient Medications"
+13 KILL ^TMP("PS",$JOB),^TMP("ORPS",$JOB)
+14 QUIT
+15 ;
LABS ; -- laboratory
+1 NEW BEG,END,TYPE,SUB,X
+2 IF '$LENGTH(CONTEXT)
SET CONTEXT=$$GET^XPAR("ALL","ORCH CONTEXT "_$SELECT($GET(ORWARD):"IN",1:"OUT")_"PT LABS")
SET DEFCXT=1
+3 SET BEG=$$DT($PIECE(CONTEXT,";"))
SET END=$$DT($PIECE(CONTEXT,";",2))
SET TYPE=$PIECE(CONTEXT,";",3)
SET ORRM=81
+4 ; cum
IF TYPE="C"
DO LRCUM^ORCHTAB4
QUIT
+5 DO RR^LR7OR1(+ORVP,,BEG,END)
+6 ; MI,AP,BB ??
SET SUB="CH"
DO LABS^ORCHTAB4
DO BLANK^ORCHTAB
+7 ;,ORACTNS="ORC LAB ACTIONS"
SET ORTITLE="Lab Tests"
+8 SET ORCAPTN("ITEM")="Test Result Units Range"
+9 SET ORCAPTN("DATA")="Collected Accession Sts"
SET ORCAPTN("MORE")=""
+10 SET ORCHANGE="ORCHANGE LAB LIST"
SET ORMENU="ORCHART LABS MENU"
+11 KILL ^TMP("LRRR",$JOB)
+12 QUIT
+13 ;
XRAYS ; -- radiology
+1 NEW BEG,END,MAX,ORI,ORX
+2 if '$LENGTH(CONTEXT)
SET CONTEXT=$$GET^XPAR("ALL","ORCH CONTEXT XRAYS")
SET DEFCXT=1
+3 SET BEG=$$DT($PIECE(CONTEXT,";"))
SET END=$$DT($PIECE(CONTEXT,";",2))
SET MAX=$PIECE(CONTEXT,";",5)
+4 SET ORX=$LENGTH($TEXT(EN1^RAO7PC1),",")
if ORX=4
DO EN1^RAO7PC1(+ORVP,BEG,END,MAX)
+5 ;incl cancelled exams
if ORX>4
DO EN1^RAO7PC1(+ORVP,BEG,END,MAX,1)
+6 SET ORI=0
FOR
SET ORI=$ORDER(^TMP($JOB,"RAE1",+ORVP,ORI))
if ORI'>0
QUIT
SET ORX=$GET(^(ORI))
DO XRAY^ORCHTAB4
+7 SET ORCAPTN("ITEM")="Procedure"
SET ORCAPTN("DATA")="Exam Date Case Report Sts"
SET ORCAPTN("MORE")=""
+8 SET ORACTNS="ORC XRAY ACTIONS"
SET ORCHANGE="ORCHANGE XRAYS"
SET ORRM=81
+9 SET ORTITLE="Imaging Procedures"
SET ORMENU="ORCHART XRAYS MENU"
+10 KILL ^TMP($JOB,"RAE1")
+11 QUIT
+12 ;
CONSULTS ; -- consults
+1 NEW BEG,END,STS,SERV,ORI,ORX
+2 if '$LENGTH(CONTEXT)
SET CONTEXT=$$GET^XPAR("ALL","ORCH CONTEXT CONSULTS")
SET DEFCXT=1
+3 SET BEG=$$DT($PIECE(CONTEXT,";"))
SET END=$$DT($PIECE(CONTEXT,";",2))
SET STS=$PIECE(CONTEXT,";",3)
SET SERV=$PIECE(CONTEXT,";",4)
+4 SET ORTITLE=$SELECT($LENGTH(STS,",")>1:"Selected",STS:$$LOWER^VALM1($PIECE(^ORD(100.01,+STS,0),U)),1:"All")_" "_$SELECT('SERV:"",$LENGTH($GET(^GMR(123.5,+SERV,.1))):^(.1)_" ",1:$PIECE($GET(^GMR(123.5,+SERV,0)),U)_" ")_"Consults"
+5 DO OER^GMRCSLM1(+ORVP,SERV,BEG,END,STS)
+6 SET ORI=0
FOR
SET ORI=$ORDER(^TMP("GMRCR",$JOB,"CS",ORI))
if ORI'>0
QUIT
SET ORX=$GET(^(ORI,0))
if $EXTRACT(ORX)="<"
QUIT
DO CSLT^ORCHTAB4
+7 SET ORCAPTN("ITEM")="Consult/Procedure"
SET ORCAPTN("DATA")="Requested No. Status"
SET ORCAPTN("MORE")=""
+8 SET ORACTNS="ORC CONSULT ACTIONS"
SET ORCHANGE="ORCHANGE CONSULTS"
SET ORRM=81
+9 SET ORMENU="ORCHART CONSULTS MENU"
+10 KILL ^TMP("GMRCR",$JOB)
+11 QUIT
+12 ;
REPORTS ; -- patient profiles
+1 NEW X,BEG,END,MAX
DO RPT^ORCHTAB4
+2 if '$LENGTH(CONTEXT)
SET CONTEXT=$$GET^XPAR("ALL","ORCH CONTEXT REPORTS")
SET DEFCXT=1
SET X="Radiology"
+3 SET BEG=$$DT($PIECE(CONTEXT,";"))
SET END=$$DT($PIECE(CONTEXT,";",2))
SET MAX=$PIECE(CONTEXT,";",5)
+4 SET X="Imaging ("_$$DATE^ORCHTAB(BEG)_" to "_$$DATE^ORCHTAB(END)_$SELECT(MAX:", limit "_MAX,1:"")_")"
+5 DO BLANK^ORCHTAB
DO SUBHDR^ORCHTAB(X)
DO XRAYS
+6 IF $LENGTH($TEXT(EN^MCARPS2))
DO BLANK^ORCHTAB
DO SUBHDR^ORCHTAB("Summary of Patient Procedures")
DO MED^ORCHTAB5
+7 SET ORCAPTN("ITEM")="Report"
SET ORCAPTN("DATA")="Date Case Status"
SET ORCAPTN("MORE")=""
+8 SET ORACTNS="ORC REPORT ACTIONS"
SET ORMENU="ORCHART REPORTS MENU"
SET ORRM=81
+9 SET ORCHANGE="ORCHANGE REPORTS"
SET ORTITLE="Reports"
+10 QUIT
