source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGQPTQ11.m@ 1456

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

initial load of FOIAVistA 6/30/08 version
File size: 5.7 KB
Line 
1DGQPTQ11 ; SLC/CLA - Functs which return patient lists and sources pt 1B ;12/15/97
2 ;;5.3;Registration;**447**;Aug 13, 1993
3 ;
4 ; SLC/PKS - Modified to deal with "Combination" lists - 3/2000.
5 ;
6DEFSRC(Y) ; return current user's default list source
7 Q:'$D(DUZ)
8 N FROM,API,DGSRV
9 S DGSRV=$G(^VA(200,DUZ,5)) I +DGSRV>0 S DGSRV=$P(DGSRV,U)
10 S FROM=$$GET^XPAR("USR^SRV.`"_+$G(DGSRV),"DGLP DEFAULT LIST SOURCE",1,"Q")
11 Q:'$L($G(FROM))
12 I FROM="T" S Y=$$GET^XPAR("USR^SRV.`"_+$G(DGSRV),"DGLP DEFAULT TEAM",1,"B")_"^Team"
13 I FROM="W" S Y=$$GET^XPAR("USR^SRV.`"_+$G(DGSRV),"DGLP DEFAULT WARD",1,"B")_"^Ward"
14 I FROM="P" S Y=$$GET^XPAR("USR^SRV.`"_+$G(DGSRV),"DGLP DEFAULT PROVIDER",1,"B")_"^Primary Provider"
15 I FROM="S" S Y=$$GET^XPAR("USR^SRV.`"_+$G(DGSRV),"DGLP DEFAULT SPECIALTY",1,"B")_"^Specialty"
16 I FROM="C" D
17 .S API="DGLP DEFAULT CLINIC "_$$UP^XLFSTR($$DOW^XLFDT(DT))
18 .S Y=$$GET^XPAR("USR^SRV.`"_+$G(DGSRV),API,1,"B")_"^"_$$DOW^XLFDT(DT)_" Clinic"
19 ; Next line added by PKS:
20 I FROM="M" S Y="^Combination"
21 Q
22FDEFSRC(DGDUZ) ; extrinsic function return user's (DGDUZ) default list source
23 Q:'$D(DGDUZ) "^^Error: No user identified"
24 N FROM,API,RESULT,DGSRV
25 S DGSRV=$G(^VA(200,DGDUZ,5)) I +DGSRV>0 S DGSRV=$P(DGSRV,U)
26 S FROM=$$GET^XPAR("USR.`"_DGDUZ_"^SRV.`"_+$G(DGSRV),"DGLP DEFAULT LIST SOURCE",1,"Q")
27 Q:'$L($G(FROM)) "^^No default list source specified"
28 I FROM="T" S RESULT=$$GET^XPAR("USR.`"_DGDUZ_"^SRV.`"_+$G(DGSRV),"DGLP DEFAULT TEAM",1,"B")_"^Team"
29 I FROM="W" S RESULT=$$GET^XPAR("USR.`"_DGDUZ_"^SRV.`"_+$G(DGSRV),"DGLP DEFAULT WARD",1,"B")_"^Ward"
30 I FROM="P" S RESULT=$$GET^XPAR("USR.`"_DGDUZ_"^SRV.`"_+$G(DGSRV),"DGLP DEFAULT PROVIDER",1,"B")_"^Primary Provider"
31 I FROM="S" S RESULT=$$GET^XPAR("USR.`"_ORDUZ_"^SRV.`"_+$G(ORSRV),"DGLP DEFAULT SPECIALTY",1,"B")_"^Specialty"
32 I FROM="C" D
33 .S API="DGLP DEFAULT CLINIC "_$$UP^XLFSTR($$DOW^XLFDT(DT))
34 .S RESULT=$$GET^XPAR("USR.`"_DGDUZ_"^SRV.`"_+$G(DGSRV),API,1,"B")_"^"_$$DOW^XLFDT(DT)_" Clinic"
35 ; Next line added by PKS - 3/2000:
36 I FROM="M" S RESULT="^Combination"
37 Q RESULT
38LISTSRC(DGDUZ,TYPE) ; extrinsic function return user's (DGDUZ) list source
39 ; for list type team, ward, primary provider, specialty, clinic, combination (TYPE)
40 Q:'$D(DGDUZ) "^^Error: No user identified"
41 Q:'$D(TYPE) "^^Error: No list type identified"
42 N API,RESULT,DGSRV
43 S DGSRV=$G(^VA(200,DGDUZ,5)) I +DGSRV>0 S DGSRV=$P(DGSRV,U)
44 I TYPE="T" S RESULT=$$GET^XPAR("USR.`"_DGDUZ_"^SRV.`"_+$G(DGSRV),"DGLP DEFAULT TEAM",1,"B")_"^Team"
45 I TYPE="W" S RESULT=$$GET^XPAR("USR.`"_DGDUZ_"^SRV.`"_+$G(DGSRV),"DGLP DEFAULT WARD",1,"B")_"^Ward"
46 I TYPE="P" S RESULT=$$GET^XPAR("USR.`"_DGDUZ_"^SRV.`"_+$G(DGSRV),"DGLP DEFAULT PROVIDER",1,"B")_"^Primary Provider"
47 I TYPE="S" S RESULT=$$GET^XPAR("USR.`"_DGDUZ_"^SRV.`"_+$G(DGSRV),"DGLP DEFAULT SPECIALTY",1,"B")_"^Specialty"
48 I TYPE="C" D
49 .S API="DGLP DEFAULT CLINIC "_$$UP^XLFSTR($$DOW^XLFDT(DT))
50 .S RESULT=$$GET^XPAR("USR.`"_DGDUZ_"^SRV.`"_+$G(DGSRV),API,1,"B")_"^"_$$DOW^XLFDT(DT)_" Clinic"
51 ; Next line added by PKS:
52 I TYPE="M" S RESULT="Combination"
53 I $P(RESULT,U)="" S RESULT=U_RESULT
54 Q RESULT
55DEFLIST(Y) ; return current user's default patient list
56 I $$BROKER^XWBLIB S Y=$NA(^TMP("DG",$J,"PATIENTS")) ; GUI = global.
57 I '$$BROKER^XWBLIB S ^TMP("DG",$J,"PATIENTS",0)=""
58 Q:'$D(DUZ)
59 N FROM,IEN,BEG,END,API,DGSRV,DGQDAT,DGQCNT,DGGUI
60 S DGSRV=$G(^VA(200,DUZ,5)) I +DGSRV>0 S DGSRV=$P(DGSRV,U) ; Get S/S.
61 S FROM=$$GET^XPAR("USR^SRV.`"_+$G(DGSRV),"DGLP DEFAULT LIST SOURCE",1,"Q")
62 Q:'$L($G(FROM))
63 I FROM="T" S IEN=$$GET^XPAR("USR^SRV.`"_+$G(DGSRV),"DGLP DEFAULT TEAM",1,"Q") D:+$G(IEN)>0 TEAMPTS^DGQPTQ1(.Y,IEN)
64 I FROM="W" S IEN=$$GET^XPAR("USR^SRV.`"_+$G(DGSRV),"DGLP DEFAULT WARD",1,"Q") D:+$G(IEN)>0 WARDPTS^DGQPTQ2(.Y,IEN)
65 I FROM="P" S IEN=$$GET^XPAR("USR^SRV.`"_+$G(DGSRV),"DGLP DEFAULT PROVIDER",1,"Q") D:+$G(IEN)>0 PROVPTS^DGQPTQ2(.Y,IEN)
66 I FROM="S" S IEN=$$GET^XPAR("USR^SRV.`"_+$G(DGSRV),"DGLP DEFAULT SPECIALTY",1,"Q") D:+$G(IEN)>0 SPECPTS^DGQPTQ2(.Y,IEN)
67 I FROM="C" D
68 .S API="DGLP DEFAULT CLINIC "_$$UP^XLFSTR($$DOW^XLFDT(DT)),IEN=$$GET^XPAR("USR^SRV.`"_+$G(DGSRV),API,1,"Q") I +$G(IEN)>0 D
69 ..S BEG=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$G(DGSRV)_"^DIV^SYS^PKG","DGLP DEFAULT CLINIC START DATE",1,"E"))
70 ..I BEG="T+0" S BEG=$$FMTE^XLFDT(DT,BEG)
71 ..S END=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$G(DGSRV)_"^DIV^SYS^PKG","DGLP DEFAULT CLINIC STOP DATE",1,"E"))
72 ..I END="T+0" S END=$$FMTE^XLFDT(DT,END)
73 ..D CLINPTS^DGQPTQ2(.Y,+$G(IEN),BEG,END)
74 ; Next section added by PKS:
75 I FROM="M" D
76 .S IEN=$D(^OR(100.24,DUZ,0)) I +$G(IEN)>0 S IEN=DUZ D
77 ..S BEG=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$G(DGSRV)_"^DIV^SYS^PKG","DGLP DEFAULT CLINIC START DATE",1,"E"))
78 ..I BEG="T+0" S BEG=$$FMTE^XLFDT(DT,BEG)
79 ..S END=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$G(DGSRV)_"^DIV^SYS^PKG","DGLP DEFAULT CLINIC STOP DATE",1,"E"))
80 ..I END="T+0" S END=$$FMTE^XLFDT(DT,END)
81 ..D COMBPTS^DGQPTQ6(0,+$G(IEN),BEG,END) ; "0"= GUI RPC call.
82 ; Added by PKS - 3/2001, to write to global for GUI:
83 I ($$BROKER^XWBLIB)&(FROM'="M") D ; Combinations already written to global.
84 .; Put list into a global:
85 .S DGQDAT="",DGQCNT=1
86 .F S DGQDAT=$G(Y(DGQCNT)) Q:DGQDAT="" D
87 ..S ^TMP("DG",$J,"PATIENTS",DGQCNT,0)=DGQDAT
88 ..S DGQCNT=DGQCNT+1
89 I ('$$BROKER^XWBLIB) S Y=FROM_";"_+$G(IEN)_";"_$G(BEG)_";"_$G(END) ; MKB 10/13/95
90 Q
91DEFSORT(Y) ; Return user's default "sort" for patient selection lists.
92 ; SLC/PKS - 4/6/2001
93 ;
94 N DGSORT,DGSECT,DGPARAM
95 ;
96 I ('$D(DUZ)) S Y="Unable to determine DUZ." Q
97 ;
98 ; Get user's current service/section:
99 S DGSECT=$G(^VA(200,DUZ,5))
100 I +DGSECT>0 S DGSECT=$P(DGSECT,U)
101 ;
102 ; Retrieve current sort parameter:
103 S Y="A" ; Default of "Alpha" sort.
104 S DGPARAM="DGLP DEFAULT LIST ORDER"
105 S DGSORT=$$GET^XPAR("USR^SRV.`"_$G(DGSECT)_"^DIV^SYS^PKG",DGPARAM,1,"I")
106 I (DGSORT'="") S Y=DGSORT
107 ;
108 Q
109 ;
Note: See TracBrowser for help on using the repository browser.