- 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 Dec 13, 2024@02:34:22 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