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

SDAMQ.m

Go to the documentation of this file. 
  1. SDAMQ ;ALB/MJK - AM Background Job ; 12/1/91
  1.  ;;5.3;PIMS;**44,132,153,1015,1016**;JUN 30, 2012;Build 20
  1.  ;
  1. EN ; -- manual entry point
  1.  I '$$SWITCH D MES G ENQ
  1.  N SDBEG,SDEND,SDAMETH
  1.  S (SDBEG,SDEND)="",SDAMETH=2 G ENQ:'$$RANGE(.SDBEG,.SDEND,.SDAMETH)
  1.  ;D START G ENQ ; line for testing
  1.  S ZTIO="",ZTRTN="START^SDAMQ",ZTDESC="ReCalc Appointment Status"
  1.  F X="SDBEG","SDEND","SDAMETH" S ZTSAVE(X)=""
  1.  K ZTSK D ^%ZTLOAD W:$D(ZTSK) "  (Task: #",ZTSK,")"
  1. ENQ Q
  1.  ;
  1. START ;
  1.  G STARTQ:'$$SWITCH
  1.  N SDSTART,SDFIN
  1.  ;N SDMHNOSH ; set for no show report
  1.  K ^TMP("SDSTATS",$J)
  1.  S SDSTART=$$NOW^SDAMU D ADD^SDAMQ1
  1.  D EN^SDAMQ3(SDBEG,SDEND)  ; appointments
  1.  D EN^SDAMQ4(SDBEG,SDEND)  ; add/edits
  1.  D EN^SDAMQ5(SDBEG,SDEND)  ; dispositions
  1.  ;D EN^SDMHNS  ;High Risk Mental Health NO Show report 
  1.  ;D ^SDMHPRO   ;High Risk Mental Health Proactive report.
  1.  S SDFIN=$$NOW^SDAMU D UPD^SDAMQ1(SDBEG,SDEND,SDFIN,.05)
  1.  D BULL^SDAMQ1
  1. STARTQ K SDBEG,SDEND,SDAMETH,^TMP("SDSTATS",$J) Q
  1.  ;
  1. AUTO ; -- nightly job entry point
  1.  G:'$$SWITCH AUTOQ
  1.  ; -- do yesterday's first
  1.  S X1=DT,X2=-1 D C^%DTC
  1.  S (SDOPCDT,SDBEG)=X,SDEND=X+.24,SDAMETH=1 D START,^SDMHNS
  1.  ; -- check previous 30 days starting with the day before yesterday
  1.  F SDBACK=2:1:31 S X1=DT,X2=-SDBACK D C^%DTC Q:X<$$SWITCH^SDAMU  I '$P($G(^SDD(409.65,+$O(^SDD(409.65,"B",X,0)),0)),U,5) S SDBEG=X,SDEND=X+.24,SDAMETH=1 D START
  1. AUTOQ K SDOPCDT,SDBEG,SDEND,SDAMETH,SDBACK,X,X1,X2 Q
  1.  ;
  1. SWITCH() ;
  1.  Q $$SWITCH^SDAMU<DT
  1.  ;
  1. MES ;
  1.  W !!,*7,"The date when all appointemnts must be checked-in to obtain"
  1.  W !,"OPC credit is ",$$FDATE^VALM1($$SWITCH^SDAMU),"."
  1.  W !!,"It is too soon to run this option."
  1.  Q
  1.  ;
  1. RANGE(SDBEG,SDEND,SDAMETH) ; -- select range
  1.  N SDWITCH,SDT,X1,X2,X
  1.  S (SDBEG,SDEND)=0,SDT=DT
  1.  I $G(SDAMETH)>0 S X1=DT,X2=-1 D C^%DTC S SDT=X
  1.  S DIR("B")=$$FDATE^VALM1(SDT),SDWITCH=$$SWITCH^SDAMU
  1.  S DIR(0)="DA"_U_SDWITCH_":"_SDT_":EX",DIR("A")="Select Beginning Date: "
  1.  S DIR("?",1)="Enter a date between "_$$FDATE^VALM1(SDWITCH)_" to "_$$FDATE^VALM1(SDT)_".",DIR("?")=" "
  1.  W ! D ^DIR K DIR G RANGEQ:Y'>0 S SDBEG=Y
  1.  S DIR("B")=$$FDATE^VALM1(SDT)
  1.  S DIR(0)="DA"_U_SDBEG_":"_SDT_":EX",DIR("A")="Select    Ending Date: "
  1.  S DIR("?",1)="Enter a date between "_$$FDATE^VALM1(SDBEG)_" to "_$$FDATE^VALM1(SDT)_".",DIR("?")=" "
  1.  D ^DIR K DIR G RANGEQ:Y'>0 S SDEND=Y_".24"
  1. RANGEQ Q SDEND
  1.  ;
  1. DIV(SDIV,SDNAME,SDLEN) ; -- get division ifn and name
  1.  ;  input:   SDIV := candidate division ifn
  1.  ;          SDLEN := length of name to pass back [optional]
  1.  ; output: SDNAME := name of division
  1.  ; return:        := division ifn
  1.  ;
  1.  N X
  1.  I '$D(SDLEN) N SDLEN S SDLEN=35
  1.  S X=$S('$P($G(^DG(43,1,"GL")),U,2):+$O(^DG(40.8,0)),$D(^DG(40.8,+SDIV,0)):+SDIV,1:+$O(^DG(40.8,0)))
  1.  S SDNAME=$E($S($D(^DG(40.8,X,0)):$P(^(0),U),1:"UNKNOWN"),1,SDLEN)
  1.  Q X
  1.  ;
  1. CO(SDOE) ; -- has co process completed
  1.  Q $P($G(^SCE(+SDOE,0)),U,7)>0