[613] | 1 | SDAMQ ;ALB/MJK - AM Background Job ; 12/1/91
|
---|
| 2 | ;;5.3;Scheduling;**44,132,153**;Aug 13, 1993
|
---|
| 3 | ;
|
---|
| 4 | EN ; -- manual entry point
|
---|
| 5 | I '$$SWITCH D MES G ENQ
|
---|
| 6 | N SDBEG,SDEND,SDAMETH
|
---|
| 7 | S (SDBEG,SDEND)="",SDAMETH=2 G ENQ:'$$RANGE(.SDBEG,.SDEND,.SDAMETH)
|
---|
| 8 | ;D START G ENQ ; line for testing
|
---|
| 9 | S ZTIO="",ZTRTN="START^SDAMQ",ZTDESC="ReCalc Appointment Status"
|
---|
| 10 | F X="SDBEG","SDEND","SDAMETH" S ZTSAVE(X)=""
|
---|
| 11 | K ZTSK D ^%ZTLOAD W:$D(ZTSK) " (Task: #",ZTSK,")"
|
---|
| 12 | ENQ Q
|
---|
| 13 | ;
|
---|
| 14 | START ;
|
---|
| 15 | G STARTQ:'$$SWITCH
|
---|
| 16 | N SDSTART,SDFIN
|
---|
| 17 | K ^TMP("SDSTATS",$J)
|
---|
| 18 | S SDSTART=$$NOW^SDAMU D ADD^SDAMQ1
|
---|
| 19 | D EN^SDAMQ3(SDBEG,SDEND) ; appointments
|
---|
| 20 | D EN^SDAMQ4(SDBEG,SDEND) ; add/edits
|
---|
| 21 | D EN^SDAMQ5(SDBEG,SDEND) ; dispositions
|
---|
| 22 | S SDFIN=$$NOW^SDAMU D UPD^SDAMQ1(SDBEG,SDEND,SDFIN,.05)
|
---|
| 23 | D BULL^SDAMQ1
|
---|
| 24 | STARTQ K SDBEG,SDEND,SDAMETH,^TMP("SDSTATS",$J) Q
|
---|
| 25 | ;
|
---|
| 26 | AUTO ; -- nightly job entry point
|
---|
| 27 | G:'$$SWITCH AUTOQ
|
---|
| 28 | ; -- do yesterday's first
|
---|
| 29 | S X1=DT,X2=-1 D C^%DTC
|
---|
| 30 | S (SDOPCDT,SDBEG)=X,SDEND=X+.24,SDAMETH=1 D START
|
---|
| 31 | ; -- check previous 30 days starting with the day before yesterday
|
---|
| 32 | 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
|
---|
| 33 | AUTOQ K SDOPCDT,SDBEG,SDEND,SDAMETH,SDBACK,X,X1,X2 Q
|
---|
| 34 | ;
|
---|
| 35 | SWITCH() ;
|
---|
| 36 | Q $$SWITCH^SDAMU<DT
|
---|
| 37 | ;
|
---|
| 38 | MES ;
|
---|
| 39 | W !!,*7,"The date when all appointemnts must be checked-in to obtain"
|
---|
| 40 | W !,"OPC credit is ",$$FDATE^VALM1($$SWITCH^SDAMU),"."
|
---|
| 41 | W !!,"It is too soon to run this option."
|
---|
| 42 | Q
|
---|
| 43 | ;
|
---|
| 44 | RANGE(SDBEG,SDEND,SDAMETH) ; -- select range
|
---|
| 45 | N SDWITCH,SDT,X1,X2,X
|
---|
| 46 | S (SDBEG,SDEND)=0,SDT=DT
|
---|
| 47 | I $G(SDAMETH)>0 S X1=DT,X2=-1 D C^%DTC S SDT=X
|
---|
| 48 | S DIR("B")=$$FDATE^VALM1(SDT),SDWITCH=$$SWITCH^SDAMU
|
---|
| 49 | S DIR(0)="DA"_U_SDWITCH_":"_SDT_":EX",DIR("A")="Select Beginning Date: "
|
---|
| 50 | S DIR("?",1)="Enter a date between "_$$FDATE^VALM1(SDWITCH)_" to "_$$FDATE^VALM1(SDT)_".",DIR("?")=" "
|
---|
| 51 | W ! D ^DIR K DIR G RANGEQ:Y'>0 S SDBEG=Y
|
---|
| 52 | S DIR("B")=$$FDATE^VALM1(SDT)
|
---|
| 53 | S DIR(0)="DA"_U_SDBEG_":"_SDT_":EX",DIR("A")="Select Ending Date: "
|
---|
| 54 | S DIR("?",1)="Enter a date between "_$$FDATE^VALM1(SDBEG)_" to "_$$FDATE^VALM1(SDT)_".",DIR("?")=" "
|
---|
| 55 | D ^DIR K DIR G RANGEQ:Y'>0 S SDEND=Y_".24"
|
---|
| 56 | RANGEQ Q SDEND
|
---|
| 57 | ;
|
---|
| 58 | DIV(SDIV,SDNAME,SDLEN) ; -- get division ifn and name
|
---|
| 59 | ; input: SDIV := candidate division ifn
|
---|
| 60 | ; SDLEN := length of name to pass back [optional]
|
---|
| 61 | ; output: SDNAME := name of division
|
---|
| 62 | ; return: := division ifn
|
---|
| 63 | ;
|
---|
| 64 | N X
|
---|
| 65 | I '$D(SDLEN) N SDLEN S SDLEN=35
|
---|
| 66 | 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)))
|
---|
| 67 | S SDNAME=$E($S($D(^DG(40.8,X,0)):$P(^(0),U),1:"UNKNOWN"),1,SDLEN)
|
---|
| 68 | Q X
|
---|
| 69 | ;
|
---|
| 70 | CO(SDOE) ; -- has co process completed
|
---|
| 71 | Q $P($G(^SCE(+SDOE,0)),U,7)>0
|
---|