source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDAMEP1.m@ 862

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

initial load of WorldVistAEHR
File size: 4.0 KB
RevLine 
[613]1SDAMEP1 ;ALB/CAW - Expanded Display (Appt. Data) ; 16 May 2001 4:49 PM
2 ;;5.3;Scheduling;**20,241**;Aug 13, 1993
3 ;
4APDATA ; Appointment Data
5 ;
6 D SET($$SETSTR^VALM1("*** Appointment Demographics ***","",24,32))
7 D CNTRL^VALM10(SDLN,24,32,IOINHI,IOINORM)
8 D SET("")
9 ;
10 S X=""
11 S X=$$SETSTR^VALM1(" Name:",X,1,SDWIDTH)
12 S X=$$SETSTR^VALM1($P($G(^DPT(DFN,0)),U),X,SDFSTCOL,24)
13 S X=$$SETSTR^VALM1(" Clinic:",X,40,SDWIDTH)
14 S X=$$SETSTR^VALM1($P($G(^SC(SDCL,0)),U),X,SDSECCOL,24)
15 D SET(X)
16 ;
17 S X=""
18 S X=$$SETSTR^VALM1(" ID:",X,1,SDWIDTH)
19 S X=$$SETSTR^VALM1(VA("PID"),X,SDFSTCOL,24)
20 S X=$$SETSTR^VALM1(" Date/Time:",X,40,SDWIDTH)
21 S X=$$SETSTR^VALM1($$FTIME^VALM1(SDT),X,SDSECCOL,24)
22 D SET(X)
23 ;
24 S X=""
25 S X=$$SETSTR^VALM1(" Status:",X,1,SDWIDTH)
26 S X=$$SETSTR^VALM1($P($$STATUS^SDAM1(DFN,SDT,SDCL,$G(^DPT(DFN,"S",SDT,0)),SDDA),";",3),X,SDFSTCOL,50)
27 D SET(X)
28 ;
29 S SDPV=$P($G(^DPT(DFN,"S",SDT,0)),U,7),SDPOV=$S(SDPV=1:"C&P",SDPV=2:"10-10",SDPV=3:"SCHEDULED",SDPV=4:"UNSCHEDULED",1:"UNKNOWN")
30 S X="",X=$$SETSTR^VALM1("Purpose of Vst.:",X,1,16)
31 S X=$$SETSTR^VALM1(SDPOV,X,SDFSTCOL,24)
32 D SET(X)
33 ;
34 S X=""
35 S X=$$SETSTR^VALM1(" Length of Appt:",X,1,SDWIDTH)
36 S X=$$SETSTR^VALM1($G(SDSC(44.003,SDDA,1)),X,SDFSTCOL,4)
37 S X=$$SETSTR^VALM1(" Appt Type:",X,40,SDWIDTH)
38 S X=$$SETSTR^VALM1(SDPT(2.98,SDT,9.5),X,SDSECCOL,24)
39 D SET(X)
40 ;
41 S X=""
42 S X=$$SETSTR^VALM1(" Lab:",X,1,SDWIDTH)
43 S X=$$SETSTR^VALM1($P(SDPT(2.98,SDT,5),"@",2),X,SDFSTCOL,5)
44 S X=$$SETSTR^VALM1(" Elig of Appt:",X,40,SDWIDTH)
45 S X=$$SETSTR^VALM1($G(SDSC(44.003,SDDA,30)),X,SDSECCOL,24)
46 D SET(X)
47 ;
48 S X=""
49 S X=$$SETSTR^VALM1(" X-ray:",X,1,SDWIDTH)
50 S X=$$SETSTR^VALM1($P(SDPT(2.98,SDT,6),"@",2),X,SDFSTCOL,5)
51 S X=$$SETSTR^VALM1(" Overbook:",X,40,SDWIDTH)
52 S X=$$SETSTR^VALM1($G(SDSC(44.003,SDDA,9)),X,SDSECCOL,24)
53 D SET(X)
54 ;
55 S X=""
56 S X=$$SETSTR^VALM1(" EKG:",X,1,SDWIDTH)
57 S X=$$SETSTR^VALM1($P(SDPT(2.98,SDT,7),"@",2),X,SDFSTCOL,5)
58 S X=$$SETSTR^VALM1("Collateral Appt:",X,40,SDWIDTH)
59 S X=$$SETSTR^VALM1($G(SDPT(2.98,SDT,13)),X,SDSECCOL,17)
60 D SET(X)
61 ;
62 S X=""
63 S X=$$SETSTR^VALM1(" Other Info:",X,1,SDWIDTH)
64 S X=$$SETSTR^VALM1($G(SDSC(44.003,SDDA,3)),X,SDFSTCOL,60)
65 D SET(X)
66 ;
67 ;
68 S (X,SDEIC)="" F SDI=0:0 S SDI=$O(^DPT(DFN,"DE",SDI)) Q:'SDI I $P(^(SDI,0),U)=SDCL F SDX=0:0 S SDX=$O(^DPT(DFN,"DE",SDI,1,SDX)) Q:'SDX S SDEN=$G(^DPT(DFN,"DE",SDI,1,SDX,0))
69 D ENROLL
70 D SET($S($D(SDFLG):X,1:" "))
71 S X="",X=$$SETSTR^VALM1($S('$D(SDEN):"",$P(SDEN,U)="":"",$P(SDEN,U,3)="":"Enrollment Date/Time:",1:""),X,4,21)
72 I $D(SDEN),+SDEN,$P(SDEN,U,3)="" S X=$$SETSTR^VALM1($$FTIME^VALM1($P(SDEN,U)),X,26,18)
73 D SET(X)
74 Q
75 ;
76ENROLL ;
77 S SDFLG=1
78 S X="",X=$$SETSTR^VALM1("Enrolled in this clinic:",X,1,25)
79 S X=$$SETSTR^VALM1($S('$D(SDEN):"NO",$P(SDEN,U)="":"NO",$P(SDEN,U,3)'="":"NO",1:"YES"),X,26,3)
80 S X=$$SETSTR^VALM1($S('$D(SDEN):"",$P(SDEN,U)="":"",$P(SDEN,U,3)="":" OPT or AC:",$P(SDEN,U,3)'="":"Disch fm Clinic:",1:""),X,44,17)
81 I $D(SDEN),+SDEN,$P(SDEN,U,3)="" S X=$$SETSTR^VALM1($S($P(SDEN,U,2)="A":"AC",1:"OPT"),X,SDSECCOL,3)
82 I $D(SDEN),+SDEN,$P(SDEN,U,3)'="" S X=$$SETSTR^VALM1($$FTIME^VALM1($P(SDEN,U,3)),X,62,17)
83 Q
84SET(X) ; Set in ^TMP global for display
85 ;
86 S SDLN=SDLN+1,^TMP("SDAMEP",$J,SDLN,0)=X
87 Q
88 ;
89INIT ; -- set up vars
90 N DR,DIQ,DIC,DA
91 D PID^VADPT6
92 S SDFSTCOL=18,SDWIDTH=16,SDSECCOL=57
93 I SDDA="" S SDDA=+$$FIND^SDAM2(DFN,SDT,SDCL)
94 S SDOE=+$P($G(^DPT(DFN,"S",SDT,0)),"^",20)
95 S DIQ="SDPT(",DIC="^DPT(DFN,""S"",",DA=SDT,DR=".01;3;5;6;7;12;13;14;15;16;9.5;17;19;20;25;26;27;28" D EN^DIQ1
96 S DIQ="SDSC(",DIC="^SC(SDCL,""S"",SDT,1,",DA=SDDA,DR="1;3;7;8;9;30;309;302;303;304;306" D EN^DIQ1
97 I $G(SDOE) S DIQ="SDOE(",DIC="^SCE(",DA=+SDOE,DR=".07" D EN^DIQ1
98 I $D(SDSC(44.003,SDDA,30)),SDSC(44.003,SDDA,30)="" S SDSC(44.003,SDDA,30)=$P($G(^DIC(8,+$G(^DPT(DFN,.36)),0)),U)
99 I $D(SDSC(44.003,SDDA,9)),SDSC(44.003,SDDA,9)="" S SDSC(44.003,SDDA,9)="NO"
100 I $D(SDPT(2.98,SDT,13)),SDPT(2.98,SDT,13)="" S SDPT(2.98,SDT,13)="NO"
101 S DIQ(0)="I",DIQ="SDPTI(",DIC="^DPT(DFN,""S"",",DA=SDT,DR="3;20;25;26;27;28" D EN^DIQ1
102 Q
Note: See TracBrowser for help on using the repository browser.