source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDOQMP1.m@ 800

SDOQMP1 ;DMJ/VAMCSD;MTZ/HNB;JRC/LRVAMC; ALB/SCK - NEXT AVAILABLE APPOINTMENT ;12/4/94
 ;;5.3;SCHEDULING;**47,179**;AUG 13, 1993
 ;
 ;2.1;;**1,2**;12/4/94
 ; Modified for national release ; 7/16/96
 Q
END ;
 K %,X,X1,X2,Y,Z,ZTSK,AMMS,AMMS1,AMMS2,AMMS3,AMMSCNT,AMMSD0,AMMI,AMMSFSL,AMMSFDT,AMMSLAST,AMMSZDT
 K ALCD,ALDCLINE,ALDCODE,ALDCPSTP,ALDCSTAR,ALDCWK,AMMSRDT,AMMSZNUM,CNT3,CNT4,DASH,END,FSLOT,FTCNT,PAGE,SLOT,TDCNT
 K ALDCD,ALDCNOW,SDWHN,XCNT,XCNT1,PMDIV,SLDATE,AMMSNDT,GET,POP,NMBR,NODE,NODE2,NUMBER,SAVE,DIC,VAUTNI,VAUTSTR,VAUTVB,SLOTWK
 K SLOTWK1,SW,SW2
 Q
 ;
DATES ; Set-up 1 year dates
 ; This array is used for available appointments
 F AMMI=1:1:365 D
 . S X1=DT,X2=AMMI D C^%DTC,H^%DTC
 . S ^TMP("SDAMMS",$J,"DATE",X)=%Y I $D(^HOLIDAY(X)) S $P(^TMP("SDAMMS",$J,"DATE",X),U,2)=1
 Q
 ;
AMMSCNT S ^TMP("SDAMMS",$J,"DN")=0,^TMP("SDAMMS",$J,"HOL")=0
 S ^TMP("SDAMMS",$J,"ZERO")=^SC(AMMSD0,0)
 Q:$P(^TMP("SDAMMS",$J,"ZERO"),U,3)'="C"
 S ^TMP("SDAMMS",$J,"ACTIVE")=$G(^SC(AMMSD0,"I"))
 Q:(^TMP("SDAMMS",$J,"ACTIVE")'="")&($P(^TMP("SDAMMS",$J,"ACTIVE"),U)<DT)&($P(^TMP("SDAMMS",$J,"ACTIVE"),U,2)>DT)
 Q:('$P(^TMP("SDAMMS",$J,"ACTIVE"),U,2))&($P(^TMP("SDAMMS",$J,"ACTIVE"),U,1))
 I $P($G(^SC(AMMSD0,"SL")),U,8)="Y" S ^TMP("SDAMMS",$J,"HOL")=1
 ;
 ; no availability
 S ^TMP("SDAMMS",$J,"NOAV")=0
 I '$O(^SC(AMMSD0,"OST",AMMSZDT)),'$O(^SC(AMMSD0,"ST",AMMSZDT,0)) D
 . 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
 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
 ;
 S ^TMP("SDAMMS",$J,"FDT")=AMMSZDT,AMMSZNUM=0
 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
 . S ^TMP("SDAMMS",$J,"FDT1")=^TMP("SDAMMS",$J,"FDT"),^TMP("SDAMMS",$J,"T")="T"_+^TMP("SDAMMS",$J,"DATE",^TMP("SDAMMS",$J,"FDT"))
 . Q:'^TMP("SDAMMS",$J,"HOL")&($P(^TMP("SDAMMS",$J,"DATE",^TMP("SDAMMS",$J,"FDT")),U,2))
NOST . ;I '$D(^SC(AMMSD0,"ST",^TMP("SDAMMS",$J,"FDT"))) S ^TMP("APPT",$J,AMMSD0)=AMMSRDT_U_"0^0" Q
 .  I '$D(^SC(AMMSD0,"ST",^TMP("SDAMMS",$J,"FDT"),1)) S IEN=AMMSD0,DATE=^TMP("SDAMMS",$J,"FDT") D FIX^SDOQMP2
 . Q:'$D(^SC(AMMSD0,"ST",^TMP("SDAMMS",$J,"FDT"),1))
 . S ^TMP("SDAMMS",$J,"PAT")=^SC(AMMSD0,"ST",^TMP("SDAMMS",$J,"FDT"),1),AMMS=^TMP("SDAMMS",$J,"PAT")
 . S AMMSCNT=0,SLOTS=0
 . ; Check the pattern for available slots
 . S AMMS=$E(AMMS,6,$L(AMMS)),AMMS=$TR(AMMS,"|[] ","")
 . F %=1:1:$L(AMMS) S AMMS2=$A(AMMS,%) D
 . . I (AMMS2>48&(AMMS2<58))!((AMMS2>105)&(AMMS2<123)) S AMMSCNT=AMMSCNT+$S(AMMS2<58:$C(AMMS2),1:AMMS2-96)
 . . Q
 . S ^TMP("SDAMMS",$J,"DN")=AMMSCNT Q
DIS I '^TMP("SDAMMS",$J,"DN")&(AMMSLAST=0) S ^TMP("APPT",$J,AMMSD0)=AMMSRDT_U_"0" Q
 I '^TMP("SDAMMS",$J,"DN") S AMMSLAST=0,AMMSZDT=DT,AMMSFDT=20,AMMSFSL=33 Q
 S (AMMSNDT,Y)=^TMP("SDAMMS",$J,"FDT1")
 S:AMMSLAST=0 ^TMP("APPT",$J,AMMSD0)=AMMSRDT_U_AMMSNDT_U_AMMSCNT
 S AMMSFDT=AMMSFDT+20,AMMSFSL=AMMSFSL+20,AMMSCNT="",AMMSLAST=AMMSLAST+1,^TMP("SDAMMS",$J,"DN")=0
 I AMMSLAST'=3 S AMMSZDT=^TMP("SDAMMS",$J,"FDT1")
 I AMMSLAST=2,^TMP("SDAMMS",$J,"MGN")=0 S AMMSZDT=DT,AMMSLAST=0,^TMP("SDAMMS",$J,"DN")=0,AMMSFDT=20,AMMSFSL=33
 I AMMSLAST=3 S AMMSZDT=DT,AMMSLAST=0,^TMP("SDAMMS",$J,"DN")=0,AMMSFDT=20,AMMSFSL=33
 Q