source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORU1.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 5.3 KB
Line 
1ORU1 ; slc/JER - More OE/RR Functions ;9/27/93 09:55
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**11**;Dec 17, 1997
3PATIENT(Y,ORPGSUPP,ORSCREEN) ; Patient selection
4 ;ORPGSUPP=1 to suppress form feed when displaying patient list
5 ;ORSCREEN=1 to suppress Inactive Location (DIC("S")) screen when looking up by location
6 ; .or you can pass your own DIC("S") in this parameter
7 F D I $S(+$G(Y)>0&($D(Y)>9):1,+$G(Y)=0:1,$D(DUOUT):1,$D(DIROUT):1,1:0) Q
8 . N C,ORCEND,ORCLIN,ORCSTRT,ORDEF,ORPRIM,ORPROV,ORSPEC,OROPREF,ORCOLW,ORCNT
9 . N ORI,ORJ,ORUFLG,ORUPNM,ORURMBD,ORUSSN,ORUVP,ORUX,ORVP,ORX,ORY,ORWARD,I,ORTITLE
10 . S X="",@^%ZOSF("TRAP")
11 . D PARAM
12 . I $O(^XUTL("OR",$J,"ORLP",0)) D
13 .. 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"
14 .. S ORUS("A")="Select Patient(s): ",ORUS("ALT")="S ORUX=$S(X=ORSEL:X,1:ORSEL),ORUFLG=1 Q"
15 .. S ORUS("F")="^XUTL(""OR"",$J,""ORLP"","""_$S($L($P($G(^XUTL("OR",$J,"ORLP",0)),U,3)):$P(^(0),U,3),1:"B")_""","
16 .. S ORUS("H")="W $$PATHLP^ORU2(X)"
17 .. S ORUS("W")="S X=$P(^XUTL(""OR"",$J,""ORLP"",ORDA,0),U)_"" (""_$E($P(^(0),U,2),6,9)_"")"""
18 .. 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)"
19 .. 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)_"")"""
20 .. 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)"
21 .. 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"
22 .. 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 !"
23 .. D EN^ORUS
24 .. I $G(ORUFLG),$L($G(ORUX)) D WHATIS(ORUX,.Y)
25 .. I +Y'>0,$D(ORUX) W:$G(ORDEF)'="P" $C(7)," ??"
26 . I +$O(^XUTL("OR",$J,"ORLP",0))'>0 D
27 .. I $G(ORDEF)="" D GETELSE(.Y) Q
28 .. D B1^ORLA1
29 .. S Y=-1
30 .. I +$D(^XUTL("OR",$J,"ORLP",0))'>0 D GETELSE(.Y)
31PATX Q
32GETELSE(Y) ; Get Patient if preference is ambiguous or non-existent
33 F D I $S(+$G(Y)>0&($D(Y)>9):1,+$G(Y)'>0:1,$D(DUOUT):1,$D(DIROUT):1,1:0) Q
34 . N ORUFLG,ORUS,ORUX,X
35 . K ^XUTL("OR",$J,"ORU"),^("ORV"),^("ORW")
36 . S ORTITLE=$S($D(ORTITLE):ORTITLE,$D(^XUTL("OR",$J,"ORLP",0)):$P(^(0),U),1:"CURRENT PATIENT LIST")
37 . S ORCOLW=40-($L(ORTITLE)\2)
38 . S ORUS="^XUTL(""OR"","_$J_",""ORLP"",",ORUS(0)=""
39 . S ORUS("A")="Select Patient: ",ORUS("ALT")="S ORUX=$S(X=ORSEL:X,1:$G(ORSEL)),ORUFLG=1 Q"
40 . S ORUS("H")="W $$PATHLP1^ORU2(X)"
41 . D EN^ORUS
42 . I +$G(Y)'>0,'$D(ORUX) Q
43 . I $L($G(ORUX))<2,(ORUX?1A) K ORUX W $C(7)," ??"
44 . I $G(ORUFLG),$L($G(ORUX)) K ^XUTL("OR",$J,"ORV") D WHATIS(ORUX,.Y)
45 . I +Y'>0,$D(ORUX) W:$G(ORDEF)'="P" $C(7)," ??"
46 Q
47WHATIS(X,Y) ; Identify input
48 N DIC,ORDEF,ORCLIN,ORCSTRT,ORCEND,ORWARD,ORSPEC,ORPROV,ORPRIM
49 I X=" "!($E($G(^%ZOSF("OS")),1,3)="DSM") S DIC=2,DIC(0)="MZE" D ^DIC Q:+Y'>0 G PTX
50 I $L(X,".")=2,("SPLspl"[$P(X,".")) D Q:+Y'>0 G PTX
51 . S X=$$UPPER^ORU(X)
52 . S DIC=$S($P(X,".")="S":45.7,$P(X,".")="P":200,1:100.21),X=$P(X,".",2)
53 . S DIC(0)="MZEI",DIC("S")="I $L(X)'<2"
54 . D ^DIC
55 . K DIC("S")
56 F DIC=2,44,45.7,200,100.21 D Q:+Y>0
57 . S DIC(0)=$S(DIC=2:"MZEN",1:"MZEI")
58 . I DIC=44 D
59 .. N X
60 .. 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
61 .. 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"")),""^"")"
62 . S:DIC=2 DIC("S")="I $G(DPTREF)'=""CN"""
63 . I DIC'=2,DIC'=44 S DIC("S")="I $L(X)'<2"
64 . D ^DIC
65 . K DIC("S")
66 I +Y'>0 Q
67PTX ;
68 I DIC["^DPT(" D Q
69 . 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)
70 S:DIC["^SC(" ORDEF=$P(Y(0),U,3)
71 S:DIC[45.7 ORDEF="S"
72 S:DIC[200 ORDEF="V"
73 S:DIC[100.21 ORDEF="T"
74 I ORDEF="C" S ORCLIN=+Y,ORCSTRT="",ORCEND=""
75 I ORDEF="W" S ORWARD=+$G(^SC(+Y,42))
76 I ORDEF="S" S ORSPEC=+Y
77 I ORDEF="V" D Q:ORPROV']""
78 . S ORPROV=+Y
79 . I '$O(^DPT("APR",+Y,0)) D
80 .. S ORPROV=""
81 .. W !!,"Provider list for "_$P(Y,U,2)_" is empty." H 1
82 .. K Y S Y=-1
83 I ORDEF="T",+$G(Y) D Q:$G(ORPRIM)']""
84 . S ORPRIM=+Y
85 . I '+$O(^OR(100.21,+ORPRIM,10,0)) D
86 .. S ORPRIM=""
87 .. W !!,"Team list "_$P(Y,U,2)_" is empty." H 1
88 .. K Y S Y=-1
89 K ORUX,ORUFLG
90 D KIL^ORLA1,B1^ORLA1
91 S Y=-1
92 I '$D(^XUTL("OR",$J,"ORLP")) D
93 . W !!,"List is empty." H 2
94 Q
95PARAM ;Get patient select parameters
96 S OROPREF=$$GET^XPAR("USR^SRV.`"_$G(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT LIST ORDER",1,"I")
97 S ORWARD=$$GET^XPAR("USR^SRV.`"_$G(ORSRV),"ORLP DEFAULT WARD",1,"I")
98 S ORPRIM=$$GET^XPAR("USR^SRV.`"_$G(ORSRV),"ORLP DEFAULT TEAM",1,"I")
99 S ORDEF=$$GET^XPAR("USR^SRV.`"_$G(ORSRV),"ORLP DEFAULT LIST SOURCE",1,"I")
100 I ORDEF="P" S ORDEF="V"
101 N API
102 S API="ORLP DEFAULT CLINIC "_$$UP^XLFSTR($$DOW^XLFDT(DT)),ORCLIN=$$GET^XPAR("USR^SRV.`"_$G(ORSRV),API,1,"I")
103 S ORCSTRT=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_$G(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT CLINIC START DATE",1,"E"))
104 S ORCEND=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_$G(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT CLINIC STOP DATE",1,"E"))
105 S ORPROV=$$GET^XPAR("USR^SRV.`"_$G(ORSRV),"ORLP DEFAULT PROVIDER",1,"I")
106 S ORSPEC=$$GET^XPAR("USR^SRV.`"_$G(ORSRV),"ORLP DEFAULT SPECIALTY",1,"I")
107 Q
Note: See TracBrowser for help on using the repository browser.