- 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 Feb 18, 2025@23:55 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