ACGSUP ;IHS/OIRM/DSD/THL,AEF - UTILITY TO CHECK FOR ACTIVE STATUS; [ 03/27/2000 2:22 PM ]
;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
;;modified for y2k;mlp
;;UTILITY TO CHECK FOR ACTIVE STATUS
INACT ;EP;TO CHECK ACTIVE STATUS
D ^XBKVAR
D FY^ACGSEXP
W ! D WAIT^DICD W !
Q:$D(ACGQUIT)!'$D(ACGFY)
FY ;EP; TO CHECK FOR ACTIVE STATUS
W !,"All records will now be checked for active status.",!,"Please do not interrupt."
S (ACGI,ACGJ,ACGX)=0,U="^"
S ACGX=0
D CHANGES
Q
F S ACGX=$O(^ACGS("C",ACGX)) Q:'ACGX K ACG91 I $D(^ACGS(ACGX,"DT")) S ACGDT=+^("DT") D
.I ACGDT'=15,ACGDT'=17 S ACGT="T"
.E S ACGT="SPP"
.S ACGY=0
.F S ACGY=$O(^ACGS("C",ACGX,ACGY)) Q:'ACGY!$D(ACG91) I $D(^ACGS(ACGY,"DT")),$D(^("DT1")) S ACG2=$P(^("DT"),U,2),ACGDT1=^("DT1") F I=2,3,4 I $E($P(ACGDT1,U,I),1,3)>(ACGFY-1) S ACG91="" Q ;y2k;mlp
.S ACGY=0
.F S ACGY=$O(^ACGS("C",ACGX,ACGY)) Q:'ACGY D
..I $D(^ACGS(ACGY,"DT")),$D(^("DT1")) S ACG2=$P(^("DT"),U,2),ACGDT1=^("DT1")
..E Q
..I $E($P(ACGDT1,U,3),1,3)>$S($E($P(ACGDT1,U,3),4,5)<10:ACGFY,1:ACGFY-1) Q ;mlp;y2k
..I ACGT="T","^102^161^235^239^241^242^243^244^245^246^247^248^249^285^GS0^GS1^"'[(U_$E(ACG2,1,3)_U) K ACG2
..S $P(^ACGS(ACGY,"IHS"),U,23)=$S($D(ACG2)&$D(ACG91)&($E($P(^ACGS(ACGY,"DT"),U,2),4,5)'>ACGFY):1,1:"")
..I $P(^ACGS(ACGY,"IHS"),U,23)=1 S ACGI=ACGI+1,^ACGS(ACGT,1,ACGY)="" W "."
K ACGT
W !,"Number of Active Records: ",ACGI
Q
CHANGES ;
S ACGDAT=2_(ACGFY-1)_"0801"
S ACGDAT=(ACGFY-1)_"0801" ;y2k;mlp
F S ACGDAT=$O(^ACGS("Q",ACGDAT)) Q:'ACGDAT D
.S ACGX=0
.F S ACGX=$O(^ACGS("Q",ACGDAT,ACGX)) Q:'ACGX D
..S ACGDT=$G(^ACGS(ACGX,"DT"))
..Q:'+ACGDT
..I ACGDT'=15,ACGDT'=17 S ACGT="T"
..E S ACGT="SPP"
..S ^ACGS(ACGT,1,ACGX)=""
..W "."
Q
ACGSUP ;IHS/OIRM/DSD/THL,AEF - UTILITY TO CHECK FOR ACTIVE STATUS; [ 03/27/2000 2:22 PM ]
+1 ;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
+2 ;;modified for y2k;mlp
+3 ;;UTILITY TO CHECK FOR ACTIVE STATUS
INACT ;EP;TO CHECK ACTIVE STATUS
+1 DO ^XBKVAR
+2 DO FY^ACGSEXP
+3 WRITE !
DO WAIT^DICD
WRITE !
+4 IF $DATA(ACGQUIT)!'$DATA(ACGFY)
QUIT
FY ;EP; TO CHECK FOR ACTIVE STATUS
+1 WRITE !,"All records will now be checked for active status.",!,"Please do not interrupt."
+2 SET (ACGI,ACGJ,ACGX)=0
SET U="^"
+3 SET ACGX=0
+4 DO CHANGES
+5 QUIT
+6 FOR
SET ACGX=$ORDER(^ACGS("C",ACGX))
IF 'ACGX
QUIT
KILL ACG91
IF $DATA(^ACGS(ACGX,"DT"))
SET ACGDT=+^("DT")
Begin DoDot:1
+7 IF ACGDT'=15
IF ACGDT'=17
SET ACGT="T"
+8 IF '$TEST
SET ACGT="SPP"
+9 SET ACGY=0
+10 ;y2k;mlp
FOR
SET ACGY=$ORDER(^ACGS("C",ACGX,ACGY))
IF 'ACGY!$DATA(ACG91)
QUIT
IF $DATA(^ACGS(ACGY,"DT"))
IF $DATA(^("DT1"))
SET ACG2=$PIECE(^("DT"),U,2)
SET ACGDT1=^("DT1")
FOR I=2,3,4
IF $EXTRACT($PIECE(ACGDT1,U,I),1,3)>(ACGFY-1)
SET ACG91=""
QUIT
+11 SET ACGY=0
+12 FOR
SET ACGY=$ORDER(^ACGS("C",ACGX,ACGY))
IF 'ACGY
QUIT
Begin DoDot:2
+13 IF $DATA(^ACGS(ACGY,"DT"))
IF $DATA(^("DT1"))
SET ACG2=$PIECE(^("DT"),U,2)
SET ACGDT1=^("DT1")
+14 IF '$TEST
QUIT
+15 ;mlp;y2k
IF $EXTRACT($PIECE(ACGDT1,U,3),1,3)>$SELECT($EXTRACT($PIECE(ACGDT1,U,3),4,5)<10:ACGFY,1:ACGFY-1)
QUIT
+16 IF ACGT="T"
IF "^102^161^235^239^241^242^243^244^245^246^247^248^249^285^GS0^GS1^"'[(U_$EXTRACT(ACG2,1,3)_U)
KILL ACG2
+17 SET $PIECE(^ACGS(ACGY,"IHS"),U,23)=$SELECT($DATA(ACG2)&$DATA(ACG91)&($EXTRACT($PIECE(^ACGS(ACGY,"DT"),U,2),4,5)'>ACGFY):1,1:"")
+18 IF $PIECE(^ACGS(ACGY,"IHS"),U,23)=1
SET ACGI=ACGI+1
SET ^ACGS(ACGT,1,ACGY)=""
WRITE "."
End DoDot:2
End DoDot:1
+19 KILL ACGT
+20 WRITE !,"Number of Active Records: ",ACGI
+21 QUIT
CHANGES ;
+1 SET ACGDAT=2_(ACGFY-1)_"0801"
+2 ;y2k;mlp
SET ACGDAT=(ACGFY-1)_"0801"
+3 FOR
SET ACGDAT=$ORDER(^ACGS("Q",ACGDAT))
IF 'ACGDAT
QUIT
Begin DoDot:1
+4 SET ACGX=0
+5 FOR
SET ACGX=$ORDER(^ACGS("Q",ACGDAT,ACGX))
IF 'ACGX
QUIT
Begin DoDot:2
+6 SET ACGDT=$GET(^ACGS(ACGX,"DT"))
+7 IF '+ACGDT
QUIT
+8 IF ACGDT'=15
IF ACGDT'=17
SET ACGT="T"
+9 IF '$TEST
SET ACGT="SPP"
+10 SET ^ACGS(ACGT,1,ACGX)=""
+11 WRITE "."
End DoDot:2
End DoDot:1
+12 QUIT
