ORU1 ; slc/JER - More OE/RR Functions ;9/27/93 09:55
;;3.0;ORDER ENTRY/RESULTS REPORTING;**11**;Dec 17, 1997
PATIENT(Y,ORPGSUPP,ORSCREEN) ; Patient selection
;ORPGSUPP=1 to suppress form feed when displaying patient list
;ORSCREEN=1 to suppress Inactive Location (DIC("S")) screen when looking up by location
; .or you can pass your own DIC("S") in this parameter
F D I $S(+$G(Y)>0&($D(Y)>9):1,+$G(Y)=0:1,$D(DUOUT):1,$D(DIROUT):1,1:0) Q
. N C,ORCEND,ORCLIN,ORCSTRT,ORDEF,ORPRIM,ORPROV,ORSPEC,OROPREF,ORCOLW,ORCNT
. N ORI,ORJ,ORUFLG,ORUPNM,ORURMBD,ORUSSN,ORUVP,ORUX,ORVP,ORX,ORY,ORWARD,I,ORTITLE
. S X="",@^%ZOSF("TRAP")
. D PARAM
. I $O(^XUTL("OR",$J,"ORLP",0)) D
.. S ORTITLE=$S($D(ORTITLE):ORTITLE,$D(^XUTL("OR",$J,"ORLP",0)):$P(^(0),U),1:"CURRENT PATIENT LIST"),ORCOLW=40-($L(ORTITLE)\2),ORUS="^XUTL(""OR"","_$J_",""ORLP"",",ORUS(0)="40MN"
.. S ORUS("A")="Select Patient(s): ",ORUS("ALT")="S ORUX=$S(X=ORSEL:X,1:ORSEL),ORUFLG=1 Q"
.. S ORUS("F")="^XUTL(""OR"",$J,""ORLP"","""_$S($L($P($G(^XUTL("OR",$J,"ORLP",0)),U,3)):$P(^(0),U,3),1:"B")_""","
.. S ORUS("H")="W $$PATHLP^ORU2(X)"
.. S ORUS("W")="S X=$P(^XUTL(""OR"",$J,""ORLP"",ORDA,0),U)_"" (""_$E($P(^(0),U,2),6,9)_"")"""
.. I OROPREF="A" S ORUS("W")="S X=$P(^XUTL(""OR"",$J,""ORLP"",ORDA,0),U)_"" (""_$E($P(^(0),U,2),6,9)_"")""_"" ""_$P(^(0),U,5)"
.. I OROPREF="R" S ORUS("W")="S X=$P(^XUTL(""OR"",$J,""ORLP"",ORDA,0),U,5)_"" ""_$P(^(0),U)_"" (""_$E($P(^(0),U,2),6,9)_"")"""
.. I OROPREF="T" S ORUS("W")="S X=""(""_$E($P(^XUTL(""OR"",$J,""ORLP"",ORDA,0),U,2),6,9)_"") ""_$P(^(0),U)_"" ""_$P(^(0),U,5)"
.. I $P(^XUTL("OR",$J,"ORLP",0),"^",3)="D",OROPREF="C" S ORUS("W")="S X=$P(^XUTL(""OR"",$J,""ORLP"",ORDA,0),U,6)_"" ""_$P(^(0),U)_"" (""_$E($P(^(0),U,2),6,9)_"")""",ORUS(0)="80MN"
.. S ORUS("T")="W:'+$G(ORPGSUPP) @IOF W:+$G(ORPGSUPP) ! W ?ORCOLW,$S($D(ORTITLE):ORTITLE,1:""PATIENT LIST"") W:$D(ORPNM) !,""Current Patient: "",ORPNM W !"
.. D EN^ORUS
.. I $G(ORUFLG),$L($G(ORUX)) D WHATIS(ORUX,.Y)
.. I +Y'>0,$D(ORUX) W:$G(ORDEF)'="P" $C(7)," ??"
. I +$O(^XUTL("OR",$J,"ORLP",0))'>0 D
.. I $G(ORDEF)="" D GETELSE(.Y) Q
.. D B1^ORLA1
.. S Y=-1
.. I +$D(^XUTL("OR",$J,"ORLP",0))'>0 D GETELSE(.Y)
PATX Q
GETELSE(Y) ; Get Patient if preference is ambiguous or non-existent
F D I $S(+$G(Y)>0&($D(Y)>9):1,+$G(Y)'>0:1,$D(DUOUT):1,$D(DIROUT):1,1:0) Q
. N ORUFLG,ORUS,ORUX,X
. K ^XUTL("OR",$J,"ORU"),^("ORV"),^("ORW")
. S ORTITLE=$S($D(ORTITLE):ORTITLE,$D(^XUTL("OR",$J,"ORLP",0)):$P(^(0),U),1:"CURRENT PATIENT LIST")
. S ORCOLW=40-($L(ORTITLE)\2)
. S ORUS="^XUTL(""OR"","_$J_",""ORLP"",",ORUS(0)=""
. S ORUS("A")="Select Patient: ",ORUS("ALT")="S ORUX=$S(X=ORSEL:X,1:$G(ORSEL)),ORUFLG=1 Q"
. S ORUS("H")="W $$PATHLP1^ORU2(X)"
. D EN^ORUS
. I +$G(Y)'>0,'$D(ORUX) Q
. I $L($G(ORUX))<2,(ORUX?1A) K ORUX W $C(7)," ??"
. I $G(ORUFLG),$L($G(ORUX)) K ^XUTL("OR",$J,"ORV") D WHATIS(ORUX,.Y)
. I +Y'>0,$D(ORUX) W:$G(ORDEF)'="P" $C(7)," ??"
Q
WHATIS(X,Y) ; Identify input
N DIC,ORDEF,ORCLIN,ORCSTRT,ORCEND,ORWARD,ORSPEC,ORPROV,ORPRIM
I X=" "!($E($G(^%ZOSF("OS")),1,3)="DSM") S DIC=2,DIC(0)="MZE" D ^DIC Q:+Y'>0 G PTX
I $L(X,".")=2,("SPLspl"[$P(X,".")) D Q:+Y'>0 G PTX
. S X=$$UPPER^ORU(X)
. S DIC=$S($P(X,".")="S":45.7,$P(X,".")="P":200,1:100.21),X=$P(X,".",2)
. S DIC(0)="MZEI",DIC("S")="I $L(X)'<2"
. D ^DIC
. K DIC("S")
F DIC=2,44,45.7,200,100.21 D Q:+Y>0
. S DIC(0)=$S(DIC=2:"MZEN",1:"MZEI")
. I DIC=44 D
.. N X
.. I $E($G(ORSCREEN),1,2)="I "!($E($G(ORSCREEN),1,3)="IF ") S X=ORSCREEN D ^DIM S:$D(X) DIC("S")=ORSCREEN Q
.. I '$G(ORSCREEN) S DIC("S")="I $S('$D(^SC(+Y,""I"")):1,'+^(""I""):1,+^(""I"")>DT:1,$P(^(""I""),""^"",2)'>DT&$P(^(""I""),""^"",2):1,1:0),'$P($G(^(""OOS"")),""^"")"
. S:DIC=2 DIC("S")="I $G(DPTREF)'=""CN"""
. I DIC'=2,DIC'=44 S DIC("S")="I $L(X)'<2"
. D ^DIC
. K DIC("S")
I +Y'>0 Q
PTX ;
I DIC["^DPT(" D Q
. S Y(1)=+Y_U_$P(Y,U,2)_U_" "_$P(Y,U,2)_" ("_$E($P(Y(0),U,9),6,9)_")"_U_1,(Y,Y(0))=1 K Y(0,0)
S:DIC["^SC(" ORDEF=$P(Y(0),U,3)
S:DIC[45.7 ORDEF="S"
S:DIC[200 ORDEF="V"
S:DIC[100.21 ORDEF="T"
I ORDEF="C" S ORCLIN=+Y,ORCSTRT="",ORCEND=""
I ORDEF="W" S ORWARD=+$G(^SC(+Y,42))
I ORDEF="S" S ORSPEC=+Y
I ORDEF="V" D Q:ORPROV']""
. S ORPROV=+Y
. I '$O(^DPT("APR",+Y,0)) D
.. S ORPROV=""
.. W !!,"Provider list for "_$P(Y,U,2)_" is empty." H 1
.. K Y S Y=-1
I ORDEF="T",+$G(Y) D Q:$G(ORPRIM)']""
. S ORPRIM=+Y
. I '+$O(^OR(100.21,+ORPRIM,10,0)) D
.. S ORPRIM=""
.. W !!,"Team list "_$P(Y,U,2)_" is empty." H 1
.. K Y S Y=-1
K ORUX,ORUFLG
D KIL^ORLA1,B1^ORLA1
S Y=-1
I '$D(^XUTL("OR",$J,"ORLP")) D
. W !!,"List is empty." H 2
Q
PARAM ;Get patient select parameters
S OROPREF=$$GET^XPAR("USR^SRV.`"_$G(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT LIST ORDER",1,"I")
S ORWARD=$$GET^XPAR("USR^SRV.`"_$G(ORSRV),"ORLP DEFAULT WARD",1,"I")
S ORPRIM=$$GET^XPAR("USR^SRV.`"_$G(ORSRV),"ORLP DEFAULT TEAM",1,"I")
S ORDEF=$$GET^XPAR("USR^SRV.`"_$G(ORSRV),"ORLP DEFAULT LIST SOURCE",1,"I")
I ORDEF="P" S ORDEF="V"
N API
S API="ORLP DEFAULT CLINIC "_$$UP^XLFSTR($$DOW^XLFDT(DT)),ORCLIN=$$GET^XPAR("USR^SRV.`"_$G(ORSRV),API,1,"I")
S ORCSTRT=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_$G(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT CLINIC START DATE",1,"E"))
S ORCEND=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_$G(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT CLINIC STOP DATE",1,"E"))
S ORPROV=$$GET^XPAR("USR^SRV.`"_$G(ORSRV),"ORLP DEFAULT PROVIDER",1,"I")
S ORSPEC=$$GET^XPAR("USR^SRV.`"_$G(ORSRV),"ORLP DEFAULT SPECIALTY",1,"I")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORU1 5566 printed Apr 09, 2024@21:40:27 Page 2
ORU1 ; slc/JER - More OE/RR Functions ;9/27/93 09:55
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**11**;Dec 17, 1997
PATIENT(Y,ORPGSUPP,ORSCREEN) ; Patient selection
+1 ;ORPGSUPP=1 to suppress form feed when displaying patient list
+2 ;ORSCREEN=1 to suppress Inactive Location (DIC("S")) screen when looking up by location
+3 ; .or you can pass your own DIC("S") in this parameter
+4 FOR
Begin DoDot:1
+5 NEW C,ORCEND,ORCLIN,ORCSTRT,ORDEF,ORPRIM,ORPROV,ORSPEC,OROPREF,ORCOLW,ORCNT
+6 NEW ORI,ORJ,ORUFLG,ORUPNM,ORURMBD,ORUSSN,ORUVP,ORUX,ORVP,ORX,ORY,ORWARD,I,ORTITLE
+7 SET X=""
SET @^%ZOSF("TRAP")
+8 DO PARAM
+9 IF $ORDER(^XUTL("OR",$JOB,"ORLP",0))
Begin DoDot:2
+10 SET ORTITLE=$SELECT($DATA(ORTITLE):ORTITLE,$DATA(^XUTL("OR",$JOB,"ORLP",0)):$PIECE(^(0),U),1:"CURRENT PATIENT LIST")
SET ORCOLW=40-($LENGTH(ORTITLE)\2)
SET ORUS="^XUTL(""OR"","_$JOB_",""ORLP"","
SET ORUS(0)="40MN"
+11 SET ORUS("A")="Select Patient(s): "
SET ORUS("ALT")="S ORUX=$S(X=ORSEL:X,1:ORSEL),ORUFLG=1 Q"
+12 SET ORUS("F")="^XUTL(""OR"",$J,""ORLP"","""_$SELECT($LENGTH($PIECE($GET(^XUTL("OR",$JOB,"ORLP",0)),U,3)):$PIECE(^(0),U,3),1:"B")_""","
+13 SET ORUS("H")="W $$PATHLP^ORU2(X)"
+14 SET ORUS("W")="S X=$P(^XUTL(""OR"",$J,""ORLP"",ORDA,0),U)_"" (""_$E($P(^(0),U,2),6,9)_"")"""
+15 IF OROPREF="A"
SET ORUS("W")="S X=$P(^XUTL(""OR"",$J,""ORLP"",ORDA,0),U)_"" (""_$E($P(^(0),U,2),6,9)_"")""_"" ""_$P(^(0),U,5)"
+16 IF OROPREF="R"
SET ORUS("W")="S X=$P(^XUTL(""OR"",$J,""ORLP"",ORDA,0),U,5)_"" ""_$P(^(0),U)_"" (""_$E($P(^(0),U,2),6,9)_"")"""
+17 IF OROPREF="T"
SET ORUS("W")="S X=""(""_$E($P(^XUTL(""OR"",$J,""ORLP"",ORDA,0),U,2),6,9)_"") ""_$P(^(0),U)_"" ""_$P(^(0),U,5)"
+18 IF $PIECE(^XUTL("OR",$JOB,"ORLP",0),"^",3)="D"
IF OROPREF="C"
SET ORUS("W")="S X=$P(^XUTL(""OR"",$J,""ORLP"",ORDA,0),U,6)_"" ""_$P(^(0),U)_"" (""_$E($P(^(0),U,2),6,9)_"")"""
SET ORUS(0)="80MN"
+19 SET ORUS("T")="W:'+$G(ORPGSUPP) @IOF W:+$G(ORPGSUPP) ! W ?ORCOLW,$S($D(ORTITLE):ORTITLE,1:""PATIENT LIST"") W:$D(ORPNM) !,""Current Patient: "",ORPNM W !"
+20 DO EN^ORUS
+21 IF $GET(ORUFLG)
IF $LENGTH($GET(ORUX))
DO WHATIS(ORUX,.Y)
+22 IF +Y'>0
IF $DATA(ORUX)
if $GET(ORDEF)'="P"
WRITE $CHAR(7)," ??"
End DoDot:2
+23 IF +$ORDER(^XUTL("OR",$JOB,"ORLP",0))'>0
Begin DoDot:2
+24 IF $GET(ORDEF)=""
DO GETELSE(.Y)
QUIT
+25 DO B1^ORLA1
+26 SET Y=-1
+27 IF +$DATA(^XUTL("OR",$JOB,"ORLP",0))'>0
DO GETELSE(.Y)
End DoDot:2
End DoDot:1
IF $SELECT(+$GET(Y)>0&($DATA(Y)>9):1,+$GET(Y)=0:1,$DATA(DUOUT):1,$DATA(DIROUT):1,1:0)
QUIT
PATX QUIT
GETELSE(Y) ; Get Patient if preference is ambiguous or non-existent
+1 FOR
Begin DoDot:1
+2 NEW ORUFLG,ORUS,ORUX,X
+3 KILL ^XUTL("OR",$JOB,"ORU"),^("ORV"),^("ORW")
+4 SET ORTITLE=$SELECT($DATA(ORTITLE):ORTITLE,$DATA(^XUTL("OR",$JOB,"ORLP",0)):$PIECE(^(0),U),1:"CURRENT PATIENT LIST")
+5 SET ORCOLW=40-($LENGTH(ORTITLE)\2)
+6 SET ORUS="^XUTL(""OR"","_$JOB_",""ORLP"","
SET ORUS(0)=""
+7 SET ORUS("A")="Select Patient: "
SET ORUS("ALT")="S ORUX=$S(X=ORSEL:X,1:$G(ORSEL)),ORUFLG=1 Q"
+8 SET ORUS("H")="W $$PATHLP1^ORU2(X)"
+9 DO EN^ORUS
+10 IF +$GET(Y)'>0
IF '$DATA(ORUX)
QUIT
+11 IF $LENGTH($GET(ORUX))<2
IF (ORUX?1A)
KILL ORUX
WRITE $CHAR(7)," ??"
+12 IF $GET(ORUFLG)
IF $LENGTH($GET(ORUX))
KILL ^XUTL("OR",$JOB,"ORV")
DO WHATIS(ORUX,.Y)
+13 IF +Y'>0
IF $DATA(ORUX)
if $GET(ORDEF)'="P"
WRITE $CHAR(7)," ??"
End DoDot:1
IF $SELECT(+$GET(Y)>0&($DATA(Y)>9):1,+$GET(Y)'>0:1,$DATA(DUOUT):1,$DATA(DIROUT):1,1:0)
QUIT
+14 QUIT
WHATIS(X,Y) ; Identify input
+1 NEW DIC,ORDEF,ORCLIN,ORCSTRT,ORCEND,ORWARD,ORSPEC,ORPROV,ORPRIM
+2 IF X=" "!($EXTRACT($GET(^%ZOSF("OS")),1,3)="DSM")
SET DIC=2
SET DIC(0)="MZE"
DO ^DIC
if +Y'>0
QUIT
GOTO PTX
+3 IF $LENGTH(X,".")=2
IF ("SPLspl"[$PIECE(X,"."))
Begin DoDot:1
+4 SET X=$$UPPER^ORU(X)
+5 SET DIC=$SELECT($PIECE(X,".")="S":45.7,$PIECE(X,".")="P":200,1:100.21)
SET X=$PIECE(X,".",2)
+6 SET DIC(0)="MZEI"
SET DIC("S")="I $L(X)'<2"
+7 DO ^DIC
+8 KILL DIC("S")
End DoDot:1
if +Y'>0
QUIT
GOTO PTX
+9 FOR DIC=2,44,45.7,200,100.21
Begin DoDot:1
+10 SET DIC(0)=$SELECT(DIC=2:"MZEN",1:"MZEI")
+11 IF DIC=44
Begin DoDot:2
+12 NEW X
+13 IF $EXTRACT($GET(ORSCREEN),1,2)="I "!($EXTRACT($GET(ORSCREEN),1,3)="IF ")
SET X=ORSCREEN
DO ^DIM
if $DATA(X)
SET DIC("S")=ORSCREEN
QUIT
+14 IF '$GET(ORSCREEN)
SET DIC("S")="I $S('$D(^SC(+Y,""I"")):1,'+^(""I""):1,+^(""I"")>DT:1,$P(^(""I""),""^"",2)'>DT&$P(^(""I""),""^"",2):1,1:0),'$P($G(^(""OOS"")),""^"")"
End DoDot:2
+15 if DIC=2
SET DIC("S")="I $G(DPTREF)'=""CN"""
+16 IF DIC'=2
IF DIC'=44
SET DIC("S")="I $L(X)'<2"
+17 DO ^DIC
+18 KILL DIC("S")
End DoDot:1
if +Y>0
QUIT
+19 IF +Y'>0
QUIT
PTX ;
+1 IF DIC["^DPT("
Begin DoDot:1
+2 SET Y(1)=+Y_U_$PIECE(Y,U,2)_U_" "_$PIECE(Y,U,2)_" ("_$EXTRACT($PIECE(Y(0),U,9),6,9)_")"_U_1
SET (Y,Y(0))=1
KILL Y(0,0)
End DoDot:1
QUIT
+3 if DIC["^SC("
SET ORDEF=$PIECE(Y(0),U,3)
+4 if DIC[45.7
SET ORDEF="S"
+5 if DIC[200
SET ORDEF="V"
+6 if DIC[100.21
SET ORDEF="T"
+7 IF ORDEF="C"
SET ORCLIN=+Y
SET ORCSTRT=""
SET ORCEND=""
+8 IF ORDEF="W"
SET ORWARD=+$GET(^SC(+Y,42))
+9 IF ORDEF="S"
SET ORSPEC=+Y
+10 IF ORDEF="V"
Begin DoDot:1
+11 SET ORPROV=+Y
+12 IF '$ORDER(^DPT("APR",+Y,0))
Begin DoDot:2
+13 SET ORPROV=""
+14 WRITE !!,"Provider list for "_$PIECE(Y,U,2)_" is empty."
HANG 1
+15 KILL Y
SET Y=-1
End DoDot:2
End DoDot:1
if ORPROV']""
QUIT
+16 IF ORDEF="T"
IF +$GET(Y)
Begin DoDot:1
+17 SET ORPRIM=+Y
+18 IF '+$ORDER(^OR(100.21,+ORPRIM,10,0))
Begin DoDot:2
+19 SET ORPRIM=""
+20 WRITE !!,"Team list "_$PIECE(Y,U,2)_" is empty."
HANG 1
+21 KILL Y
SET Y=-1
End DoDot:2
End DoDot:1
if $GET(ORPRIM)']""
QUIT
+22 KILL ORUX,ORUFLG
+23 DO KIL^ORLA1
DO B1^ORLA1
+24 SET Y=-1
+25 IF '$DATA(^XUTL("OR",$JOB,"ORLP"))
Begin DoDot:1
+26 WRITE !!,"List is empty."
HANG 2
End DoDot:1
+27 QUIT
PARAM ;Get patient select parameters
+1 SET OROPREF=$$GET^XPAR("USR^SRV.`"_$GET(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT LIST ORDER",1,"I")
+2 SET ORWARD=$$GET^XPAR("USR^SRV.`"_$GET(ORSRV),"ORLP DEFAULT WARD",1,"I")
+3 SET ORPRIM=$$GET^XPAR("USR^SRV.`"_$GET(ORSRV),"ORLP DEFAULT TEAM",1,"I")
+4 SET ORDEF=$$GET^XPAR("USR^SRV.`"_$GET(ORSRV),"ORLP DEFAULT LIST SOURCE",1,"I")
+5 IF ORDEF="P"
SET ORDEF="V"
+6 NEW API
+7 SET API="ORLP DEFAULT CLINIC "_$$UP^XLFSTR($$DOW^XLFDT(DT))
SET ORCLIN=$$GET^XPAR("USR^SRV.`"_$GET(ORSRV),API,1,"I")
+8 SET ORCSTRT=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_$GET(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT CLINIC START DATE",1,"E"))
+9 SET ORCEND=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_$GET(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT CLINIC STOP DATE",1,"E"))
+10 SET ORPROV=$$GET^XPAR("USR^SRV.`"_$GET(ORSRV),"ORLP DEFAULT PROVIDER",1,"I")
+11 SET ORSPEC=$$GET^XPAR("USR^SRV.`"_$GET(ORSRV),"ORLP DEFAULT SPECIALTY",1,"I")
+12 QUIT
