SDAM ;MJK/ALB - Appt Mgt ; 8/30/99 9:09am
;;5.3;Scheduling;**149,177,76,242,380**;Aug 13, 1993
;
D HDLKILL^SDAMEVT
EN ; -- main entry point
N XQORS,VALMEVL D EN^VALM("SDAM APPT MGT")
Q
;
INIT ; -- set up appt man vars
K I,X,SDBEG,SDEND,SDB,XQORNOD,SDFN,SDCLN,DA,DR,DIE,DNM,DQ,%B,SDRES
S DIR(0)="43,213",DIR("A")="Select Patient name or Clinic name"
D ^DIR K DIR I $D(DIRUT) S VALMQUIT="" G INITQ
S SDY=Y
I SDY["DPT(" S DFN=+SDY D 2^VADPT I +VADM(6) D G:SDUP="^" INIT
. W !!,"WARNING ",VADM(7),!!
. R "Press Return to Continue or ^ to Quit: ",SDUP:DTIME
I SDY["DPT(" S SDAMTYP="P",SDFN=+SDY D INIT^SDAM1
I SDY["SC(" S SDRES=$$CLNCK^SDUTL2(+SDY,1) I 'SDRES D G INIT
. W !,?5,"Clinic MUST be corrected before continuing."
I SDY["SC(" S SDAMTYP="C",SDCLN=+SDY D INIT^SDAM3
INITQ Q
;
HDR ; -- screen head
N X,SDX,SDLNX S SDLNX=2
;I SDAMTYP="P" D HDR^SDAM10 S VALM("TM")=5 D
I SDAMTYP="P" D HDR^SDAM10 D
.S SDX=$$PCLINE^SDPPTEM(SDFN,DT) Q:'$L(SDX)
.S VALMHDR(SDLNX)=SDX,SDLNX=3
.;S VALMHDR(SDLNX)=SDX,SDLNX=3,VALM("TM")=6
.;Increment Top & Bottom margins to allow for additional line
.;S VALM("TM")=VALM("TM")+1
.;S VALM("BM")=VALM("BM")+1
.Q
I SDAMTYP="C" D HDR^SDAM3
S X=$P(SDAMLIST,"^",2)
S VALMHDR(SDLNX)=X
S X="* - New GAF Required",VALMHDR(SDLNX)=$$SETSTR^VALM1(X,VALMHDR(SDLNX),34,30)
S VALMHDR(SDLNX)=$$SETSTR^VALM1($$FDATE^VALM1(SDBEG)_" thru "_$$FDATE^VALM1(SDEND),VALMHDR(SDLNX),59,22)
Q
;
FNL ; -- what to do after action
K ^TMP("SDAM",$J),^TMP("SDAMIDX",$J),^TMP("VALMIDX",$J)
K SDAMCNT,SDFLDD,SDACNT,VALMHCNT,SDPRD,SDFN,SDCLN,SDAMLIST,SDT,SDATA,SDBEG,SDEND,DFN,Y,SDAMTYP,SDY,X,SDCL,Y,SDDA,VALMY
Q
;
BLD ; -- entry point to bld list
; input: SDAMLIST := list to build
D:'$D(SDAMLIST) GROUP("ALL",.SDAMLIST)
I SDAMTYP="P" D BLD^SDAM1
I SDAMTYP="C" D BLD^SDAM3
BLDQ Q
;
LIST ; -- find and build
; input: X := status group
; output: SDAMLIST := array of status'
;
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
D GROUP(X,.SDAMLIST),BLD
S VALMBCK="R"
LISTQ Q
;
GROUP(GROUP,SDAMLIST) ; -- find list
S (I,SDAMLIST)="" F S I=$O(SDAMLIST(I)) Q:I="" K SDAMLIST(I)
S GROUP=+$O(^SD(409.62,"B",GROUP,0))
G GROUPQ:'$D(^SD(409.62,GROUP,0)) S SDAMLIST=^(0)
S I=$G(^SD(409.62,GROUP,1)) S:I]"" SDAMLIST("SCR")=I
S I=0 F S I=$O(^SD(409.63,"C",GROUP,I)) Q:'I S SDAMLIST(I)=""
GROUPQ Q
;
FUT ; -- change date range
S X1=DT,X2=999 D C^%DTC
S SDEBG=DT,SDEND=X,X="FUTURE" K VALMHDR
D LIST
FUTQ Q
;
EXIT ; -- exit action for protocol
I $D(VALMBCK),VALMBCK="R" D REFRESH^VALM S VALMBCK=$P(VALMBCK,"R")_$P(VALMBCK,"R",2)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDAM 2756 printed Dec 13, 2024@02:47:04 Page 2
SDAM ;MJK/ALB - Appt Mgt ; 8/30/99 9:09am
+1 ;;5.3;Scheduling;**149,177,76,242,380**;Aug 13, 1993
+2 ;
+3 DO HDLKILL^SDAMEVT
EN ; -- main entry point
+1 NEW XQORS,VALMEVL
DO EN^VALM("SDAM APPT MGT")
+2 QUIT
+3 ;
INIT ; -- set up appt man vars
+1 KILL I,X,SDBEG,SDEND,SDB,XQORNOD,SDFN,SDCLN,DA,DR,DIE,DNM,DQ,%B,SDRES
+2 SET DIR(0)="43,213"
SET DIR("A")="Select Patient name or Clinic name"
+3 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET VALMQUIT=""
GOTO INITQ
+4 SET SDY=Y
+5 IF SDY["DPT("
SET DFN=+SDY
DO 2^VADPT
IF +VADM(6)
Begin DoDot:1
+6 WRITE !!,"WARNING ",VADM(7),!!
+7 READ "Press Return to Continue or ^ to Quit: ",SDUP:DTIME
End DoDot:1
if SDUP="^"
GOTO INIT
+8 IF SDY["DPT("
SET SDAMTYP="P"
SET SDFN=+SDY
DO INIT^SDAM1
+9 IF SDY["SC("
SET SDRES=$$CLNCK^SDUTL2(+SDY,1)
IF 'SDRES
Begin DoDot:1
+10 WRITE !,?5,"Clinic MUST be corrected before continuing."
End DoDot:1
GOTO INIT
+11 IF SDY["SC("
SET SDAMTYP="C"
SET SDCLN=+SDY
DO INIT^SDAM3
INITQ QUIT
+1 ;
HDR ; -- screen head
+1 NEW X,SDX,SDLNX
SET SDLNX=2
+2 ;I SDAMTYP="P" D HDR^SDAM10 S VALM("TM")=5 D
+3 IF SDAMTYP="P"
DO HDR^SDAM10
Begin DoDot:1
+4 SET SDX=$$PCLINE^SDPPTEM(SDFN,DT)
if '$LENGTH(SDX)
QUIT
+5 SET VALMHDR(SDLNX)=SDX
SET SDLNX=3
+6 ;S VALMHDR(SDLNX)=SDX,SDLNX=3,VALM("TM")=6
+7 ;Increment Top & Bottom margins to allow for additional line
+8 ;S VALM("TM")=VALM("TM")+1
+9 ;S VALM("BM")=VALM("BM")+1
+10 QUIT
End DoDot:1
+11 IF SDAMTYP="C"
DO HDR^SDAM3
+12 SET X=$PIECE(SDAMLIST,"^",2)
+13 SET VALMHDR(SDLNX)=X
+14 SET X="* - New GAF Required"
SET VALMHDR(SDLNX)=$$SETSTR^VALM1(X,VALMHDR(SDLNX),34,30)
+15 SET VALMHDR(SDLNX)=$$SETSTR^VALM1($$FDATE^VALM1(SDBEG)_" thru "_$$FDATE^VALM1(SDEND),VALMHDR(SDLNX),59,22)
+16 QUIT
+17 ;
FNL ; -- what to do after action
+1 KILL ^TMP("SDAM",$JOB),^TMP("SDAMIDX",$JOB),^TMP("VALMIDX",$JOB)
+2 KILL SDAMCNT,SDFLDD,SDACNT,VALMHCNT,SDPRD,SDFN,SDCLN,SDAMLIST,SDT,SDATA,SDBEG,SDEND,DFN,Y,SDAMTYP,SDY,X,SDCL,Y,SDDA,VALMY
+3 QUIT
+4 ;
BLD ; -- entry point to bld list
+1 ; input: SDAMLIST := list to build
+2 if '$DATA(SDAMLIST)
DO GROUP("ALL",.SDAMLIST)
+3 IF SDAMTYP="P"
DO BLD^SDAM1
+4 IF SDAMTYP="C"
DO BLD^SDAM3
BLDQ QUIT
+1 ;
LIST ; -- find and build
+1 ; input: X := status group
+2 ; output: SDAMLIST := array of status'
+3 ;
+4 IF X["CANCELLED"
IF $GET(SDAMTYP)="C"
SET VALMBCK=""
WRITE !!,*7,"You must be viewing a patient to list cancelled appointments."
DO PAUSE^VALM1
GOTO LISTQ
+5 DO GROUP(X,.SDAMLIST)
DO BLD
+6 SET VALMBCK="R"
LISTQ QUIT
+1 ;
GROUP(GROUP,SDAMLIST) ; -- find list
+1 SET (I,SDAMLIST)=""
FOR
SET I=$ORDER(SDAMLIST(I))
if I=""
QUIT
KILL SDAMLIST(I)
+2 SET GROUP=+$ORDER(^SD(409.62,"B",GROUP,0))
+3 if '$DATA(^SD(409.62,GROUP,0))
GOTO GROUPQ
SET SDAMLIST=^(0)
+4 SET I=$GET(^SD(409.62,GROUP,1))
if I]""
SET SDAMLIST("SCR")=I
+5 SET I=0
FOR
SET I=$ORDER(^SD(409.63,"C",GROUP,I))
if 'I
QUIT
SET SDAMLIST(I)=""
GROUPQ QUIT
+1 ;
FUT ; -- change date range
+1 SET X1=DT
SET X2=999
DO C^%DTC
+2 SET SDEBG=DT
SET SDEND=X
SET X="FUTURE"
KILL VALMHDR
+3 DO LIST
FUTQ QUIT
+1 ;
EXIT ; -- exit action for protocol
+1 IF $DATA(VALMBCK)
IF VALMBCK="R"
DO REFRESH^VALM
SET VALMBCK=$PIECE(VALMBCK,"R")_$PIECE(VALMBCK,"R",2)
+2 QUIT
+3 ;
