1 | SDAMEP ;ALB/CAW - Extended Display ; 16 May 2001 1:46 PM
|
---|
2 | ;;5.3;Scheduling;**241,334,480**;Aug 13, 1993
|
---|
3 | ;
|
---|
4 | EN ; Selection of appointment
|
---|
5 | K ^TMP("SDAMEP",$J)
|
---|
6 | S VALMBCK=""
|
---|
7 | D SEL G ENQ:'$D(SDW)!(SDERR)
|
---|
8 | N SDWIDTH,SDPT,SDSC,SDPTI,SDAMEP
|
---|
9 | W ! D WAIT^DICD
|
---|
10 | S DFN=$P(^TMP("SDAMIDX",$J,SDW),U,2)
|
---|
11 | D FULL^VALM1 S DIC=2,DIC(0)="EM",X="`"_DFN ;,SDAMEP=1
|
---|
12 | D ^DIC I Y<0 S VALMBCK="R" Q
|
---|
13 | D EN^VALM("SDAM APPT PROFILE")
|
---|
14 | S VALMBCK="R"
|
---|
15 | ENQ Q
|
---|
16 | ;
|
---|
17 | HDR ; Header
|
---|
18 | N VA,VAERR
|
---|
19 | D PID^VADPT
|
---|
20 | S VALMHDR(1)=$E($P("Patient: "_$G(^DPT(DFN,0)),"^",1),1,30)_" ("_VA("BID")_")"
|
---|
21 | S X=$S($D(^DPT(DFN,.1)):"Ward: "_^(.1),1:"Outpatient")
|
---|
22 | S VALMHDR(1)=$$SETSTR^VALM1(X,VALMHDR(1),81-$L(X),$L(X))
|
---|
23 | S X="Clinic: "_$P(^SC(SDCL,0),U)
|
---|
24 | S VALMHDR(2)=$$SETSTR^VALM1(X,"Appointment #: "_SDW,81-$L(X),$L(X))
|
---|
25 | Q
|
---|
26 | ;
|
---|
27 | INIT ;
|
---|
28 | N VA,VAERR,SDFSTCOL,SDSECCOL
|
---|
29 | D PID^VADPT
|
---|
30 | S SDT=$P(^TMP("SDAMIDX",$J,SDW),U,3),DFN=$P(^(SDW),U,2),SDCL=$P(^(SDW),U,4),SDDA=$P(^(SDW),U,5),SDLN=0 ;added DFN SD*5.3*480
|
---|
31 | D INIT^SDAMEP1
|
---|
32 | D APDATA^SDAMEP1 ; Appointment Data
|
---|
33 | D APLOG^SDAMEP3 ; Appointment Event Log
|
---|
34 | D PDATA^SDAMEP2 ; Patient Data
|
---|
35 | D APCO^SDAMEP4 ; Appointment Check Out Data
|
---|
36 | S VALMCNT=SDLN
|
---|
37 | Q
|
---|
38 | ;
|
---|
39 | FNL ;
|
---|
40 | K SD,SDOE,SDSC,SDPT,SDLN,VALMCNT,SDEIC,SDI,SDX,SDW,SDEN,SDSTATE,SDERR,SDFLG,SDMT,SDT,DGPMVI,SDDISCH,SDPV,SDPOV,SDST,SDSTA
|
---|
41 | D CLEAN^VALM10
|
---|
42 | Q
|
---|
43 | ;
|
---|
44 | SEL ; -- select processing
|
---|
45 | N BG,LST,Y
|
---|
46 | S BG=+$O(@VALMAR@("IDX",VALMBG,0))
|
---|
47 | S LST=+$O(@VALMAR@("IDX",VALMLST,0))
|
---|
48 | I 'BG W !!,*7,"There are no '",VALM("ENTITY"),"s' to select.",! S DIR(0)="E" D ^DIR K DIR D OUT G SELQ
|
---|
49 | S Y=+$P($P(XQORNOD(0),U,4),"=",2)
|
---|
50 | I 'Y S DIR(0)="N^"_BG_":"_LST,DIR("A")="Select "_VALM("ENTITY")_"(s)" D ^DIR K DIR I $D(DIRUT) D OUT G SELQ
|
---|
51 | ;
|
---|
52 | ; -- check was valid entries
|
---|
53 | S SDERR=0,SDW=Y
|
---|
54 | I SDW<BG!(SDW>LST) D
|
---|
55 | .W !,*7,"Selection '",SDW,"' is not a valid choice."
|
---|
56 | .D OUT,PAUSE^VALM1
|
---|
57 | ;
|
---|
58 | SELQ K DIRUT,DTOUT,DUOUT,DIROUT Q
|
---|
59 | ;
|
---|
60 | OUT ;
|
---|
61 | S SDERR=1
|
---|
62 | Q
|
---|