source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORLP01.m

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

initial load of FOIAVistA 6/30/08 version

File size: 5.9 KB
Line 
1ORLP01 ; SLC/MKB,CLA - Edit Patient Lists cont ; 20 Sep 2005 1:05 PM
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**11,47,215**;Dec 17, 1997
3 ;
4 ; DBIA 3869 GETPLIST^SDAMA202 ^TMP($J,"SDAMA202")
5 ;
6 ; Modified 3/2000 by PKS/SLC to screen out inactive wards, clinics,
7 ; and terminated/deactivated providers.
8 ;
9PROV ;from ASKPT^ORLP00, option ORLP ADD PROVIDER - Add provider's patients to list, display # of patients added if not TEAM list
10 D ASK^ORLP0(.X)
11 I (X<0)!(X>1) Q
12 S:'$D(ORCNT) ORCNT=$S($D(^XUTL("OR",$J,"ORLP",0)):+$P(^(0),"^",4),1:0)
13 F S ORCT=0 D P1 Q:+ORY<1 I ORCNT>0 W:'($D(TEAM)#2) !!,ORCT_" Patients added, "_ORCNT_" total"
14 I $G(DUOUT)=1!(ORCNT'>0) W:'($D(TEAM)#2) !!,"No patients added.",! K ORCNT G END^ORLP0
15 D SEQ^ORLP0
16 Q
17 ;
18P1 ;
19 K DIC
20 S DIC=200,DIC(0)="AEQ",DIC("A")="Select PROVIDER: ",D="AK.PROVIDER^PS1^PS2^B"
21 ; Setting of DIC("S") modified by PKS:
22 S DIC("S")="I $D(^VA(200,""AK.PROVIDER"",$P(^(0),U))),$$ACTIVE^XUSER(+Y)"
23 N ORPTYP,DIR
24 D MIX^DIC1
25 K DIC
26 S ORY=Y
27 Q:+Y<1
28 S ORZ=+Y
29 F D I $D(DIRUT)!Y]""!(Y["^") S ORY=-1 Q
30 . S DIR(0)="S^P:PRIMARY CARE PHYSICIAN;A:ATTENDING PHYSICIAN;B:BOTH",DIR("A")="Select",DIR("B")="BOTH"
31 . S DIR("?",1)="In order to determine how this Provider's patients will be added to this list,"
32 . S DIR("?",2)="enter a response that will use the following rules."
33 . S DIR("?",3)=" 'P' - Primary will add patients to the list that have the chosen provider"
34 . S DIR("?",4)="assigned to them thru the MAS options as PRIMARY CARE PHYSICIAN."
35 . S DIR("?",5)=" 'A' - Attending will add patients to the list that have chosen provider"
36 . S DIR("?",6)="assigned to them thru the MAS options as ATTENDING PHYSICIAN."
37 . S DIR("?",7)=" 'B' - Both will add patients to the list that have the chosen provider"
38 . S DIR("?")="assigned to them thru the MAS options as PRIMARY CARE PHYSICIAN or ATTENDING PHYSICIAN."
39 . D ^DIR
40 . Q:Y']""
41 . S ORPTYP=Y
42 Q:$S($G(ORPTYP)']"":1,"ABP"'[$G(ORPTYP):1,1:0)
43 I '$D(^DPT("APR",ORZ)),'$D(^DPT("AAP",ORZ)) W !!,"No patients found for this provider!" Q
44 W !!,"Working..."
45 D PREF^ORLP0
46 I "BP"[ORPTYP S ORJ=0 F S ORJ=$O(^DPT("APR",ORZ,ORJ)) Q:ORJ<1 S ORX="",ORVP=ORJ_";DPT(" D PR1^ORLA1(ORVP,OROPREF)
47 I "AB"[ORPTYP S ORJ=0 F ORI=0:0 S ORJ=$O(^DPT("AAP",ORZ,ORJ)) Q:ORJ<1 S ORX="",ORVP=ORJ_";DPT(" D PR1^ORLA1(ORVP,OROPREF)
48 Q
49 ;
50SPEC ; from ASKPT^ORLP00, option ORLP ADD SPECIALTY - Add treating specialty's patients to list, display # of patients added if not TEAM list
51 D ASK^ORLP0(.X)
52 I (X<0)!(X>1) Q
53 S:'$D(ORCNT) ORCNT=$S($D(^XUTL("OR",$J,"ORLP",0)):+$P(^(0),"^",4),1:0)
54 F S ORCT=0 D S1 Q:+ORY<1 I ORCNT>0 W:'($D(TEAM)#2) !!,ORCT_" Patients added, "_ORCNT_" total"
55 I $G(DUOUT)=1!(ORCNT'>0) W:'($D(TEAM)#2) !!,"No patients added.",! G END^ORLP0
56 D SEQ^ORLP0
57 Q
58 ;
59S1 ;
60 K DIC
61 S DIC="^DIC(45.7,",DIC(0)="AQEM",DIC("A")="Select SPECIALTY: "
62 D ^DIC
63 S ORY=Y
64 K DIC
65 Q:+Y<1
66 I '$D(^DPT("ATR",+ORY)) W !!,"No patients found for this treating specialty!" Q
67 W !!,"Working..."
68 D PREF^ORLP0
69 S ORJ=0 F S ORJ=$O(^DPT("ATR",+ORY,ORJ)) Q:ORJ<1 S ORX="",ORVP=ORJ_";DPT(" D PR1^ORLA1(ORVP,OROPREF)
70 Q
71 ;
72WARD ;from ASKPT^ORLP00, option ORLP ADD WARD - Add ward's patients to list, display # of patients added if not TEAM list
73 D ASK^ORLP0(.X)
74 I (X<0)!(X>1) Q
75 S:'$D(ORCNT) ORCNT=$S($D(^XUTL("OR",$J,"ORLP",0)):+$P(^(0),"^",4),1:0)
76 F S ORCT=0 D W1 Q:+ORY<1 I ORCNT>0 W:'($D(TEAM)#2) !!,ORCT_" Patients added, "_ORCNT_" total"
77 I $G(DUOUT)=1!(ORCNT'>0) W:'($D(TEAM)#2) !!,"No patients added.",! G END^ORLP0
78 D SEQ^ORLP0
79 Q
80 ;
81W1 ;
82 K DIC
83 S DIC="^DIC(42,",DIC(0)="AQEM"
84 ; Next line added by PKS:
85 S DIC("S")="I '$$WINACT^ORLP3U1(+Y)"
86 D ^DIC
87 S ORY=Y
88 K DIC
89 Q:+Y<1
90 I '$D(^DPT("CN",$P(Y,"^",2))) W !!,"No Patients found on ward!" Q
91 W !!,"Working..."
92 D PREF^ORLP0
93 S ORJ=0 F S ORJ=$O(^DPT("CN",$P(ORY,"^",2),ORJ)) Q:ORJ<1 S ORVP=ORJ_";DPT(",ORX="" D PR1^ORLA1(ORVP,OROPREF)
94 Q
95 ;
96CLIN ;from ASKPT^ORLP, option ORLP ADD CLINIC - Add clinic's patients to list, display # of patients added if not TEAM list
97 D ASK^ORLP0(.X)
98 I (X<0)!(X>1) Q
99 S:'$D(ORCNT) ORCNT=$S($D(^XUTL("OR",$J,"ORLP",0)):+$P(^(0),"^",4),1:0)
100 F S ORCT=0 D C1 Q:+ORY<1 I ORCNT>0 W:'($D(TEAM)#2) !!,ORCT_" Patients added, "_ORCNT_" total"
101 I $G(DUOUT)=1!(ORCNT'>0) W:'($D(TEAM)#2) !!,"No patients added.",! G END^ORLP0
102 D SEQ^ORLP0
103 Q
104 ;
105C1 ; DBIA 3869
106 K DIC
107 S DIC("A")="Select CLINIC: ",ORCT=0,ORCSTRT="",ORCEND="",ORCLIN=""
108 S DIC("S")="I $P(^(0),""^"",3)=""C"""
109 D LOC
110 K DIC
111 S ORY=Y
112 Q:+Y<1
113 S ORCLIN=+Y,ORDEF="C"
114 W:$L(ORCSTRT) !,"Starting date: "
115 S %DT=$S($L(ORCSTRT):"E",1:"AE"),X=$S($L(ORCSTRT):ORCSTRT,1:"")
116 S:'$L(ORCSTRT) %DT("A")="Patient Appointment STARTING DATE: ",%DT("B")="T"
117 D ^%DT
118 I Y<0 S OREND=1 Q
119 S ORCSTRT=Y
120 D DD^%DT
121 W:$L(ORCEND) !,"Ending date: "
122 S %DT=$S($L(ORCEND):"E",1:"AE"),X=$S($L(ORCEND):ORCEND,1:"")
123 S:'$L(ORCEND) %DT("A")="Patient Appointment ENDING DATE: ",%DT("B")=Y
124 D ^%DT
125 I Y<0 S OREND=1 Q
126 S ORCEND=$P(Y,".")_.5
127 I ORCEND<ORCSTRT S ORCTMP=ORCEND,ORCEND=ORCSTRT,ORCSTRT=ORCTMP K ORCTMP
128 W !,"Working..."
129 D PREF^ORLP0
130 S ORJ=ORCSTRT
131 N ORI,ORERR
132 K ^TMP($J,"SDAMA202","GETPLIST")
133 D GETPLIST^SDAMA202(+ORCLIN,"1;4","",ORCSTRT,ORCEND) ;DBIA 3869
134 S ORERR=$$CLINERR^ORQRY01
135 I $L(ORERR) W !,ORERR S ORY=-1,ORCNT=0 Q
136 S ORI=0
137 F S ORI=$O(^TMP($J,"SDAMA202","GETPLIST",ORI)) Q:ORI<1 D ;DBIA 3869
138 . S ORJ=+$G(^TMP($J,"SDAMA202","GETPLIST",ORI,1))
139 . S ORVP=+$G(^TMP($J,"SDAMA202","GETPLIST",ORI,4))_";DPT("
140 . I ORJ,ORVP S ORX="" D PR1^ORLA1(ORVP,OROPREF)
141 K ^TMP($J,"SDAMA202","GETPLIST")
142 I '$L($O(^XUTL("OR",$J,"ORLP",0))) W *7,!,"No patients found!"
143 Q
144 ;
145LOC ;Hospital Location Look-up For Clinics
146 ; Copied from ORUTL and modified by PKS.
147 N DIC,ORIA,ORRA
148 S DIC=44,DIC(0)="AEQM"
149 ; Setting of DIC("S") modified by PKS:
150 S DIC("S")="I $D(X),$P(^SC(+Y,0),U,3)=""C"",$$ACTLOC^ORWU(+Y)=1"
151 D ^DIC
152 I Y<1 Q
153 I $D(^SC(+Y,"I")) S ORIA=+^("I"),ORRA=$P(^("I"),U,2)
154 I $S('$D(ORIA):0,'ORIA:0,ORIA>DT:0,ORRA'>DT&(ORRA):0,1:1) W $C(7),!," This location has been inactivated.",! K ORL G LOC
155 Q
156 ;
Note: See TracBrowser for help on using the repository browser.