source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDOQMP1.m@ 1719

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

initial load of WorldVistAEHR
File size: 3.3 KB
RevLine 
[613]1SDOQMP1 ;DMJ/VAMCSD;MTZ/HNB;JRC/LRVAMC; ALB/SCK - NEXT AVAILABLE APPOINTMENT ;12/4/94
2 ;;5.3;SCHEDULING;**47,179**;AUG 13, 1993
3 ;
4 ;2.1;;**1,2**;12/4/94
5 ; Modified for national release ; 7/16/96
6 Q
7END ;
8 K %,X,X1,X2,Y,Z,ZTSK,AMMS,AMMS1,AMMS2,AMMS3,AMMSCNT,AMMSD0,AMMI,AMMSFSL,AMMSFDT,AMMSLAST,AMMSZDT
9 K ALCD,ALDCLINE,ALDCODE,ALDCPSTP,ALDCSTAR,ALDCWK,AMMSRDT,AMMSZNUM,CNT3,CNT4,DASH,END,FSLOT,FTCNT,PAGE,SLOT,TDCNT
10 K ALDCD,ALDCNOW,SDWHN,XCNT,XCNT1,PMDIV,SLDATE,AMMSNDT,GET,POP,NMBR,NODE,NODE2,NUMBER,SAVE,DIC,VAUTNI,VAUTSTR,VAUTVB,SLOTWK
11 K SLOTWK1,SW,SW2
12 Q
13 ;
14DATES ; Set-up 1 year dates
15 ; This array is used for available appointments
16 F AMMI=1:1:365 D
17 . S X1=DT,X2=AMMI D C^%DTC,H^%DTC
18 . S ^TMP("SDAMMS",$J,"DATE",X)=%Y I $D(^HOLIDAY(X)) S $P(^TMP("SDAMMS",$J,"DATE",X),U,2)=1
19 Q
20 ;
21AMMSCNT S ^TMP("SDAMMS",$J,"DN")=0,^TMP("SDAMMS",$J,"HOL")=0
22 S ^TMP("SDAMMS",$J,"ZERO")=^SC(AMMSD0,0)
23 Q:$P(^TMP("SDAMMS",$J,"ZERO"),U,3)'="C"
24 S ^TMP("SDAMMS",$J,"ACTIVE")=$G(^SC(AMMSD0,"I"))
25 Q:(^TMP("SDAMMS",$J,"ACTIVE")'="")&($P(^TMP("SDAMMS",$J,"ACTIVE"),U)<DT)&($P(^TMP("SDAMMS",$J,"ACTIVE"),U,2)>DT)
26 Q:('$P(^TMP("SDAMMS",$J,"ACTIVE"),U,2))&($P(^TMP("SDAMMS",$J,"ACTIVE"),U,1))
27 I $P($G(^SC(AMMSD0,"SL")),U,8)="Y" S ^TMP("SDAMMS",$J,"HOL")=1
28 ;
29 ; no availability
30 S ^TMP("SDAMMS",$J,"NOAV")=0
31 I '$O(^SC(AMMSD0,"OST",AMMSZDT)),'$O(^SC(AMMSD0,"ST",AMMSZDT,0)) D
32 . F AMMI=0:1:6 S ^TMP("SDAMMS",$J,"DOW")=$O(^SC(AMMSD0,"T"_AMMI,AMMSZDT)) Q:^TMP("SDAMMS",$J,"DOW") S:^TMP("SDAMMS",$J,"DOW") ^TMP("SDAMMS",$J,"NOAV")=1
33 I $G(^TMP("SDAMMS",$J,"NOAV")) S ^TMP("APPT",$J,AMMSD0)=AMMSRDT_U_"0^0" S AMMSLAST=0,AMMSZDT=DT,AMMSFDT=20,AMMSFSL=33 Q
34 ;
35 S ^TMP("SDAMMS",$J,"FDT")=AMMSZDT,AMMSZNUM=0
36 F S ^TMP("SDAMMS",$J,"FDT")=$O(^TMP("SDAMMS",$J,"DATE",^TMP("SDAMMS",$J,"FDT"))) Q:'+^TMP("SDAMMS",$J,"FDT")!(^TMP("SDAMMS",$J,"DN")) D
37 . S ^TMP("SDAMMS",$J,"FDT1")=^TMP("SDAMMS",$J,"FDT"),^TMP("SDAMMS",$J,"T")="T"_+^TMP("SDAMMS",$J,"DATE",^TMP("SDAMMS",$J,"FDT"))
38 . Q:'^TMP("SDAMMS",$J,"HOL")&($P(^TMP("SDAMMS",$J,"DATE",^TMP("SDAMMS",$J,"FDT")),U,2))
39NOST . ;I '$D(^SC(AMMSD0,"ST",^TMP("SDAMMS",$J,"FDT"))) S ^TMP("APPT",$J,AMMSD0)=AMMSRDT_U_"0^0" Q
40 . I '$D(^SC(AMMSD0,"ST",^TMP("SDAMMS",$J,"FDT"),1)) S IEN=AMMSD0,DATE=^TMP("SDAMMS",$J,"FDT") D FIX^SDOQMP2
41 . Q:'$D(^SC(AMMSD0,"ST",^TMP("SDAMMS",$J,"FDT"),1))
42 . S ^TMP("SDAMMS",$J,"PAT")=^SC(AMMSD0,"ST",^TMP("SDAMMS",$J,"FDT"),1),AMMS=^TMP("SDAMMS",$J,"PAT")
43 . S AMMSCNT=0,SLOTS=0
44 . ; Check the pattern for available slots
45 . S AMMS=$E(AMMS,6,$L(AMMS)),AMMS=$TR(AMMS,"|[] ","")
46 . F %=1:1:$L(AMMS) S AMMS2=$A(AMMS,%) D
47 . . I (AMMS2>48&(AMMS2<58))!((AMMS2>105)&(AMMS2<123)) S AMMSCNT=AMMSCNT+$S(AMMS2<58:$C(AMMS2),1:AMMS2-96)
48 . . Q
49 . S ^TMP("SDAMMS",$J,"DN")=AMMSCNT Q
50DIS I '^TMP("SDAMMS",$J,"DN")&(AMMSLAST=0) S ^TMP("APPT",$J,AMMSD0)=AMMSRDT_U_"0" Q
51 I '^TMP("SDAMMS",$J,"DN") S AMMSLAST=0,AMMSZDT=DT,AMMSFDT=20,AMMSFSL=33 Q
52 S (AMMSNDT,Y)=^TMP("SDAMMS",$J,"FDT1")
53 S:AMMSLAST=0 ^TMP("APPT",$J,AMMSD0)=AMMSRDT_U_AMMSNDT_U_AMMSCNT
54 S AMMSFDT=AMMSFDT+20,AMMSFSL=AMMSFSL+20,AMMSCNT="",AMMSLAST=AMMSLAST+1,^TMP("SDAMMS",$J,"DN")=0
55 I AMMSLAST'=3 S AMMSZDT=^TMP("SDAMMS",$J,"FDT1")
56 I AMMSLAST=2,^TMP("SDAMMS",$J,"MGN")=0 S AMMSZDT=DT,AMMSLAST=0,^TMP("SDAMMS",$J,"DN")=0,AMMSFDT=20,AMMSFSL=33
57 I AMMSLAST=3 S AMMSZDT=DT,AMMSLAST=0,^TMP("SDAMMS",$J,"DN")=0,AMMSFDT=20,AMMSFSL=33
58 Q
Note: See TracBrowser for help on using the repository browser.