source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGWPT1.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: 3.5 KB
Line 
1DGWPT1 ; SLC/KCM - Patient Lookup Functions (cont) ;3/1/01
2 ;;5.3;Registration;**447**;Aug 13, 1993
3 ;
4SAVDFLT ; continued from DGWPT, save new default patient list
5 N DAY,HOLDX S OK=1
6 I $P(X,U)="P" D
7 . D EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT LIST SOURCE",1,"P")
8 . D EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT PROVIDER",1,"`"_$P(X,U,2))
9 I $P(X,U)="T" D
10 . D EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT LIST SOURCE",1,"T")
11 . D EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT TEAM",1,"`"_$P(X,U,2))
12 I $P(X,U)="S" D
13 . D EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT LIST SOURCE",1,"S")
14 . D EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT SPECIALTY",1,"`"_$P(X,U,2))
15 I $P(X,U)="C" D
16 . D EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT LIST SOURCE",1,"C")
17 . F DAY="MONDAY","TUESDAY","WEDNESDAY","THURSDAY","FRIDAY","SATURDAY","SUNDAY" D EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT CLINIC "_DAY,1,"`"_$P(X,U,2))
18 . D EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT CLINIC START DATE",1,$P($P(X,U,3),";"))
19 . D EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT CLINIC STOP DATE",1,$P($P(X,U,3),";",2))
20 ; SLC/PKS - 6/25/2001
21 ; Added section to save clinic defaults for current day only:
22 I $P(X,U)="CT" D
23 . D EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT LIST SOURCE",1,"C")
24 . S HOLDX=X
25 . D NOW^%DTC D DW^%DTC S DAY=X S X=HOLDX
26 . D EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT CLINIC "_DAY,1,"`"_$P(X,U,2))
27 . D EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT CLINIC START DATE",1,$P($P(X,U,3),";"))
28 . D EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT CLINIC STOP DATE",1,$P($P(X,U,3),";",2))
29 I $P(X,U)="W" D
30 . D EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT LIST SOURCE",1,"W")
31 . D EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT WARD",1,"`"_$P(X,U,2))
32 I $P(X,U)="A" D DEL^XPAR(DUZ_";VA(200,","ORLP DEFAULT LIST SOURCE",1)
33 Q
34PRCARE(VAL,PATIENT) ; return Primary Care info
35 ; VAL=Primary Care Team^Primary Care Provider^Attending
36 N PCT,PCP,ATT
37 S PCT=$P($$OUTPTTM^SDUTL3(PATIENT,DT),U,2)
38 S PCP=$P($$OUTPTPR^SDUTL3(PATIENT,DT),U,2)
39 S ATT=$G(^DPT(PATIENT,.1041)) I ATT S ATT=$P($G(^VA(200,ATT,0)),U)
40 S VAL=PCT_U_PCP_U_ATT
41 Q
42PCDETAIL(LST,PATIENT) ; return Primary Care Detail information
43 N ILST,X S ILST=0
44 S X=$$OUTPTTM^SDUTL3(PATIENT,DT)
45 I +X>0 D
46 . S ILST=ILST+1,LST(ILST)=" Primary Care Team: "_$P(X,U,2)
47 . S ILST=ILST+1,LST(ILST)=" Phone: "_$P($G(^SCTM(404.51,+X,0)),U,2)
48 E S ILST=ILST+1,LST(ILST)="No Primary Care Team Assigned."
49 S ILST=ILST+1,LST(ILST)=" "
50 S X=$$OUTPTPR^SDUTL3(PATIENT,DT)
51 I +X>0 D
52 . S ILST=ILST+1,LST(ILST)="Primary Care Provider: "_$P(X,U,2)
53 . S ILST=ILST+1,LST(ILST)=" Analog Pager: "_$P($G(^VA(200,+X,.13)),U,7)
54 . S ILST=ILST+1,LST(ILST)=" Digital Pager: "_$P($G(^VA(200,+X,.13)),U,8)
55 . S ILST=ILST+1,LST(ILST)=" Office Phone: "_$P($G(^VA(200,+X,.13)),U,2)
56 E S ILST=ILST+1,LST(ILST)="No Primary Care Provider Assigned."
57 S ILST=ILST+1,LST(ILST)=" "
58 S X=$$OUTPTAP^SDUTL3(PATIENT,DT)
59 I +X>0 D
60 . S ILST=ILST+1,LST(ILST)=" Associate Provider: "_$P(X,U,2)
61 . S ILST=ILST+1,LST(ILST)=" Analog Pager: "_$P($G(^VA(200,+X,.13)),U,7)
62 . S ILST=ILST+1,LST(ILST)=" Digital Pager: "_$P($G(^VA(200,+X,.13)),U,8)
63 . S ILST=ILST+1,LST(ILST)=" Office Phone: "_$P($G(^VA(200,+X,.13)),U,2)
64 E S ILST=ILST+1,LST(ILST)="No Associate Provider Assigned."
65 S ILST=ILST+1,LST(ILST)=" "
66 S X=$G(^DPT(PATIENT,.1041))
67 I +X D
68 . S ILST=ILST+1,LST(ILST)=" Attending Physician: "_$P($G(^VA(200,+X,0)),U)
69 . S ILST=ILST+1,LST(ILST)=" Analog Pager: "_$P($G(^VA(200,+X,.13)),U,7)
70 . S ILST=ILST+1,LST(ILST)=" Digital Pager: "_$P($G(^VA(200,+X,.13)),U,8)
71 . S ILST=ILST+1,LST(ILST)=" Office Phone: "_$P($G(^VA(200,+X,.13)),U,2)
72 Q
Note: See TracBrowser for help on using the repository browser.