source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDOQMP2.m@ 905

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

initial load of FOIAVistA 6/30/08 version

File size: 5.2 KB
Line 
1SDOQMP2 ;LRVAMC/JRC ;ALB/SCK - Appointment monitoring ; 7/15/96
2 ;;5.3;SCHEDULING;**47,179**;AUG 13, 1993
3 ; MODIFIED FOR NATIONAL RELEASE
4 Q
5 ;
6START D LOOP
7 S $P(^TMP("SDPM",$J,0),U,2)=DT
8 D KILL
9 Q
10LOOP S IEN=0 F S IEN=$O(^TMP("APPT",$J,IEN)) Q:IEN'>0 D
11 .S GET=$G(^TMP("APPT",$J,IEN)),DATE1=$P(GET,U,1),DATE2=$P(GET,U,2)
12 .;S RUNDATE=$E(DATE1,4,5)_$E(DATE1,6,7)_$E(DATE1,2,3)
13 .S RUNDATE=DATE1
14 .I DATE2=0 S (NEXTDATE,SLOT,TDCNT,FTCNT,XSLOT,FSLOT,OPENDAYS,DIFF,TIME)=0 D WRITE Q
15 .S X2=DATE1,X1=DATE2 D ^%DTC S DIFF=X
16 .S NEXTDATE=DATE2
17 .;S NEXTDATE=$E(DATE2,4,5)_$E(DATE2,6,7)_$E(DATE2,2,3)
18 .S SLOT=0
19 .D SLOT
20 .S TDCNT=0
21 .D:SLOT>0 TODAY
22 .S FSLOT=0,XSLOT=0
23 .D FTSLOT
24 .S TIME=".1200"
25 .D TIME
26 .S FTCNT=0
27 .D:FSLOT>0 APPT
28 .D WRITE
29 Q
30SLOT S SLDATE=DT
31 I '$D(^SC(IEN,"ST",SLDATE,1)) N DATE S DATE=DT D FIX
32 S SLOTWK=$G(^SC(IEN,"ST",SLDATE,1))
33 S:SLOTWK="" SLOT=0
34 S SLOTWK=$E(SLOTWK,6,$L(SLOTWK))
35 Q:SLOTWK'["["
36 S SLOTWK=$TR(SLOTWK,"[]*| ","")
37 S SLOT=$L(SLOTWK)
38 Q
39TODAY S DATE=DT_".000001",END=DT_".595959"
40 F S DATE=$O(^SC(IEN,"S",DATE)) Q:DATE'>0!(DATE>END) D
41 .S NODE=0 F S NODE=$O(^SC(IEN,"S",DATE,NODE)) Q:NODE'>0 D
42 ..S NODE2=0 F S NODE2=$O(^SC(IEN,"S",DATE,NODE,NODE2)) Q:NODE2'>0 D
43 ...S DFN=$P($G(^SC(IEN,"S",DATE,NODE,NODE2,0)),U)
44 ...S TDCNT=TDCNT+1
45 Q
46FTSLOT S X="T" D ^%DT S DATE=Y,OPENDAYS=0,SW=0
47 F DATE=DATE:0 S X1=DATE,X2=1 D C^%DTC S DATE=X Q:DATE>DATE2 D CHECK
48 Q
49CHECK I '$D(^SC(IEN,"ST",DATE,1)) D FIX
50 S SLOTWK=$G(^SC(IEN,"ST",DATE,1)) Q:'$L(SLOTWK)
51 Q:SLOTWK["CANCEL"
52 Q:SLOTWK'["["
53 S SLOTWK=$E(SLOTWK,6,$L(SLOTWK)),SLOTWK=$TR(SLOTWK,"[]*| ","")
54 I DATE=DATE2 D SLTCNT S FSLOT=FSLOT+XSLOT,OPENDAYS=OPENDAYS+1 Q
55 S FSLOT=FSLOT+$L(SLOTWK),OPENDAYS=OPENDAYS+1
56 Q
57SLTCNT F %=1:1:$L(SLOTWK) Q:SW=1 D
58 .S NUMBER=$E(SLOTWK,%)
59 .I NUMBER'=0 S SW=1 Q
60 .S XSLOT=XSLOT+1
61 Q
62TIME S (SW2,XCNT,XCNT1)=0
63 S SLOTWK1=$G(^SC(IEN,"ST",DATE2,1))
64 S SLOTWK1=$E(SLOTWK1,6,$L(SLOTWK1))
65 S SLOTWK1=$TR(SLOTWK1,")(]* ","")
66 F %=1:1:$L(SLOTWK1) Q:SW2=1 D
67 .S NMBR=$E(SLOTWK1,%)
68 .S:NMBR="|" XCNT=XCNT+1
69 .S:NMBR="[" SAVE=1,XCNT1=XCNT1+1
70 . ;====================== CHANGE SCK ===============================
71 . I +$G(SAVE)=1&(XCNT1=XSLOT) S SW2=1
72 ;
73 I XCNT=0 S TIME=$S(XCNT1=1:"0800",XCNT1=2:"0900",XCNT1=3:"1000",XCNT1=4:"1100",1:"1200")
74 I XCNT=1 S TIME=$S(XCNT1=1:"0900",XCNT1=2:"1000",XCNT1=3:"1100",XCNT1=4:"1200",1:"1300")
75 I XCNT=2 S TIME=$S(XCNT1=1:"1000",XCNT1=2:"1100",XCNT1=3:"1200",XCNT1=4:"1300",1:"1300")
76 I XCNT=3 S TIME=$S(XCNT1=0:"1100",XCNT1=1:"1200",XCNT1=2:"1300",XCNT1=3:"1400",XCNT1=4:"1500",1:"1500")
77 I XCNT=4 S TIME=$S(XCNT1=0:"1200",XCNT1=1:"1300",XCNT1=2:"1400",XCNT1=3:"1500",XCNT1=4:"1600",1:"1600")
78 I XCNT>4 S TIME=$S(XCNT1=0:"1200",XCNT1=1:"1300",XCNT1=2:"1400",XCNT1=3:"1500",XCNT1=4:"1600",1:"1600")
79 Q
80APPT S X="T+1" D ^%DT S DATE=Y_".000001",END=DATE2_"."_TIME
81 F S DATE=$O(^SC(IEN,"S",DATE)) Q:DATE'>0!(DATE>END) D
82 .S NODE=0 F S NODE=$O(^SC(IEN,"S",DATE,NODE)) Q:NODE'>0 D
83 ..S NODE2=0 F S NODE2=$O(^SC(IEN,"S",DATE,NODE,NODE2)) Q:NODE2'>0 D
84 ...S DFN=$P($G(^SC(IEN,"S",DATE,NODE,NODE2,0)),U)
85 ...S FTCNT=FTCNT+1
86 Q
87 ;
88WRITE ;
89 N PMDIV
90 S PMDIV=$P($G(^SC(IEN,0)),U,15)
91 S ^TMP("SDPM",$J,IEN,RUNDATE)=NEXTDATE_U_SLOT_U_TDCNT_U_FSLOT_U_FTCNT_U_OPENDAYS_U_$S(PMDIV]"":PMDIV,1:"ND")
92 Q
93 ;
94KILL K IEN,DATE1,DATE2,DATE,CNT,CNT1,CNT2,NEXTDATE,RUNDATE,SLOTS,APPTS,OPENDAYS,TIME
95 K ^TMP("APPT",$J)
96 Q
97FIX ;DH=PATTERN X=DATE
98 N SC,DAY,DH,DIFF,DOW,DR,DR1,S,SB,SDAPPT,SDAPPT1,SDSI,SDSL,SI,SL,SM,SS,STARTDAY,STR,SDSOH,HSI,P,ST S SC=IEN
99SETX Q:'$D(^SC(SC,"SL")) S SDSL=^("SL"),SL=+^("SL"),X=$P(SDSL,U,3),STARTDAY=$S($L(X):X,1:8),X=$P(SDSL,U,6),HSI=$S('X:4,X<3:8/X,1:2),SI=$S(X:X,1:4),SDSI=SI S:SI=1 SI=4 S:SI=2 SI=4 S SDSOH=$S($P(SDSL,U,8)']"":0,1:1)
100 S X=DATE D DW^%DTC S DAY=$P("SUN^MON^TUES^WEDNES^THURS^FRI^SATUR",U,Y+1),DOW=Y,X=DATE
101 S SS=+$O(^SC(SC,"T"_DOW,DATE)),SB=STARTDAY-1/100,STR="{}&%?#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz"
102 Q:'$D(^SC(SC,"T"_DOW,SS,1)) S DH=^(1) Q:DH=""
103 D SM ;G:'SDAPPT OVR
104SDAPPT S DR=+$O(^SC(SC,"S",DATE)),SDAPPT=0 I DR>(DATE_.9) S DR=DATE G OVR
105I S I=DR#1-SB*100,I=I#1*SI\.6+(I\1*SI)*2,S=$E(SM,I,999),SM=$E(SM,1,I-1)
106 I $D(^SC(SC,"S",DR,"MES")) D CAN S X=SDSAVX K SDSAVX S DR=+$O(^SC(SC,"S",DR)) G:DR\1=X I G OVR
107 F Y=0:0 S Y=$O(^SC(SC,"S",DR,1,Y)) Q:Y'>0 I $P(^(Y,0),"^",9)'["C" S SDSL=$P(^(0),U,2)/SL*(SL\(60/SDSI))*HSI-HSI F I=0:HSI:SDSL S ST=$E(S,I+2) S:ST="" ST=" " S S=$E(S,1,I+2-1)_$E(STR,$F(STR,ST)-2)_$E(S,I+3,999)
108 S SM=SM_S,DR=$O(^SC(SC,"S",DR)) I DR\1=X G I
109OVR I $L(SM)>SM S ^SC(SC,"ST",X,0)=X,^(1)=SM S:SS'>0 ^(9)=SC
110 Q ;G Z
111SM S SM=$P("SU^MO^TU^WE^TH^FR^SA",U,DOW+1)_" "_$E(X,6,7)_$J("",SI+SI-6)_DH_$J("",64-$L(DH)) Q
112APPT1 S DR=+$O(^SC(SC,"S",DATE)),SDAPPT=0 I DR>(DATE_.9) S DR=DATE Q
113 F DR1=DATE:0 S DR1=$O(^SC(SC,"S",DR1)) Q:DR1'>0!(DR1>(DATE+1))!(SDAPPT) S:$D(^(DR1,"MES")) SDAPPT=1 F SDAPPT1=0:0 S SDAPPT1=$O(^SC(SC,"S",DR1,1,SDAPPT1)) Q:SDAPPT1'>0 I $D(^(SDAPPT1,0)) S SDAPPT=$S($P(^(0),"^",9)="C":0,1:1)
114 Q
115CAN S SDSAVX=X Q:'$D(^SC(SC,"SDCAN",DR,0)) S X=$E($P(DR,".",2)_"0000",1,4),I=SM_S D TT S ST=%,X=$P(^SC(SC,"SDCAN",DR,0),"^",2) D TT S I=I_$J("",%-$L(I)),Y=""
116 F X=0:2:% S S=$E(I,X+SI+SI),P=$S(X<ST:S_$E(I,X+1+SI+SI),X=%:$S(Y="[":Y,1:S)_$E(I,X+1+SI+SI),1:$S(Y="["&(X=ST):"]",1:"X")_"X"),Y=$S(S="]":"",S="[":S,1:Y),I=$E(I,1,X-1+SI+SI)_P_$E(I,X+2+SI+SI,999)
117 S SM=I Q
118TT S %=$E(X,3,4),%=X\100-STARTDAY*SI+(%*SI\60)*2 Q
Note: See TracBrowser for help on using the repository browser.