- SDOQMP2 ;LRVAMC/JRC ;ALB/SCK - Appointment monitoring ; 7/15/96
- ;;5.3;SCHEDULING;**47,179**;AUG 13, 1993
- ; MODIFIED FOR NATIONAL RELEASE
- Q
- ;
- START D LOOP
- S $P(^TMP("SDPM",$J,0),U,2)=DT
- D KILL
- Q
- LOOP S IEN=0 F S IEN=$O(^TMP("APPT",$J,IEN)) Q:IEN'>0 D
- .S GET=$G(^TMP("APPT",$J,IEN)),DATE1=$P(GET,U,1),DATE2=$P(GET,U,2)
- .;S RUNDATE=$E(DATE1,4,5)_$E(DATE1,6,7)_$E(DATE1,2,3)
- .S RUNDATE=DATE1
- .I DATE2=0 S (NEXTDATE,SLOT,TDCNT,FTCNT,XSLOT,FSLOT,OPENDAYS,DIFF,TIME)=0 D WRITE Q
- .S X2=DATE1,X1=DATE2 D ^%DTC S DIFF=X
- .S NEXTDATE=DATE2
- .;S NEXTDATE=$E(DATE2,4,5)_$E(DATE2,6,7)_$E(DATE2,2,3)
- .S SLOT=0
- .D SLOT
- .S TDCNT=0
- .D:SLOT>0 TODAY
- .S FSLOT=0,XSLOT=0
- .D FTSLOT
- .S TIME=".1200"
- .D TIME
- .S FTCNT=0
- .D:FSLOT>0 APPT
- .D WRITE
- Q
- SLOT S SLDATE=DT
- I '$D(^SC(IEN,"ST",SLDATE,1)) N DATE S DATE=DT D FIX
- S SLOTWK=$G(^SC(IEN,"ST",SLDATE,1))
- S:SLOTWK="" SLOT=0
- S SLOTWK=$E(SLOTWK,6,$L(SLOTWK))
- Q:SLOTWK'["["
- S SLOTWK=$TR(SLOTWK,"[]*| ","")
- S SLOT=$L(SLOTWK)
- Q
- TODAY S DATE=DT_".000001",END=DT_".595959"
- F S DATE=$O(^SC(IEN,"S",DATE)) Q:DATE'>0!(DATE>END) D
- .S NODE=0 F S NODE=$O(^SC(IEN,"S",DATE,NODE)) Q:NODE'>0 D
- ..S NODE2=0 F S NODE2=$O(^SC(IEN,"S",DATE,NODE,NODE2)) Q:NODE2'>0 D
- ...S DFN=$P($G(^SC(IEN,"S",DATE,NODE,NODE2,0)),U)
- ...S TDCNT=TDCNT+1
- Q
- FTSLOT S X="T" D ^%DT S DATE=Y,OPENDAYS=0,SW=0
- F DATE=DATE:0 S X1=DATE,X2=1 D C^%DTC S DATE=X Q:DATE>DATE2 D CHECK
- Q
- CHECK I '$D(^SC(IEN,"ST",DATE,1)) D FIX
- S SLOTWK=$G(^SC(IEN,"ST",DATE,1)) Q:'$L(SLOTWK)
- Q:SLOTWK["CANCEL"
- Q:SLOTWK'["["
- S SLOTWK=$E(SLOTWK,6,$L(SLOTWK)),SLOTWK=$TR(SLOTWK,"[]*| ","")
- I DATE=DATE2 D SLTCNT S FSLOT=FSLOT+XSLOT,OPENDAYS=OPENDAYS+1 Q
- S FSLOT=FSLOT+$L(SLOTWK),OPENDAYS=OPENDAYS+1
- Q
- SLTCNT F %=1:1:$L(SLOTWK) Q:SW=1 D
- .S NUMBER=$E(SLOTWK,%)
- .I NUMBER'=0 S SW=1 Q
- .S XSLOT=XSLOT+1
- Q
- TIME S (SW2,XCNT,XCNT1)=0
- S SLOTWK1=$G(^SC(IEN,"ST",DATE2,1))
- S SLOTWK1=$E(SLOTWK1,6,$L(SLOTWK1))
- S SLOTWK1=$TR(SLOTWK1,")(]* ","")
- F %=1:1:$L(SLOTWK1) Q:SW2=1 D
- .S NMBR=$E(SLOTWK1,%)
- .S:NMBR="|" XCNT=XCNT+1
- .S:NMBR="[" SAVE=1,XCNT1=XCNT1+1
- . ;====================== CHANGE SCK ===============================
- . I +$G(SAVE)=1&(XCNT1=XSLOT) S SW2=1
- ;
- I XCNT=0 S TIME=$S(XCNT1=1:"0800",XCNT1=2:"0900",XCNT1=3:"1000",XCNT1=4:"1100",1:"1200")
- I XCNT=1 S TIME=$S(XCNT1=1:"0900",XCNT1=2:"1000",XCNT1=3:"1100",XCNT1=4:"1200",1:"1300")
- I XCNT=2 S TIME=$S(XCNT1=1:"1000",XCNT1=2:"1100",XCNT1=3:"1200",XCNT1=4:"1300",1:"1300")
- I XCNT=3 S TIME=$S(XCNT1=0:"1100",XCNT1=1:"1200",XCNT1=2:"1300",XCNT1=3:"1400",XCNT1=4:"1500",1:"1500")
- I XCNT=4 S TIME=$S(XCNT1=0:"1200",XCNT1=1:"1300",XCNT1=2:"1400",XCNT1=3:"1500",XCNT1=4:"1600",1:"1600")
- I XCNT>4 S TIME=$S(XCNT1=0:"1200",XCNT1=1:"1300",XCNT1=2:"1400",XCNT1=3:"1500",XCNT1=4:"1600",1:"1600")
- Q
- APPT S X="T+1" D ^%DT S DATE=Y_".000001",END=DATE2_"."_TIME
- F S DATE=$O(^SC(IEN,"S",DATE)) Q:DATE'>0!(DATE>END) D
- .S NODE=0 F S NODE=$O(^SC(IEN,"S",DATE,NODE)) Q:NODE'>0 D
- ..S NODE2=0 F S NODE2=$O(^SC(IEN,"S",DATE,NODE,NODE2)) Q:NODE2'>0 D
- ...S DFN=$P($G(^SC(IEN,"S",DATE,NODE,NODE2,0)),U)
- ...S FTCNT=FTCNT+1
- Q
- ;
- WRITE ;
- N PMDIV
- S PMDIV=$P($G(^SC(IEN,0)),U,15)
- S ^TMP("SDPM",$J,IEN,RUNDATE)=NEXTDATE_U_SLOT_U_TDCNT_U_FSLOT_U_FTCNT_U_OPENDAYS_U_$S(PMDIV]"":PMDIV,1:"ND")
- Q
- ;
- KILL K IEN,DATE1,DATE2,DATE,CNT,CNT1,CNT2,NEXTDATE,RUNDATE,SLOTS,APPTS,OPENDAYS,TIME
- K ^TMP("APPT",$J)
- Q
- FIX ;DH=PATTERN X=DATE
- 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
- SETX 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)
- S X=DATE D DW^%DTC S DAY=$P("SUN^MON^TUES^WEDNES^THURS^FRI^SATUR",U,Y+1),DOW=Y,X=DATE
- S SS=+$O(^SC(SC,"T"_DOW,DATE)),SB=STARTDAY-1/100,STR="{}&%?#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz"
- Q:'$D(^SC(SC,"T"_DOW,SS,1)) S DH=^(1) Q:DH=""
- D SM ;G:'SDAPPT OVR
- SDAPPT S DR=+$O(^SC(SC,"S",DATE)),SDAPPT=0 I DR>(DATE_.9) S DR=DATE G OVR
- I 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)
- 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
- 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)
- S SM=SM_S,DR=$O(^SC(SC,"S",DR)) I DR\1=X G I
- OVR I $L(SM)>SM S ^SC(SC,"ST",X,0)=X,^(1)=SM S:SS'>0 ^(9)=SC
- Q ;G Z
- SM 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
- APPT1 S DR=+$O(^SC(SC,"S",DATE)),SDAPPT=0 I DR>(DATE_.9) S DR=DATE Q
- 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)
- Q
- CAN 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=""
- 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)
- S SM=I Q
- TT S %=$E(X,3,4),%=X\100-STARTDAY*SI+(%*SI\60)*2 Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDOQMP2 5478 printed Feb 19, 2025@00:25:46 Page 2
- SDOQMP2 ;LRVAMC/JRC ;ALB/SCK - Appointment monitoring ; 7/15/96
- +1 ;;5.3;SCHEDULING;**47,179**;AUG 13, 1993
- +2 ; MODIFIED FOR NATIONAL RELEASE
- +3 QUIT
- +4 ;
- START DO LOOP
- +1 SET $PIECE(^TMP("SDPM",$JOB,0),U,2)=DT
- +2 DO KILL
- +3 QUIT
- LOOP SET IEN=0
- FOR
- SET IEN=$ORDER(^TMP("APPT",$JOB,IEN))
- if IEN'>0
- QUIT
- Begin DoDot:1
- +1 SET GET=$GET(^TMP("APPT",$JOB,IEN))
- SET DATE1=$PIECE(GET,U,1)
- SET DATE2=$PIECE(GET,U,2)
- +2 ;S RUNDATE=$E(DATE1,4,5)_$E(DATE1,6,7)_$E(DATE1,2,3)
- +3 SET RUNDATE=DATE1
- +4 IF DATE2=0
- SET (NEXTDATE,SLOT,TDCNT,FTCNT,XSLOT,FSLOT,OPENDAYS,DIFF,TIME)=0
- DO WRITE
- QUIT
- +5 SET X2=DATE1
- SET X1=DATE2
- DO ^%DTC
- SET DIFF=X
- +6 SET NEXTDATE=DATE2
- +7 ;S NEXTDATE=$E(DATE2,4,5)_$E(DATE2,6,7)_$E(DATE2,2,3)
- +8 SET SLOT=0
- +9 DO SLOT
- +10 SET TDCNT=0
- +11 if SLOT>0
- DO TODAY
- +12 SET FSLOT=0
- SET XSLOT=0
- +13 DO FTSLOT
- +14 SET TIME=".1200"
- +15 DO TIME
- +16 SET FTCNT=0
- +17 if FSLOT>0
- DO APPT
- +18 DO WRITE
- End DoDot:1
- +19 QUIT
- SLOT SET SLDATE=DT
- +1 IF '$DATA(^SC(IEN,"ST",SLDATE,1))
- NEW DATE
- SET DATE=DT
- DO FIX
- +2 SET SLOTWK=$GET(^SC(IEN,"ST",SLDATE,1))
- +3 if SLOTWK=""
- SET SLOT=0
- +4 SET SLOTWK=$EXTRACT(SLOTWK,6,$LENGTH(SLOTWK))
- +5 if SLOTWK'["["
- QUIT
- +6 SET SLOTWK=$TRANSLATE(SLOTWK,"[]*| ","")
- +7 SET SLOT=$LENGTH(SLOTWK)
- +8 QUIT
- TODAY SET DATE=DT_".000001"
- SET END=DT_".595959"
- +1 FOR
- SET DATE=$ORDER(^SC(IEN,"S",DATE))
- if DATE'>0!(DATE>END)
- QUIT
- Begin DoDot:1
- +2 SET NODE=0
- FOR
- SET NODE=$ORDER(^SC(IEN,"S",DATE,NODE))
- if NODE'>0
- QUIT
- Begin DoDot:2
- +3 SET NODE2=0
- FOR
- SET NODE2=$ORDER(^SC(IEN,"S",DATE,NODE,NODE2))
- if NODE2'>0
- QUIT
- Begin DoDot:3
- +4 SET DFN=$PIECE($GET(^SC(IEN,"S",DATE,NODE,NODE2,0)),U)
- +5 SET TDCNT=TDCNT+1
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +6 QUIT
- FTSLOT SET X="T"
- DO ^%DT
- SET DATE=Y
- SET OPENDAYS=0
- SET SW=0
- +1 FOR DATE=DATE:0
- SET X1=DATE
- SET X2=1
- DO C^%DTC
- SET DATE=X
- if DATE>DATE2
- QUIT
- DO CHECK
- +2 QUIT
- CHECK IF '$DATA(^SC(IEN,"ST",DATE,1))
- DO FIX
- +1 SET SLOTWK=$GET(^SC(IEN,"ST",DATE,1))
- if '$LENGTH(SLOTWK)
- QUIT
- +2 if SLOTWK["CANCEL"
- QUIT
- +3 if SLOTWK'["["
- QUIT
- +4 SET SLOTWK=$EXTRACT(SLOTWK,6,$LENGTH(SLOTWK))
- SET SLOTWK=$TRANSLATE(SLOTWK,"[]*| ","")
- +5 IF DATE=DATE2
- DO SLTCNT
- SET FSLOT=FSLOT+XSLOT
- SET OPENDAYS=OPENDAYS+1
- QUIT
- +6 SET FSLOT=FSLOT+$LENGTH(SLOTWK)
- SET OPENDAYS=OPENDAYS+1
- +7 QUIT
- SLTCNT FOR %=1:1:$LENGTH(SLOTWK)
- if SW=1
- QUIT
- Begin DoDot:1
- +1 SET NUMBER=$EXTRACT(SLOTWK,%)
- +2 IF NUMBER'=0
- SET SW=1
- QUIT
- +3 SET XSLOT=XSLOT+1
- End DoDot:1
- +4 QUIT
- TIME SET (SW2,XCNT,XCNT1)=0
- +1 SET SLOTWK1=$GET(^SC(IEN,"ST",DATE2,1))
- +2 SET SLOTWK1=$EXTRACT(SLOTWK1,6,$LENGTH(SLOTWK1))
- +3 SET SLOTWK1=$TRANSLATE(SLOTWK1,")(]* ","")
- +4 FOR %=1:1:$LENGTH(SLOTWK1)
- if SW2=1
- QUIT
- Begin DoDot:1
- +5 SET NMBR=$EXTRACT(SLOTWK1,%)
- +6 if NMBR="|"
- SET XCNT=XCNT+1
- +7 if NMBR="["
- SET SAVE=1
- SET XCNT1=XCNT1+1
- +8 ;====================== CHANGE SCK ===============================
- +9 IF +$GET(SAVE)=1&(XCNT1=XSLOT)
- SET SW2=1
- End DoDot:1
- +10 ;
- +11 IF XCNT=0
- SET TIME=$SELECT(XCNT1=1:"0800",XCNT1=2:"0900",XCNT1=3:"1000",XCNT1=4:"1100",1:"1200")
- +12 IF XCNT=1
- SET TIME=$SELECT(XCNT1=1:"0900",XCNT1=2:"1000",XCNT1=3:"1100",XCNT1=4:"1200",1:"1300")
- +13 IF XCNT=2
- SET TIME=$SELECT(XCNT1=1:"1000",XCNT1=2:"1100",XCNT1=3:"1200",XCNT1=4:"1300",1:"1300")
- +14 IF XCNT=3
- SET TIME=$SELECT(XCNT1=0:"1100",XCNT1=1:"1200",XCNT1=2:"1300",XCNT1=3:"1400",XCNT1=4:"1500",1:"1500")
- +15 IF XCNT=4
- SET TIME=$SELECT(XCNT1=0:"1200",XCNT1=1:"1300",XCNT1=2:"1400",XCNT1=3:"1500",XCNT1=4:"1600",1:"1600")
- +16 IF XCNT>4
- SET TIME=$SELECT(XCNT1=0:"1200",XCNT1=1:"1300",XCNT1=2:"1400",XCNT1=3:"1500",XCNT1=4:"1600",1:"1600")
- +17 QUIT
- APPT SET X="T+1"
- DO ^%DT
- SET DATE=Y_".000001"
- SET END=DATE2_"."_TIME
- +1 FOR
- SET DATE=$ORDER(^SC(IEN,"S",DATE))
- if DATE'>0!(DATE>END)
- QUIT
- Begin DoDot:1
- +2 SET NODE=0
- FOR
- SET NODE=$ORDER(^SC(IEN,"S",DATE,NODE))
- if NODE'>0
- QUIT
- Begin DoDot:2
- +3 SET NODE2=0
- FOR
- SET NODE2=$ORDER(^SC(IEN,"S",DATE,NODE,NODE2))
- if NODE2'>0
- QUIT
- Begin DoDot:3
- +4 SET DFN=$PIECE($GET(^SC(IEN,"S",DATE,NODE,NODE2,0)),U)
- +5 SET FTCNT=FTCNT+1
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +6 QUIT
- +7 ;
- WRITE ;
- +1 NEW PMDIV
- +2 SET PMDIV=$PIECE($GET(^SC(IEN,0)),U,15)
- +3 SET ^TMP("SDPM",$JOB,IEN,RUNDATE)=NEXTDATE_U_SLOT_U_TDCNT_U_FSLOT_U_FTCNT_U_OPENDAYS_U_$SELECT(PMDIV]"":PMDIV,1:"ND")
- +4 QUIT
- +5 ;
- KILL KILL IEN,DATE1,DATE2,DATE,CNT,CNT1,CNT2,NEXTDATE,RUNDATE,SLOTS,APPTS,OPENDAYS,TIME
- +1 KILL ^TMP("APPT",$JOB)
- +2 QUIT
- FIX ;DH=PATTERN X=DATE
- +1 NEW SC,DAY,DH,DIFF,DOW,DR,DR1,S,SB,SDAPPT,SDAPPT1,SDSI,SDSL,SI,SL,SM,SS,STARTDAY,STR,SDSOH,HSI,P,ST
- SET SC=IEN
- SETX if '$DATA(^SC(SC,"SL"))
- QUIT
- SET SDSL=^("SL")
- SET SL=+^("SL")
- SET X=$PIECE(SDSL,U,3)
- SET STARTDAY=$SELECT($LENGTH(X):X,1:8)
- SET X=$PIECE(SDSL,U,6)
- SET HSI=$SELECT('X:4,X<3:8/X,1:2)
- SET SI=$SELECT(X:X,1:4)
- SET SDSI=SI
- if SI=1
- SET SI=4
- if SI=2
- SET SI=4
- SET SDSOH=$SELECT($PIECE(SDSL,U,8)']"":0,1:1)
- +1 SET X=DATE
- DO DW^%DTC
- SET DAY=$PIECE("SUN^MON^TUES^WEDNES^THURS^FRI^SATUR",U,Y+1)
- SET DOW=Y
- SET X=DATE
- +2 SET SS=+$ORDER(^SC(SC,"T"_DOW,DATE))
- SET SB=STARTDAY-1/100
- SET STR="{}&%?#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz"
- +3 if '$DATA(^SC(SC,"T"_DOW,SS,1))
- QUIT
- SET DH=^(1)
- if DH=""
- QUIT
- +4 ;G:'SDAPPT OVR
- DO SM
- SDAPPT SET DR=+$ORDER(^SC(SC,"S",DATE))
- SET SDAPPT=0
- IF DR>(DATE_.9)
- SET DR=DATE
- GOTO OVR
- I SET I=DR#1-SB*100
- SET I=I#1*SI\.6+(I\1*SI)*2
- SET S=$EXTRACT(SM,I,999)
- SET SM=$EXTRACT(SM,1,I-1)
- +1 IF $DATA(^SC(SC,"S",DR,"MES"))
- DO CAN
- SET X=SDSAVX
- KILL SDSAVX
- SET DR=+$ORDER(^SC(SC,"S",DR))
- if DR\1=X
- GOTO I
- GOTO OVR
- +2 FOR Y=0:0
- SET Y=$ORDER(^SC(SC,"S",DR,1,Y))
- if Y'>0
- QUIT
- IF $PIECE(^(Y,0),"^",9)'["C"
- SET SDSL=$PIECE(^(0),U,2)/SL*(SL\(60/SDSI))*HSI-HSI
- FOR I=0:HSI:SDSL
- SET ST=$EXTRACT(S,I+2)
- if ST=""
- SET ST=" "
- SET S=$EXTRACT(S,1,I+2-1)_$EXTRACT(STR,$FIND(STR,ST)-2)_$EXTRACT(S,I+3,999)
- +3 SET SM=SM_S
- SET DR=$ORDER(^SC(SC,"S",DR))
- IF DR\1=X
- GOTO I
- OVR IF $LENGTH(SM)>SM
- SET ^SC(SC,"ST",X,0)=X
- SET ^(1)=SM
- if SS'>0
- SET ^(9)=SC
- +1 ;G Z
- QUIT
- SM SET SM=$PIECE("SU^MO^TU^WE^TH^FR^SA",U,DOW+1)_" "_$EXTRACT(X,6,7)_$JUSTIFY("",SI+SI-6)_DH_$JUSTIFY("",64-$LENGTH(DH))
- QUIT
- APPT1 SET DR=+$ORDER(^SC(SC,"S",DATE))
- SET SDAPPT=0
- IF DR>(DATE_.9)
- SET DR=DATE
- QUIT
- +1 FOR DR1=DATE:0
- SET DR1=$ORDER(^SC(SC,"S",DR1))
- if DR1'>0!(DR1>(DATE+1))!(SDAPPT)
- QUIT
- if $DATA(^(DR1,"MES"))
- SET SDAPPT=1
- FOR SDAPPT1=0:0
- SET SDAPPT1=$ORDER(^SC(SC,"S",DR1,1,SDAPPT1))
- if SDAPPT1'>0
- QUIT
- IF $DATA(^(SDAPPT1,0))
- SET SDAPPT=$SELECT($PIECE(^(0),"^",9)="C":0,1:1)
- +2 QUIT
- CAN SET SDSAVX=X
- if '$DATA(^SC(SC,"SDCAN",DR,0))
- QUIT
- SET X=$EXTRACT($PIECE(DR,".",2)_"0000",1,4)
- SET I=SM_S
- DO TT
- SET ST=%
- SET X=$PIECE(^SC(SC,"SDCAN",DR,0),"^",2)
- DO TT
- SET I=I_$JUSTIFY("",%-$LENGTH(I))
- SET Y=""
- +1 FOR X=0:2:%
- SET S=$EXTRACT(I,X+SI+SI)
- SET P=$SELECT(X<ST:S_$EXTRACT(I,X+1+SI+SI),X=%:$SELECT(Y="[":Y,1:S)_$EXTRACT(I,X+1+SI+SI),1:$SELECT(Y="["&(X=ST):"]",1:"X")_"X")
- SET Y=$SELECT(S="]":"",S="[":S,1:Y)
- SET I=$EXTRACT(I,1,X-1+SI+SI)_P_$EXTRACT(I,X+2+SI+SI,999)
- +2 SET SM=I
- QUIT
- TT SET %=$EXTRACT(X,3,4)
- SET %=X\100-STARTDAY*SI+(%*SI\60)*2
- QUIT