Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDAM

SDAM.m

Go to the documentation of this file.
  1. SDAM ;MJK/ALB - Appt Mgt ; 8/30/99 9:09am
  1. ;;5.3;Scheduling;**149,177,76,242,380**;Aug 13, 1993
  1. ;
  1. D HDLKILL^SDAMEVT
  1. EN ; -- main entry point
  1. N XQORS,VALMEVL D EN^VALM("SDAM APPT MGT")
  1. Q
  1. ;
  1. INIT ; -- set up appt man vars
  1. K I,X,SDBEG,SDEND,SDB,XQORNOD,SDFN,SDCLN,DA,DR,DIE,DNM,DQ,%B,SDRES
  1. S DIR(0)="43,213",DIR("A")="Select Patient name or Clinic name"
  1. D ^DIR K DIR I $D(DIRUT) S VALMQUIT="" G INITQ
  1. S SDY=Y
  1. I SDY["DPT(" S DFN=+SDY D 2^VADPT I +VADM(6) D G:SDUP="^" INIT
  1. . W !!,"WARNING ",VADM(7),!!
  1. . R "Press Return to Continue or ^ to Quit: ",SDUP:DTIME
  1. I SDY["DPT(" S SDAMTYP="P",SDFN=+SDY D INIT^SDAM1
  1. I SDY["SC(" S SDRES=$$CLNCK^SDUTL2(+SDY,1) I 'SDRES D G INIT
  1. . W !,?5,"Clinic MUST be corrected before continuing."
  1. I SDY["SC(" S SDAMTYP="C",SDCLN=+SDY D INIT^SDAM3
  1. INITQ Q
  1. ;
  1. HDR ; -- screen head
  1. N X,SDX,SDLNX S SDLNX=2
  1. ;I SDAMTYP="P" D HDR^SDAM10 S VALM("TM")=5 D
  1. I SDAMTYP="P" D HDR^SDAM10 D
  1. .S SDX=$$PCLINE^SDPPTEM(SDFN,DT) Q:'$L(SDX)
  1. .S VALMHDR(SDLNX)=SDX,SDLNX=3
  1. .;S VALMHDR(SDLNX)=SDX,SDLNX=3,VALM("TM")=6
  1. .;Increment Top & Bottom margins to allow for additional line
  1. .;S VALM("TM")=VALM("TM")+1
  1. .;S VALM("BM")=VALM("BM")+1
  1. .Q
  1. I SDAMTYP="C" D HDR^SDAM3
  1. S X=$P(SDAMLIST,"^",2)
  1. S VALMHDR(SDLNX)=X
  1. S X="* - New GAF Required",VALMHDR(SDLNX)=$$SETSTR^VALM1(X,VALMHDR(SDLNX),34,30)
  1. S VALMHDR(SDLNX)=$$SETSTR^VALM1($$FDATE^VALM1(SDBEG)_" thru "_$$FDATE^VALM1(SDEND),VALMHDR(SDLNX),59,22)
  1. Q
  1. ;
  1. FNL ; -- what to do after action
  1. K ^TMP("SDAM",$J),^TMP("SDAMIDX",$J),^TMP("VALMIDX",$J)
  1. K SDAMCNT,SDFLDD,SDACNT,VALMHCNT,SDPRD,SDFN,SDCLN,SDAMLIST,SDT,SDATA,SDBEG,SDEND,DFN,Y,SDAMTYP,SDY,X,SDCL,Y,SDDA,VALMY
  1. Q
  1. ;
  1. BLD ; -- entry point to bld list
  1. ; input: SDAMLIST := list to build
  1. D:'$D(SDAMLIST) GROUP("ALL",.SDAMLIST)
  1. I SDAMTYP="P" D BLD^SDAM1
  1. I SDAMTYP="C" D BLD^SDAM3
  1. BLDQ Q
  1. ;
  1. LIST ; -- find and build
  1. ; input: X := status group
  1. ; output: SDAMLIST := array of status'
  1. ;
  1. 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
  1. D GROUP(X,.SDAMLIST),BLD
  1. S VALMBCK="R"
  1. LISTQ Q
  1. ;
  1. GROUP(GROUP,SDAMLIST) ; -- find list
  1. S (I,SDAMLIST)="" F S I=$O(SDAMLIST(I)) Q:I="" K SDAMLIST(I)
  1. S GROUP=+$O(^SD(409.62,"B",GROUP,0))
  1. G GROUPQ:'$D(^SD(409.62,GROUP,0)) S SDAMLIST=^(0)
  1. S I=$G(^SD(409.62,GROUP,1)) S:I]"" SDAMLIST("SCR")=I
  1. S I=0 F S I=$O(^SD(409.63,"C",GROUP,I)) Q:'I S SDAMLIST(I)=""
  1. GROUPQ Q
  1. ;
  1. FUT ; -- change date range
  1. S X1=DT,X2=999 D C^%DTC
  1. S SDEBG=DT,SDEND=X,X="FUTURE" K VALMHDR
  1. D LIST
  1. FUTQ Q
  1. ;
  1. EXIT ; -- exit action for protocol
  1. I $D(VALMBCK),VALMBCK="R" D REFRESH^VALM S VALMBCK=$P(VALMBCK,"R")_$P(VALMBCK,"R",2)
  1. Q
  1. ;