SDUNC ;MAN/GRR - RESTORE CLINIC AVAILABILITY ; 24 JUL 2003 10:08 am
;;5.3;Scheduling;**79,303,380,452,1006,1015**;Aug 13, 1993;Build 21
;IHS/ANMC/LJF 8/18/2000 added DIC("W") to warn if clinic inactivated
; 11/30/2000 changed $N to $O
; 12/13/2000 added code for 10 hour clinic displays
; 12/18/2002 added check so only onwers can restore clinic
;IHS/OIT/LJF 06/28/2006 PATCH 1006 if clinic pattern was deleted by a future inactivation, cannot restore
;
;D DT^DICRW S DIC=44,DIC(0)="MEQA",DIC("S")="I $P(^(0),""^"",3)=""C"",'$G(^(""OOS""))",DIC("A")="Select CLINIC NAME: " D ^DIC K DIC("S"),DIC("A") Q:"^"[X G:Y<0 SDUNC Q:'$D(^SC(+Y,"SL")) ;IHS/ANMC/LJF 8/18/2000
D DT^DICRW S DIC=44,DIC(0)="MEQA",DIC("S")="I $P(^(0),""^"",3)=""C"",'$G(^(""OOS""))",DIC("A")="Select CLINIC NAME: ",DIC("W")=$$INACTMSG^BSDU D ^DIC K DIC("S"),DIC("A") Q:"^"[X G:Y<0 SDUNC Q:'$D(^SC(+Y,"SL")) ;IHS/ANMC/LJF 8/18/2000
;1/9/2003 WAR per P46,LJF37
I '$$OWNER^BSDU(+Y,+$G(DUZ)) D MSG^BDGF("You are NOT an owner of this clinic. Please select again.",2,1) G SDUNC ;IHS/ANMC/LJF 12/18/2002
I $D(^SC(+Y,0)) ;IHS/ANMC/LJF 12/18/2002 restoring naked reference
S SC=+Y,SL=^("SL") ;NAKED REFERENCE - ^SC(IFN,"SL")
N SDRES S SDRES=$$CLNCK^SDUTL2(SC,1)
I 'SDRES W !,?5,"Clinic MUST be corrected before continuing." G SDUNC
S %DT="AEXF",%DT("A")="RESTORE '"_$P(Y,U,2)_"' FOR WHAT DATE: " D ^%DT K %DT Q:Y<0
S (SD,CDATE)=Y,%=$P(SL,U,6),SI=$S(%="":4,%<3:4,%:%,1:4),%=$P(SL,U,3),STARTDAY=$S(%:%,1:8)
K SDIN,SDIN1,SDRE,SDRE1 I $D(^SC(SC,"I")) S SDIN=+^("I"),SDRE=+$P(^("I"),"^",2),Y=SDIN D DTS^SDUTL S SDIN1=Y,Y=SDRE D DTS^SDUTL S SDRE1=Y
I $S('$D(SDIN):0,'SDIN:0,SDIN>CDATE:0,SDRE'>CDATE&(SDRE):0,1:1) W !,*7,"Clinic is inactive ",$S(SDRE:"from ",1:"as of "),SDIN1,$S(SDRE:" to "_SDRE1,1:"") G SDUNC
K SDIN,SDIN1,SDRE,SDRE1 G:'$D(^SC(SC,"ST",SD,1)) NOWAY
I $D(^SC(SC,"ST",SD,1)),^(1)'["CANCELLED"&(^(1)'["X") G NOWAY
I $D(^SC(SC,"ST",SD,9)) I $D(^SC(SC,"OST",SD,1)) D FIX Q:^SC(SC,"ST",SD,1)["X"&('$D(SDFR1)) S ^SC(SC,"ST",SD,1)=HOLD K:^(1)'["X" ^SC(SC,"ST",SD,"CAN") W !,"RESTORED!",*7 D CHK Q
I $D(^SC(SC,"ST",SD,9)),'$D(^SC(SC,"OST",SD,1)) G ERRM^SDUNC1
;
;IHS/OIT/LJF 06/28/2006 PATCH 1006
;D B Q:^SC(SC,"ST",SD,1)["X"&('$D(SDFR1)) S ^SC(SC,"ST",SD,0)=SD,^SC(SC,"ST",SD,1)=DH G N
D B Q:^SC(SC,"ST",SD,1)["X"&('$D(SDFR1))
I '$D(DH) W !!,"**** This date CANNOT be RESTORED. ****",!,"Clinic has been INACTIVATED and default slots have been removed.",!,"You must enter the AVAILABILITY again under Set Up A Clinic." Q ;new code
S ^SC(SC,"ST",SD,0)=SD,^SC(SC,"ST",SD,1)=DH G N
;IHS/OIT/LJF 06/28/2006 end of PATCH 1006 changes
;
Q:^SC(SC,"ST",SD,1)["X"&('$D(SDFR1)) S ^SC(SC,"ST",SD,0)=SD,^SC(SC,"ST",SD,1)=DH G N
NOWAY W !,*7,"CLINIC HAS NOT BEEN CANCELLED FOR THAT DATE, SO IT CANNOT BE RESTORED",*7 G SDUNC
NOPAT W !,*7,"NO UPCOMING OR INDEFINITE APPOINTMENT PATTERN EXISTS FOR DAY OF WEEK,",!,"CREATE 'AVAILABILITY' PATTERN THRU 'CLINIC SETUP', THEN RESTORE AGAIN",*7 G SDUNC
B S X=SD D DOW^SDM0 S DOW=Y,SS=$O(^SC(SC,"T"_Y,X)) I SS'="",$D(^(SS,1)),^(1)]"" S DH=$P("SU^MO^TU^WE^TH^FR^SA","^",DOW+1)_" "_$E(SD,6,7)_$J("",SI+SI-6)_^(1),DO=X+1,DA(1)=SC,HOLD=DH D FIX2
Q
N I '$F(^SC(SC,"ST",SD,1),"[") K ^SC(SC,"ST",SD) W !,*7,"CLINIC DOES NOT MEET ON THAT DAY" G SDUNC
K:^SC(SC,"ST",SD,1)'["X" ^SC(SC,"ST",SD,"CAN") W !,"RESTORED!",*7 D CHK Q
FIX I ^SC(SC,"ST",SD,1)["X" S SDREST=^SC(SC,"OST",SD,1) D SEL Q
S HOLD=^SC(SC,"OST",SD,1)
Q
CHK F N1=SD:0 S N1=$O(^SC(SC,"S",N1)) Q:'N1!(N1\1-SD) I $D(^SC(SC,"S",N1,"MES")) D KMES I $D(SDFR1),'$D(^("MES")) Q
Q
FIX2 Q:^SC(SC,"ST",SD,1)'["X"
S SDREST=DH D SEL Q:'$D(SDFR1) S DH=HOLD
Q
SEL K SDFR1 Q:'$D(^SC(SC,"SL")) S SL=^("SL"),%=$P(SL,U,6),SI=$S(%="":4,%<3:4,%:%,1:4),%=$P(SL,U,3),STARTDAY=$S(%:%,1:8)
W !,"Clinic has been cancelled for the following periods:",!
;
;IHS/ANMC/LJF 11/30/2000 $N->$O
;K SDTEMP,SDZZ S SDZZ=0 F I=SD:0 S I=$N(^SC(SC,"SDCAN",I)) Q:I'>0!(I\1-SD) S SDZZ=SDZZ+1,X=I D TM S SDFR=X,SDFRX=X1,X="."_$P(^(I,0),"^",2) D TM S SDTO=X,SDTEMP(SDFRX_"-"_X1)=SDFR_"^"_SDTO,SDZZ(SDZZ)=SDFRX_"-"_X1
K SDTEMP,SDZZ S SDZZ=0 F I=SD:0 S I=$O(^SC(SC,"SDCAN",I)) Q:I'>0!(I\1-SD) S SDZZ=SDZZ+1,X=I D TM S SDFR=X,SDFRX=X1,X="."_$P(^(I,0),"^",2) D TM S SDTO=X,SDTEMP(SDFRX_"-"_X1)=SDFR_"^"_SDTO,SDZZ(SDZZ)=SDFRX_"-"_X1
;F I=SD:0 S I=$N(^SC(SC,"S",I)) Q:I'>0!(I\1-SD) I $D(^SC(SC,"S",I,"MES")),'$D(^SC(SC,"SDCAN",I)) S X=I D TM S SDFRX=X1,SDFR=X,X="."_$E(^SC(SC,"S",I,"MES"),17,20) D TM S SDZZ=SDZZ+1,SDTEMP(SDFRX_"-"_X1)=SDFR_"^"_X,SDZZ(SDZZ)=SDFRX_"-"_X1
F I=SD:0 S I=$O(^SC(SC,"S",I)) Q:I'>0!(I\1-SD) I $D(^SC(SC,"S",I,"MES")),'$D(^SC(SC,"SDCAN",I)) S X=I D TM S SDFRX=X1,SDFR=X,X="."_$E(^SC(SC,"S",I,"MES"),17,20) D TM S SDZZ=SDZZ+1,SDTEMP(SDFRX_"-"_X1)=SDFR_"^"_X,SDZZ(SDZZ)=SDFRX_"-"_X1
;F I1=0:0 S I1=$N(SDZZ(I1)) Q:I1'>0 S I=SDTEMP(SDZZ(I1)) W !,?9,"(",$J(I1,2),") ","From: ",$J($P(I,"^",1),8)," To: ",$J($P(I,"^",2),8)
F I1=0:0 S I1=$O(SDZZ(I1)) Q:I1'>0 S I=SDTEMP(SDZZ(I1)) W !,?9,"(",$J(I1,2),") ","From: ",$J($P(I,"^",1),8)," To: ",$J($P(I,"^",2),8)
;
A K SDFRX,X1,SDFR,SDTO R !!,"RESTORE WHICH PERIOD?: ",X:DTIME Q:"^"[X
I X?1"?".E W !,"Enter the # that precedes the time period you want to restore." G A
S SDR=X I $D(SDZZ(SDR)),$D(SDTEMP(SDZZ(SDR))) W " ",$P(SDTEMP(SDZZ(SDR)),"^",1)," - ",$P(SDTEMP(SDZZ(SDR)),"^",2) G ROK
W !,*7,"INVALID CHOICE, TRY AGAIN" G A
ROK S X=$P(SDZZ(SDR),"-",1) D TC S FR=X,SDBEG=%+SI+SI,X=$P(SDZZ(SDR),"-",2) D TC S TO=X,SDEND=%+SI+SI
S SDFR1=CDATE+(FR/10000) K SDTEMP,SDZZ,SDR
;S HOLD=^SC(SC,"ST",SD,1),HOLD=$E(HOLD,1,SDBEG-1)_$E(SDREST,SDBEG,SDEND)_$E(HOLD,SDEND+1,80) K ^SC(SC,"SDCAN",SDFR1) I $D(^SC(SC,"SDCAN",0)) S CNT=$P(^(0),U,4),CNT=$S(CNT>0:CNT-1,1:0),^(0)=$P(^(0),U,1,3)_U_CNT K CNT ;IHS/ANMC/LJF 12/13/2000
S HOLD=^SC(SC,"ST",SD,1),HOLD=$E(HOLD,1,SDBEG-1)_$E(SDREST,SDBEG,SDEND)_$E(HOLD,SDEND+1,132) K ^SC(SC,"SDCAN",SDFR1) I $D(^SC(SC,"SDCAN",0)) S CNT=$P(^(0),U,4),CNT=$S(CNT>0:CNT-1,1:0),^(0)=$P(^(0),U,1,3)_U_CNT K CNT ;IHS/ANMC/LJF 12/13/2000
I HOLD'["[" S I5=$F(HOLD,"|"),HOLD=$E(HOLD,1,(I5-2))_"["_$E(HOLD,I5,999) K I5
K SDBEG,SDEND,SDANS,SI,STARTDAY,FR,TO Q
KMES I '$D(SDFR1) K ^("MES") Q ;NAKED REFERENCE - ^SC(IFN,"S",DATE,"MES")
I $D(SDFR1),N1=SDFR1 K ^("MES") Q ;NAKED REFERENCE - ^SC(IFN,"S",DATE,"MES")
Q
TC S %=$E(X,3,4),%=X\100-STARTDAY*SI+(%*SI\60)*2
Q
TM S X=$E($P(X,".",2)_"0000",1,4),X1=X,%=X>1159 S:X>1259 X=X-1200 S X=X\100_":"_$E(X#100+100,2,3)_" "_$E("AP",%+1)_"M" Q
SDUNC ;MAN/GRR - RESTORE CLINIC AVAILABILITY ; 24 JUL 2003 10:08 am
+1 ;;5.3;Scheduling;**79,303,380,452,1006,1015**;Aug 13, 1993;Build 21
+2 ;IHS/ANMC/LJF 8/18/2000 added DIC("W") to warn if clinic inactivated
+3 ; 11/30/2000 changed $N to $O
+4 ; 12/13/2000 added code for 10 hour clinic displays
+5 ; 12/18/2002 added check so only onwers can restore clinic
+6 ;IHS/OIT/LJF 06/28/2006 PATCH 1006 if clinic pattern was deleted by a future inactivation, cannot restore
+7 ;
+8 ;D DT^DICRW S DIC=44,DIC(0)="MEQA",DIC("S")="I $P(^(0),""^"",3)=""C"",'$G(^(""OOS""))",DIC("A")="Select CLINIC NAME: " D ^DIC K DIC("S"),DIC("A") Q:"^"[X G:Y<0 SDUNC Q:'$D(^SC(+Y,"SL")) ;IHS/ANMC/LJF 8/18/2000
+9 ;IHS/ANMC/LJF 8/18/2000
DO DT^DICRW
SET DIC=44
SET DIC(0)="MEQA"
SET DIC("S")="I $P(^(0),""^"",3)=""C"",'$G(^(""OOS""))"
SET DIC("A")="Select CLINIC NAME: "
SET DIC("W")=$$INACTMSG^BSDU
DO ^DIC
KILL DIC("S"),DIC("A")
IF "^"[X
QUIT
IF Y<0
GOTO SDUNC
IF '$DATA(^SC(+Y,"SL"))
QUIT
+10 ;1/9/2003 WAR per P46,LJF37
+11 ;IHS/ANMC/LJF 12/18/2002
IF '$$OWNER^BSDU(+Y,+$GET(DUZ))
DO MSG^BDGF("You are NOT an owner of this clinic. Please select again.",2,1)
GOTO SDUNC
+12 ;IHS/ANMC/LJF 12/18/2002 restoring naked reference
IF $DATA(^SC(+Y,0))
+13 ;NAKED REFERENCE - ^SC(IFN,"SL")
SET SC=+Y
SET SL=^("SL")
+14 NEW SDRES
SET SDRES=$$CLNCK^SDUTL2(SC,1)
+15 IF 'SDRES
WRITE !,?5,"Clinic MUST be corrected before continuing."
GOTO SDUNC
+16 SET %DT="AEXF"
SET %DT("A")="RESTORE '"_$PIECE(Y,U,2)_"' FOR WHAT DATE: "
DO ^%DT
KILL %DT
IF Y<0
QUIT
+17 SET (SD,CDATE)=Y
SET %=$PIECE(SL,U,6)
SET SI=$SELECT(%="":4,%<3:4,%:%,1:4)
SET %=$PIECE(SL,U,3)
SET STARTDAY=$SELECT(%:%,1:8)
+18 KILL SDIN,SDIN1,SDRE,SDRE1
IF $DATA(^SC(SC,"I"))
SET SDIN=+^("I")
SET SDRE=+$PIECE(^("I"),"^",2)
SET Y=SDIN
DO DTS^SDUTL
SET SDIN1=Y
SET Y=SDRE
DO DTS^SDUTL
SET SDRE1=Y
+19 IF $SELECT('$DATA(SDIN):0,'SDIN:0,SDIN>CDATE:0,SDRE'>CDATE&(SDRE):0,1:1)
WRITE !,*7,"Clinic is inactive ",$SELECT(SDRE:"from ",1:"as of "),SDIN1,$SELECT(SDRE:" to "_SDRE1,1:"")
GOTO SDUNC
+20 KILL SDIN,SDIN1,SDRE,SDRE1
IF '$DATA(^SC(SC,"ST",SD,1))
GOTO NOWAY
+21 IF $DATA(^SC(SC,"ST",SD,1))
IF ^(1)'["CANCELLED"&(^(1)'["X")
GOTO NOWAY
+22 IF $DATA(^SC(SC,"ST",SD,9))
IF $DATA(^SC(SC,"OST",SD,1))
DO FIX
IF ^SC(SC,"ST",SD,1)["X"&('$DATA(SDFR1))
QUIT
SET ^SC(SC,"ST",SD,1)=HOLD
IF ^(1)'["X"
KILL ^SC(SC,"ST",SD,"CAN")
WRITE !,"RESTORED!",*7
DO CHK
QUIT
+23 IF $DATA(^SC(SC,"ST",SD,9))
IF '$DATA(^SC(SC,"OST",SD,1))
GOTO ERRM^SDUNC1
+24 ;
+25 ;IHS/OIT/LJF 06/28/2006 PATCH 1006
+26 ;D B Q:^SC(SC,"ST",SD,1)["X"&('$D(SDFR1)) S ^SC(SC,"ST",SD,0)=SD,^SC(SC,"ST",SD,1)=DH G N
+27 DO B
IF ^SC(SC,"ST",SD,1)["X"&('$DATA(SDFR1))
QUIT
+28 ;new code
IF '$DATA(DH)
WRITE !!,"**** This date CANNOT be RESTORED. ****",!,"Clinic has been INACTIVATED and default slots have been removed.",!,"You must enter the AVAILABILITY again under Set Up A Clinic."
QUIT
+29 SET ^SC(SC,"ST",SD,0)=SD
SET ^SC(SC,"ST",SD,1)=DH
GOTO N
+30 ;IHS/OIT/LJF 06/28/2006 end of PATCH 1006 changes
+31 ;
+32 IF ^SC(SC,"ST",SD,1)["X"&('$DATA(SDFR1))
QUIT
SET ^SC(SC,"ST",SD,0)=SD
SET ^SC(SC,"ST",SD,1)=DH
GOTO N
NOWAY WRITE !,*7,"CLINIC HAS NOT BEEN CANCELLED FOR THAT DATE, SO IT CANNOT BE RESTORED",*7
GOTO SDUNC
NOPAT WRITE !,*7,"NO UPCOMING OR INDEFINITE APPOINTMENT PATTERN EXISTS FOR DAY OF WEEK,",!,"CREATE 'AVAILABILITY' PATTERN THRU 'CLINIC SETUP', THEN RESTORE AGAIN",*7
GOTO SDUNC
B SET X=SD
DO DOW^SDM0
SET DOW=Y
SET SS=$ORDER(^SC(SC,"T"_Y,X))
IF SS'=""
IF $DATA(^(SS,1))
IF ^(1)]""
SET DH=$PIECE("SU^MO^TU^WE^TH^FR^SA","^",DOW+1)_" "_$EXTRACT(SD,6,7)_$JUSTIFY("",SI+SI-6)_^(1)
SET DO=X+1
SET DA(1)=SC
SET HOLD=DH
DO FIX2
+1 QUIT
N IF '$FIND(^SC(SC,"ST",SD,1),"[")
KILL ^SC(SC,"ST",SD)
WRITE !,*7,"CLINIC DOES NOT MEET ON THAT DAY"
GOTO SDUNC
+1 IF ^SC(SC,"ST",SD,1)'["X"
KILL ^SC(SC,"ST",SD,"CAN")
WRITE !,"RESTORED!",*7
DO CHK
QUIT
FIX IF ^SC(SC,"ST",SD,1)["X"
SET SDREST=^SC(SC,"OST",SD,1)
DO SEL
QUIT
+1 SET HOLD=^SC(SC,"OST",SD,1)
+2 QUIT
CHK FOR N1=SD:0
SET N1=$ORDER(^SC(SC,"S",N1))
IF 'N1!(N1\1-SD)
QUIT
IF $DATA(^SC(SC,"S",N1,"MES"))
DO KMES
IF $DATA(SDFR1)
IF '$DATA(^("MES"))
QUIT
+1 QUIT
FIX2 IF ^SC(SC,"ST",SD,1)'["X"
QUIT
+1 SET SDREST=DH
DO SEL
IF '$DATA(SDFR1)
QUIT
SET DH=HOLD
+2 QUIT
SEL KILL SDFR1
IF '$DATA(^SC(SC,"SL"))
QUIT
SET SL=^("SL")
SET %=$PIECE(SL,U,6)
SET SI=$SELECT(%="":4,%<3:4,%:%,1:4)
SET %=$PIECE(SL,U,3)
SET STARTDAY=$SELECT(%:%,1:8)
+1 WRITE !,"Clinic has been cancelled for the following periods:",!
+2 ;
+3 ;IHS/ANMC/LJF 11/30/2000 $N->$O
+4 ;K SDTEMP,SDZZ S SDZZ=0 F I=SD:0 S I=$N(^SC(SC,"SDCAN",I)) Q:I'>0!(I\1-SD) S SDZZ=SDZZ+1,X=I D TM S SDFR=X,SDFRX=X1,X="."_$P(^(I,0),"^",2) D TM S SDTO=X,SDTEMP(SDFRX_"-"_X1)=SDFR_"^"_SDTO,SDZZ(SDZZ)=SDFRX_"-"_X1
+5 KILL SDTEMP,SDZZ
SET SDZZ=0
FOR I=SD:0
SET I=$ORDER(^SC(SC,"SDCAN",I))
IF I'>0!(I\1-SD)
QUIT
SET SDZZ=SDZZ+1
SET X=I
DO TM
SET SDFR=X
SET SDFRX=X1
SET X="."_$PIECE(^(I,0),"^",2)
DO TM
SET SDTO=X
SET SDTEMP(SDFRX_"-"_X1)=SDFR_"^"_SDTO
SET SDZZ(SDZZ)=SDFRX_"-"_X1
+6 ;F I=SD:0 S I=$N(^SC(SC,"S",I)) Q:I'>0!(I\1-SD) I $D(^SC(SC,"S",I,"MES")),'$D(^SC(SC,"SDCAN",I)) S X=I D TM S SDFRX=X1,SDFR=X,X="."_$E(^SC(SC,"S",I,"MES"),17,20) D TM S SDZZ=SDZZ+1,SDTEMP(SDFRX_"-"_X1)=SDFR_"^"_X,SDZZ(SDZZ)=SDFRX_"-"_X1
+7 FOR I=SD:0
SET I=$ORDER(^SC(SC,"S",I))
IF I'>0!(I\1-SD)
QUIT
IF $DATA(^SC(SC,"S",I,"MES"))
IF '$DATA(^SC(SC,"SDCAN",I))
SET X=I
DO TM
SET SDFRX=X1
SET SDFR=X
SET X="."_$EXTRACT(^SC(SC,"S",I,"MES"),17,20)
DO TM
SET SDZZ=SDZZ+1
SET SDTEMP(SDFRX_"-"_X1)=SDFR_"^"_X
SET SDZZ(SDZZ)=SDFRX_"-"_X1
+8 ;F I1=0:0 S I1=$N(SDZZ(I1)) Q:I1'>0 S I=SDTEMP(SDZZ(I1)) W !,?9,"(",$J(I1,2),") ","From: ",$J($P(I,"^",1),8)," To: ",$J($P(I,"^",2),8)
+9 FOR I1=0:0
SET I1=$ORDER(SDZZ(I1))
IF I1'>0
QUIT
SET I=SDTEMP(SDZZ(I1))
WRITE !,?9,"(",$JUSTIFY(I1,2),") ","From: ",$JUSTIFY($PIECE(I,"^",1),8)," To: ",$JUSTIFY($PIECE(I,"^",2),8)
+10 ;
A KILL SDFRX,X1,SDFR,SDTO
READ !!,"RESTORE WHICH PERIOD?: ",X:DTIME
IF "^"[X
QUIT
+1 IF X?1"?".E
WRITE !,"Enter the # that precedes the time period you want to restore."
GOTO A
+2 SET SDR=X
IF $DATA(SDZZ(SDR))
IF $DATA(SDTEMP(SDZZ(SDR)))
WRITE " ",$PIECE(SDTEMP(SDZZ(SDR)),"^",1)," - ",$PIECE(SDTEMP(SDZZ(SDR)),"^",2)
GOTO ROK
+3 WRITE !,*7,"INVALID CHOICE, TRY AGAIN"
GOTO A
ROK SET X=$PIECE(SDZZ(SDR),"-",1)
DO TC
SET FR=X
SET SDBEG=%+SI+SI
SET X=$PIECE(SDZZ(SDR),"-",2)
DO TC
SET TO=X
SET SDEND=%+SI+SI
+1 SET SDFR1=CDATE+(FR/10000)
KILL SDTEMP,SDZZ,SDR
+2 ;S HOLD=^SC(SC,"ST",SD,1),HOLD=$E(HOLD,1,SDBEG-1)_$E(SDREST,SDBEG,SDEND)_$E(HOLD,SDEND+1,80) K ^SC(SC,"SDCAN",SDFR1) I $D(^SC(SC,"SDCAN",0)) S CNT=$P(^(0),U,4),CNT=$S(CNT>0:CNT-1,1:0),^(0)=$P(^(0),U,1,3)_U_CNT K CNT ;IHS/ANMC/LJF 12/13/2000
+3 ;IHS/ANMC/LJF 12/13/2000
SET HOLD=^SC(SC,"ST",SD,1)
SET HOLD=$EXTRACT(HOLD,1,SDBEG-1)_$EXTRACT(SDREST,SDBEG,SDEND)_$EXTRACT(HOLD,SDEND+1,132)
KILL ^SC(SC,"SDCAN",SDFR1)
IF $DATA(^SC(SC,"SDCAN",0))
SET CNT=$PIECE(^(0),U,4)
SET CNT=$SELECT(CNT>0:CNT-1,1:0)
SET ^(0)=$PIECE(^(0),U,1,3)_U_CNT
KILL CNT
+4 IF HOLD'["["
SET I5=$FIND(HOLD,"|")
SET HOLD=$EXTRACT(HOLD,1,(I5-2))_"["_$EXTRACT(HOLD,I5,999)
KILL I5
+5 KILL SDBEG,SDEND,SDANS,SI,STARTDAY,FR,TO
QUIT
KMES ;NAKED REFERENCE - ^SC(IFN,"S",DATE,"MES")
IF '$DATA(SDFR1)
KILL ^("MES")
QUIT
+1 ;NAKED REFERENCE - ^SC(IFN,"S",DATE,"MES")
IF $DATA(SDFR1)
IF N1=SDFR1
KILL ^("MES")
QUIT
+2 QUIT
TC SET %=$EXTRACT(X,3,4)
SET %=X\100-STARTDAY*SI+(%*SI\60)*2
+1 QUIT
TM SET X=$EXTRACT($PIECE(X,".",2)_"0000",1,4)
SET X1=X
SET %=X>1159
IF X>1259
SET X=X-1200
SET X=X\100_":"_$EXTRACT(X#100+100,2,3)_" "_$EXTRACT("AP",%+1)_"M"
QUIT
