- 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
