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