source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDAMQ.m@ 1361

Last change on this file since 1361 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.6 KB
RevLine 
[613]1SDAMQ ;ALB/MJK - AM Background Job ; 12/1/91
2 ;;5.3;Scheduling;**44,132,153**;Aug 13, 1993
3 ;
4EN ; -- 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,")"
12ENQ Q
13 ;
14START ;
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
24STARTQ K SDBEG,SDEND,SDAMETH,^TMP("SDSTATS",$J) Q
25 ;
26AUTO ; -- 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
33AUTOQ K SDOPCDT,SDBEG,SDEND,SDAMETH,SDBACK,X,X1,X2 Q
34 ;
35SWITCH() ;
36 Q $$SWITCH^SDAMU<DT
37 ;
38MES ;
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 ;
44RANGE(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"
56RANGEQ Q SDEND
57 ;
58DIV(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 ;
70CO(SDOE) ; -- has co process completed
71 Q $P($G(^SCE(+SDOE,0)),U,7)>0
Note: See TracBrowser for help on using the repository browser.