SDAMQ ;ALB/MJK - AM Background Job ; 12/1/91
;;5.3;Scheduling;**44,132,153,578,588**;Aug 13,1993;Build 53
;
EN ; -- manual entry point
I '$$SWITCH D MES G ENQ
N SDBEG,SDEND,SDAMETH,Y
S (SDBEG,SDEND)="",SDAMETH=2 G ENQ:'$$RANGE(.SDBEG,.SDEND,.SDAMETH)
;D START G ENQ ; line for testing
N ZTDESC,ZTIO,ZTRTN,ZTSAVE
S ZTIO="",ZTRTN="START^SDAMQ",ZTDESC="ReCalc Appointment Status"
F X="SDBEG","SDEND","SDAMETH" S ZTSAVE(X)=""
K ZTSK D ^%ZTLOAD W:$D(ZTSK) " (Task: #",ZTSK,")"
ENQ Q
;
START ;
G STARTQ:'$$SWITCH
N SDSTART,SDFIN
;N SDMHNOSH ; set for no show report
K ^TMP("SDSTATS",$J)
S SDSTART=$$NOW^SDAMU D ADD^SDAMQ1
D EN^SDAMQ3(SDBEG,SDEND) ; appointments
D EN^SDAMQ4(SDBEG,SDEND) ; add/edits
D EN^SDAMQ5(SDBEG,SDEND) ; dispositions
S SDFIN=$$NOW^SDAMU D UPD^SDAMQ1(SDBEG,SDEND,SDFIN,.05)
D BULL^SDAMQ1
STARTQ K SDBEG,SDEND,SDAMETH,^TMP("SDSTATS",$J) Q
;
AUTO ; -- nightly job entry point
G:'$$SWITCH AUTOQ
; -- do yesterday's first
S X1=DT,X2=-1 D C^%DTC
S (SDOPCDT,SDBEG)=X,SDEND=X+.24,SDAMETH=1 D START
D EN^SDMHNS
D EN^SDMHPRO
; -- check previous 30 days starting with the day before yesterday
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
AUTOQ K SDOPCDT,SDBEG,SDEND,SDAMETH,SDBACK,X,X1,X2 Q
;
SWITCH() ;
Q $$SWITCH^SDAMU<DT
;
MES ;
W !!,*7,"The date when all appointemnts must be checked-in to obtain"
W !,"OPC credit is ",$$FDATE^VALM1($$SWITCH^SDAMU),"."
W !!,"It is too soon to run this option."
Q
;
RANGE(SDBEG,SDEND,SDAMETH) ; -- select range
N SDWITCH,SDT,X1,X2,X
S (SDBEG,SDEND)=0,SDT=DT
I $G(SDAMETH)>0 S X1=DT,X2=-1 D C^%DTC S SDT=X
S DIR("B")=$$FDATE^VALM1(SDT),SDWITCH=$$SWITCH^SDAMU
S DIR(0)="DA"_U_SDWITCH_":"_SDT_":EX",DIR("A")="Select Beginning Date: "
S DIR("?",1)="Enter a date between "_$$FDATE^VALM1(SDWITCH)_" to "_$$FDATE^VALM1(SDT)_".",DIR("?")=" "
W ! D ^DIR K DIR G RANGEQ:Y'>0 S SDBEG=Y
S DIR("B")=$$FDATE^VALM1(SDT)
S DIR(0)="DA"_U_SDBEG_":"_SDT_":EX",DIR("A")="Select Ending Date: "
S DIR("?",1)="Enter a date between "_$$FDATE^VALM1(SDBEG)_" to "_$$FDATE^VALM1(SDT)_".",DIR("?")=" "
D ^DIR K DIR G RANGEQ:Y'>0 S SDEND=Y_".24"
RANGEQ Q SDEND
;
DIV(SDIV,SDNAME,SDLEN) ; -- get division ifn and name
; input: SDIV := candidate division ifn
; SDLEN := length of name to pass back [optional]
; output: SDNAME := name of division
; return: := division ifn
;
N X
I '$D(SDLEN) N SDLEN S SDLEN=35
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)))
S SDNAME=$E($S($D(^DG(40.8,X,0)):$P(^(0),U),1:"UNKNOWN"),1,SDLEN)
Q X
;
CO(SDOE) ; -- has co process completed
Q $P($G(^SCE(+SDOE,0)),U,7)>0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDAMQ 2840 printed Oct 16, 2024@18:48:45 Page 2
SDAMQ ;ALB/MJK - AM Background Job ; 12/1/91
+1 ;;5.3;Scheduling;**44,132,153,578,588**;Aug 13,1993;Build 53
+2 ;
EN ; -- manual entry point
+1 IF '$$SWITCH
DO MES
GOTO ENQ
+2 NEW SDBEG,SDEND,SDAMETH,Y
+3 SET (SDBEG,SDEND)=""
SET SDAMETH=2
if '$$RANGE(.SDBEG,.SDEND,.SDAMETH)
GOTO ENQ
+4 ;D START G ENQ ; line for testing
+5 NEW ZTDESC,ZTIO,ZTRTN,ZTSAVE
+6 SET ZTIO=""
SET ZTRTN="START^SDAMQ"
SET ZTDESC="ReCalc Appointment Status"
+7 FOR X="SDBEG","SDEND","SDAMETH"
SET ZTSAVE(X)=""
+8 KILL ZTSK
DO ^%ZTLOAD
if $DATA(ZTSK)
WRITE " (Task: #",ZTSK,")"
ENQ QUIT
+1 ;
START ;
+1 if '$$SWITCH
GOTO STARTQ
+2 NEW SDSTART,SDFIN
+3 ;N SDMHNOSH ; set for no show report
+4 KILL ^TMP("SDSTATS",$JOB)
+5 SET SDSTART=$$NOW^SDAMU
DO ADD^SDAMQ1
+6 ; appointments
DO EN^SDAMQ3(SDBEG,SDEND)
+7 ; add/edits
DO EN^SDAMQ4(SDBEG,SDEND)
+8 ; dispositions
DO EN^SDAMQ5(SDBEG,SDEND)
+9 SET SDFIN=$$NOW^SDAMU
DO UPD^SDAMQ1(SDBEG,SDEND,SDFIN,.05)
+10 DO BULL^SDAMQ1
STARTQ KILL SDBEG,SDEND,SDAMETH,^TMP("SDSTATS",$JOB)
QUIT
+1 ;
AUTO ; -- nightly job entry point
+1 if '$$SWITCH
GOTO AUTOQ
+2 ; -- do yesterday's first
+3 SET X1=DT
SET X2=-1
DO C^%DTC
+4 SET (SDOPCDT,SDBEG)=X
SET SDEND=X+.24
SET SDAMETH=1
DO START
+5 DO EN^SDMHNS
+6 DO EN^SDMHPRO
+7 ; -- check previous 30 days starting with the day before yesterday
+8 FOR SDBACK=2:1:31
SET X1=DT
SET X2=-SDBACK
DO C^%DTC
if X<$$SWITCH^SDAMU
QUIT
IF '$PIECE($GET(^SDD(409.65,+$ORDER(^SDD(409.65,"B",X,0)),0)),U,5)
SET SDBEG=X
SET SDEND=X+.24
SET SDAMETH=1
DO START
AUTOQ KILL SDOPCDT,SDBEG,SDEND,SDAMETH,SDBACK,X,X1,X2
QUIT
+1 ;
SWITCH() ;
+1 QUIT $$SWITCH^SDAMU<DT
+2 ;
MES ;
+1 WRITE !!,*7,"The date when all appointemnts must be checked-in to obtain"
+2 WRITE !,"OPC credit is ",$$FDATE^VALM1($$SWITCH^SDAMU),"."
+3 WRITE !!,"It is too soon to run this option."
+4 QUIT
+5 ;
RANGE(SDBEG,SDEND,SDAMETH) ; -- select range
+1 NEW SDWITCH,SDT,X1,X2,X
+2 SET (SDBEG,SDEND)=0
SET SDT=DT
+3 IF $GET(SDAMETH)>0
SET X1=DT
SET X2=-1
DO C^%DTC
SET SDT=X
+4 SET DIR("B")=$$FDATE^VALM1(SDT)
SET SDWITCH=$$SWITCH^SDAMU
+5 SET DIR(0)="DA"_U_SDWITCH_":"_SDT_":EX"
SET DIR("A")="Select Beginning Date: "
+6 SET DIR("?",1)="Enter a date between "_$$FDATE^VALM1(SDWITCH)_" to "_$$FDATE^VALM1(SDT)_"."
SET DIR("?")=" "
+7 WRITE !
DO ^DIR
KILL DIR
if Y'>0
GOTO RANGEQ
SET SDBEG=Y
+8 SET DIR("B")=$$FDATE^VALM1(SDT)
+9 SET DIR(0)="DA"_U_SDBEG_":"_SDT_":EX"
SET DIR("A")="Select Ending Date: "
+10 SET DIR("?",1)="Enter a date between "_$$FDATE^VALM1(SDBEG)_" to "_$$FDATE^VALM1(SDT)_"."
SET DIR("?")=" "
+11 DO ^DIR
KILL DIR
if Y'>0
GOTO RANGEQ
SET SDEND=Y_".24"
RANGEQ QUIT SDEND
+1 ;
DIV(SDIV,SDNAME,SDLEN) ; -- get division ifn and name
+1 ; input: SDIV := candidate division ifn
+2 ; SDLEN := length of name to pass back [optional]
+3 ; output: SDNAME := name of division
+4 ; return: := division ifn
+5 ;
+6 NEW X
+7 IF '$DATA(SDLEN)
NEW SDLEN
SET SDLEN=35
+8 SET X=$SELECT('$PIECE($GET(^DG(43,1,"GL")),U,2):+$ORDER(^DG(40.8,0)),$DATA(^DG(40.8,+SDIV,0)):+SDIV,1:+$ORDER(^DG(40.8,0)))
+9 SET SDNAME=$EXTRACT($SELECT($DATA(^DG(40.8,X,0)):$PIECE(^(0),U),1:"UNKNOWN"),1,SDLEN)
+10 QUIT X
+11 ;
CO(SDOE) ; -- has co process completed
+1 QUIT $PIECE($GET(^SCE(+SDOE,0)),U,7)>0
