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,1001,1005,1015**;Aug 13, 1993;Build 21
  1.  ;IHS/ANMC/LJF  6/01/2000 removed "* - New GAF Required" from header
  1.  ;              8/18/2000 cleared screen before entering list template
  1.  ;              9/29/2000 added kill of patient variables
  1.  ;              8/29/2001 changed so can be called with patient set(VPR)
  1.  ;                        also changed list temp entry code to INIT1
  1.  ;             10/19/2001 added insurance coverage to heading
  1.  ;             10/22/2001 cleaned up call to VALM
  1.  ;IHS/ITSC/WAR 10/20/2004 PATCH 1001 clear DFN if viewing by clinic
  1.  ;IHS/OIT/LJF  12/29/2005 PATCH 1005 added age to header display
  1.  ;
  1.  D HDLKILL^SDAMEVT
  1. EN ; -- main entry point
  1.  ;IHS/ANMC/LJF 8/29/2001 start of changes
  1.  ;N XQORS,VALMEVL D EN^VALM("SDAM APPT MGT")  ;original VA code
  1.  K VALMQUIT D INIT Q:$D(VALMQUIT)
  1. EN1 ;PEP; entry point when patient is known - see technical documentation
  1.  D TERM^VALM0                            ;IHS/ANMC/LJF 10/22/2001 added for clean VALM call
  1.  NEW VALMCNT D EN^VALM("SDAM APPT MGT")
  1.  D KILL^AUPNPAT,KVA^VADPT,CLEAR^VALM1    ;IHS/ANMC/LJF 9/29/2000 added
  1.  ;IHS/ANMC/LJF 8/29/2001 end of new code
  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.  ;
  1.  ;IHS/ANMC/LJF 8/29/2001 changed code so can be called with patient set
  1.  Q
  1.  ;
  1. INIT1 ; added line label
  1.  ;IHS/ANMC/LJF 8/29/2001 end of mods
  1.  ;
  1.  I SDY["DPT(" S SDAMTYP="P",SDFN=+SDY D INIT^SDAM1
  1.  ;IHS/ITSC/WAR 10/20/04 PATCH #1001 clear Pt DFN if a Clinic is chosen
  1.  ;I SDY["SC(" S SDAMTYP="C",SDCLN=+SDY D INIT^SDAM3
  1.  I SDY["SC(" S SDAMTYP="C",SDCLN=+SDY K DFN D INIT^SDAM3
  1.  D CLEAR^VALM1  ;IHS/ANMC/LJF 8/18/2000
  1.  ;
  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.  .;IHS/OIT/LJF 12/29/2005 PATCH 1005 added patient age to PCP line
  1.  .;S SDX=$$PCLINE^SDPPTEM(SDFN,DT) Q:'$L(SDX)
  1.  .S SDX="    Age:  "_$$AGE^AUPNPAT(SDFN,DT,"R")_"  "_$$PCLINE^SDPPTEM(SDFN,DT) Q:'$L(SDX)
  1.  .;
  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.  I SDAMTYP="P" S VALMHDR(SDLNX)=$$SETSTR^VALM1($$INSUR^BDGF2(SDFN,SDBEG),VALMHDR(SDLNX),40,15)  ;IHS/ANMC/LJF 10/19/2001
  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.  ;