- 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 Feb 19, 2025@00:13:31 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 ;