| 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
 | 
|---|