| 1 | SDAM ;MJK/ALB - Appt Mgt ; 8/30/99 9:09am
|
|---|
| 2 | ;;5.3;Scheduling;**149,177,76,242,380**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | D HDLKILL^SDAMEVT
|
|---|
| 5 | EN ; -- main entry point
|
|---|
| 6 | N XQORS,VALMEVL D EN^VALM("SDAM APPT MGT")
|
|---|
| 7 | Q
|
|---|
| 8 | ;
|
|---|
| 9 | INIT ; -- set up appt man vars
|
|---|
| 10 | K I,X,SDBEG,SDEND,SDB,XQORNOD,SDFN,SDCLN,DA,DR,DIE,DNM,DQ,%B,SDRES
|
|---|
| 11 | S DIR(0)="43,213",DIR("A")="Select Patient name or Clinic name"
|
|---|
| 12 | D ^DIR K DIR I $D(DIRUT) S VALMQUIT="" G INITQ
|
|---|
| 13 | S SDY=Y
|
|---|
| 14 | I SDY["DPT(" S DFN=+SDY D 2^VADPT I +VADM(6) D G:SDUP="^" INIT
|
|---|
| 15 | . W !!,"WARNING ",VADM(7),!!
|
|---|
| 16 | . R "Press Return to Continue or ^ to Quit: ",SDUP:DTIME
|
|---|
| 17 | I SDY["DPT(" S SDAMTYP="P",SDFN=+SDY D INIT^SDAM1
|
|---|
| 18 | I SDY["SC(" S SDRES=$$CLNCK^SDUTL2(+SDY,1) I 'SDRES D G INIT
|
|---|
| 19 | . W !,?5,"Clinic MUST be corrected before continuing."
|
|---|
| 20 | I SDY["SC(" S SDAMTYP="C",SDCLN=+SDY D INIT^SDAM3
|
|---|
| 21 | INITQ Q
|
|---|
| 22 | ;
|
|---|
| 23 | HDR ; -- screen head
|
|---|
| 24 | N X,SDX,SDLNX S SDLNX=2
|
|---|
| 25 | ;I SDAMTYP="P" D HDR^SDAM10 S VALM("TM")=5 D
|
|---|
| 26 | I SDAMTYP="P" D HDR^SDAM10 D
|
|---|
| 27 | .S SDX=$$PCLINE^SDPPTEM(SDFN,DT) Q:'$L(SDX)
|
|---|
| 28 | .S VALMHDR(SDLNX)=SDX,SDLNX=3
|
|---|
| 29 | .;S VALMHDR(SDLNX)=SDX,SDLNX=3,VALM("TM")=6
|
|---|
| 30 | .;Increment Top & Bottom margins to allow for additional line
|
|---|
| 31 | .;S VALM("TM")=VALM("TM")+1
|
|---|
| 32 | .;S VALM("BM")=VALM("BM")+1
|
|---|
| 33 | .Q
|
|---|
| 34 | I SDAMTYP="C" D HDR^SDAM3
|
|---|
| 35 | S X=$P(SDAMLIST,"^",2)
|
|---|
| 36 | S VALMHDR(SDLNX)=X
|
|---|
| 37 | S X="* - New GAF Required",VALMHDR(SDLNX)=$$SETSTR^VALM1(X,VALMHDR(SDLNX),34,30)
|
|---|
| 38 | S VALMHDR(SDLNX)=$$SETSTR^VALM1($$FDATE^VALM1(SDBEG)_" thru "_$$FDATE^VALM1(SDEND),VALMHDR(SDLNX),59,22)
|
|---|
| 39 | Q
|
|---|
| 40 | ;
|
|---|
| 41 | FNL ; -- what to do after action
|
|---|
| 42 | K ^TMP("SDAM",$J),^TMP("SDAMIDX",$J),^TMP("VALMIDX",$J)
|
|---|
| 43 | K SDAMCNT,SDFLDD,SDACNT,VALMHCNT,SDPRD,SDFN,SDCLN,SDAMLIST,SDT,SDATA,SDBEG,SDEND,DFN,Y,SDAMTYP,SDY,X,SDCL,Y,SDDA,VALMY
|
|---|
| 44 | Q
|
|---|
| 45 | ;
|
|---|
| 46 | BLD ; -- entry point to bld list
|
|---|
| 47 | ; input: SDAMLIST := list to build
|
|---|
| 48 | D:'$D(SDAMLIST) GROUP("ALL",.SDAMLIST)
|
|---|
| 49 | I SDAMTYP="P" D BLD^SDAM1
|
|---|
| 50 | I SDAMTYP="C" D BLD^SDAM3
|
|---|
| 51 | BLDQ Q
|
|---|
| 52 | ;
|
|---|
| 53 | LIST ; -- find and build
|
|---|
| 54 | ; input: X := status group
|
|---|
| 55 | ; output: SDAMLIST := array of status'
|
|---|
| 56 | ;
|
|---|
| 57 | I X["CANCELLED",$G(SDAMTYP)="C" S VALMBCK="" W !!,*7,"You must be viewing a patient to list cancelled appointments." D PAUSE^VALM1 G LISTQ
|
|---|
| 58 | D GROUP(X,.SDAMLIST),BLD
|
|---|
| 59 | S VALMBCK="R"
|
|---|
| 60 | LISTQ Q
|
|---|
| 61 | ;
|
|---|
| 62 | GROUP(GROUP,SDAMLIST) ; -- find list
|
|---|
| 63 | S (I,SDAMLIST)="" F S I=$O(SDAMLIST(I)) Q:I="" K SDAMLIST(I)
|
|---|
| 64 | S GROUP=+$O(^SD(409.62,"B",GROUP,0))
|
|---|
| 65 | G GROUPQ:'$D(^SD(409.62,GROUP,0)) S SDAMLIST=^(0)
|
|---|
| 66 | S I=$G(^SD(409.62,GROUP,1)) S:I]"" SDAMLIST("SCR")=I
|
|---|
| 67 | S I=0 F S I=$O(^SD(409.63,"C",GROUP,I)) Q:'I S SDAMLIST(I)=""
|
|---|
| 68 | GROUPQ Q
|
|---|
| 69 | ;
|
|---|
| 70 | FUT ; -- change date range
|
|---|
| 71 | S X1=DT,X2=999 D C^%DTC
|
|---|
| 72 | S SDEBG=DT,SDEND=X,X="FUTURE" K VALMHDR
|
|---|
| 73 | D LIST
|
|---|
| 74 | FUTQ Q
|
|---|
| 75 | ;
|
|---|
| 76 | EXIT ; -- exit action for protocol
|
|---|
| 77 | I $D(VALMBCK),VALMBCK="R" D REFRESH^VALM S VALMBCK=$P(VALMBCK,"R")_$P(VALMBCK,"R",2)
|
|---|
| 78 | Q
|
|---|
| 79 | ;
|
|---|
