source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDAMEP.m@ 658

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

initial load of FOIAVistA 6/30/08 version

File size: 1.9 KB
Line 
1SDAMEP ;ALB/CAW - Extended Display ; 16 May 2001 1:46 PM
2 ;;5.3;Scheduling;**241,334,480**;Aug 13, 1993
3 ;
4EN ; 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"
15ENQ Q
16 ;
17HDR ; 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 ;
27INIT ;
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 ;
39FNL ;
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 ;
44SEL ; -- 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 ;
58SELQ K DIRUT,DTOUT,DUOUT,DIROUT Q
59 ;
60OUT ;
61 S SDERR=1
62 Q
Note: See TracBrowser for help on using the repository browser.