Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORU1

ORU1.m

Go to the documentation of this file.
  1. ORU1 ; slc/JER - More OE/RR Functions ;9/27/93 09:55
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**11**;Dec 17, 1997
  1. PATIENT(Y,ORPGSUPP,ORSCREEN) ; Patient selection
  1. ;ORPGSUPP=1 to suppress form feed when displaying patient list
  1. ;ORSCREEN=1 to suppress Inactive Location (DIC("S")) screen when looking up by location
  1. ; .or you can pass your own DIC("S") in this parameter
  1. F D I $S(+$G(Y)>0&($D(Y)>9):1,+$G(Y)=0:1,$D(DUOUT):1,$D(DIROUT):1,1:0) Q
  1. . N C,ORCEND,ORCLIN,ORCSTRT,ORDEF,ORPRIM,ORPROV,ORSPEC,OROPREF,ORCOLW,ORCNT
  1. . N ORI,ORJ,ORUFLG,ORUPNM,ORURMBD,ORUSSN,ORUVP,ORUX,ORVP,ORX,ORY,ORWARD,I,ORTITLE
  1. . S X="",@^%ZOSF("TRAP")
  1. . D PARAM
  1. . I $O(^XUTL("OR",$J,"ORLP",0)) D
  1. .. 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"
  1. .. S ORUS("A")="Select Patient(s): ",ORUS("ALT")="S ORUX=$S(X=ORSEL:X,1:ORSEL),ORUFLG=1 Q"
  1. .. S ORUS("F")="^XUTL(""OR"",$J,""ORLP"","""_$S($L($P($G(^XUTL("OR",$J,"ORLP",0)),U,3)):$P(^(0),U,3),1:"B")_""","
  1. .. S ORUS("H")="W $$PATHLP^ORU2(X)"
  1. .. S ORUS("W")="S X=$P(^XUTL(""OR"",$J,""ORLP"",ORDA,0),U)_"" (""_$E($P(^(0),U,2),6,9)_"")"""
  1. .. 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)"
  1. .. 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)_"")"""
  1. .. 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)"
  1. .. 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"
  1. .. 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 !"
  1. .. D EN^ORUS
  1. .. I $G(ORUFLG),$L($G(ORUX)) D WHATIS(ORUX,.Y)
  1. .. I +Y'>0,$D(ORUX) W:$G(ORDEF)'="P" $C(7)," ??"
  1. . I +$O(^XUTL("OR",$J,"ORLP",0))'>0 D
  1. .. I $G(ORDEF)="" D GETELSE(.Y) Q
  1. .. D B1^ORLA1
  1. .. S Y=-1
  1. .. I +$D(^XUTL("OR",$J,"ORLP",0))'>0 D GETELSE(.Y)
  1. PATX Q
  1. GETELSE(Y) ; Get Patient if preference is ambiguous or non-existent
  1. F D I $S(+$G(Y)>0&($D(Y)>9):1,+$G(Y)'>0:1,$D(DUOUT):1,$D(DIROUT):1,1:0) Q
  1. . N ORUFLG,ORUS,ORUX,X
  1. . K ^XUTL("OR",$J,"ORU"),^("ORV"),^("ORW")
  1. . S ORTITLE=$S($D(ORTITLE):ORTITLE,$D(^XUTL("OR",$J,"ORLP",0)):$P(^(0),U),1:"CURRENT PATIENT LIST")
  1. . S ORCOLW=40-($L(ORTITLE)\2)
  1. . S ORUS="^XUTL(""OR"","_$J_",""ORLP"",",ORUS(0)=""
  1. . S ORUS("A")="Select Patient: ",ORUS("ALT")="S ORUX=$S(X=ORSEL:X,1:$G(ORSEL)),ORUFLG=1 Q"
  1. . S ORUS("H")="W $$PATHLP1^ORU2(X)"
  1. . D EN^ORUS
  1. . I +$G(Y)'>0,'$D(ORUX) Q
  1. . I $L($G(ORUX))<2,(ORUX?1A) K ORUX W $C(7)," ??"
  1. . I $G(ORUFLG),$L($G(ORUX)) K ^XUTL("OR",$J,"ORV") D WHATIS(ORUX,.Y)
  1. . I +Y'>0,$D(ORUX) W:$G(ORDEF)'="P" $C(7)," ??"
  1. Q
  1. WHATIS(X,Y) ; Identify input
  1. N DIC,ORDEF,ORCLIN,ORCSTRT,ORCEND,ORWARD,ORSPEC,ORPROV,ORPRIM
  1. I X=" "!($E($G(^%ZOSF("OS")),1,3)="DSM") S DIC=2,DIC(0)="MZE" D ^DIC Q:+Y'>0 G PTX
  1. I $L(X,".")=2,("SPLspl"[$P(X,".")) D Q:+Y'>0 G PTX
  1. . S X=$$UPPER^ORU(X)
  1. . S DIC=$S($P(X,".")="S":45.7,$P(X,".")="P":200,1:100.21),X=$P(X,".",2)
  1. . S DIC(0)="MZEI",DIC("S")="I $L(X)'<2"
  1. . D ^DIC
  1. . K DIC("S")
  1. F DIC=2,44,45.7,200,100.21 D Q:+Y>0
  1. . S DIC(0)=$S(DIC=2:"MZEN",1:"MZEI")
  1. . I DIC=44 D
  1. .. N X
  1. .. 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
  1. .. 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"")),""^"")"
  1. . S:DIC=2 DIC("S")="I $G(DPTREF)'=""CN"""
  1. . I DIC'=2,DIC'=44 S DIC("S")="I $L(X)'<2"
  1. . D ^DIC
  1. . K DIC("S")
  1. I +Y'>0 Q
  1. PTX ;
  1. I DIC["^DPT(" D Q
  1. . 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)
  1. S:DIC["^SC(" ORDEF=$P(Y(0),U,3)
  1. S:DIC[45.7 ORDEF="S"
  1. S:DIC[200 ORDEF="V"
  1. S:DIC[100.21 ORDEF="T"
  1. I ORDEF="C" S ORCLIN=+Y,ORCSTRT="",ORCEND=""
  1. I ORDEF="W" S ORWARD=+$G(^SC(+Y,42))
  1. I ORDEF="S" S ORSPEC=+Y
  1. I ORDEF="V" D Q:ORPROV']""
  1. . S ORPROV=+Y
  1. . I '$O(^DPT("APR",+Y,0)) D
  1. .. S ORPROV=""
  1. .. W !!,"Provider list for "_$P(Y,U,2)_" is empty." H 1
  1. .. K Y S Y=-1
  1. I ORDEF="T",+$G(Y) D Q:$G(ORPRIM)']""
  1. . S ORPRIM=+Y
  1. . I '+$O(^OR(100.21,+ORPRIM,10,0)) D
  1. .. S ORPRIM=""
  1. .. W !!,"Team list "_$P(Y,U,2)_" is empty." H 1
  1. .. K Y S Y=-1
  1. K ORUX,ORUFLG
  1. D KIL^ORLA1,B1^ORLA1
  1. S Y=-1
  1. I '$D(^XUTL("OR",$J,"ORLP")) D
  1. . W !!,"List is empty." H 2
  1. Q
  1. PARAM ;Get patient select parameters
  1. S OROPREF=$$GET^XPAR("USR^SRV.`"_$G(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT LIST ORDER",1,"I")
  1. S ORWARD=$$GET^XPAR("USR^SRV.`"_$G(ORSRV),"ORLP DEFAULT WARD",1,"I")
  1. S ORPRIM=$$GET^XPAR("USR^SRV.`"_$G(ORSRV),"ORLP DEFAULT TEAM",1,"I")
  1. S ORDEF=$$GET^XPAR("USR^SRV.`"_$G(ORSRV),"ORLP DEFAULT LIST SOURCE",1,"I")
  1. I ORDEF="P" S ORDEF="V"
  1. N API
  1. S API="ORLP DEFAULT CLINIC "_$$UP^XLFSTR($$DOW^XLFDT(DT)),ORCLIN=$$GET^XPAR("USR^SRV.`"_$G(ORSRV),API,1,"I")
  1. S ORCSTRT=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_$G(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT CLINIC START DATE",1,"E"))
  1. S ORCEND=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_$G(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT CLINIC STOP DATE",1,"E"))
  1. S ORPROV=$$GET^XPAR("USR^SRV.`"_$G(ORSRV),"ORLP DEFAULT PROVIDER",1,"I")
  1. S ORSPEC=$$GET^XPAR("USR^SRV.`"_$G(ORSRV),"ORLP DEFAULT SPECIALTY",1,"I")
  1. Q