- ACGSRQDC ;IHS/OIRM/DSD/THL,AEF - CHECK REQUIRED FIELDS FOR DATA; [ 03/27/2000 2:22 PM ]
- ;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
- ;;CHECK TO ENSURE THAT ALL REQUIRED FIELDS OF DATA ARE ENTERED
- EN D EN1
- EXIT K ACG,ACGC,ACGCNT,ACGX,ACGRDA,ACGO,ACG1,^TMP("ACGC",$J),ACGQUIT,ACG2,ACG5,ACGF,ACGCNTX
- Q
- EN1 K ACGQUIT,^TMP("ACGC")
- W !!,"The following procedure will check all contract actions for missing data.",!,"This could take several minutes."
- S DIR(0)="YO",DIR("A")="Sure you want to continue",DIR("B")="NO"
- D DIR^ACGSDIC
- Q:Y'=1
- D CHK^ACGSRQD1
- Q
- CHK ;EP
- I '$D(ZTQUEUED) W !,"DATA INTEGRITY CHECK IN PROGRESS. DO NOT INTERRUPT."
- S (ACGO,ACGCNT)=0
- F S ACGO=$O(^ACGS("C",ACGO)) Q:'ACGO D:$P(^ACGS(ACGO,"IHS"),U,22)=1
- .S ACGRDA=0
- .F S ACGRDA=$O(^ACGS("C",ACGO,ACGRDA)) Q:'ACGRDA I $D(^ACGS(ACGRDA,0)),$D(^("DT")),$D(^("DT1")),$D(^("DT2")) D
- ..I '$D(^ACGS(ACGRDA,0)) K ^ACGS("C",ACGO,ACGRDA) Q
- ..S ACG1=$S($P(^ACGS(ACGRDA,"DT"),U):$P(^ACGTPA($P(^ACGS(ACGRDA,"DT"),U),0),U),1:"D"),ACG5=$P(^ACGS(ACGRDA,"DT"),U,5),ACG2=$P(^("DT"),U,2)
- ..I ACG5'="",ACG2 D @ACG1
- I '$D(^TMP("ACGC",$J)) W !!,"DATA INTEGRITY CHECK PASSED WITHOUT ERRORS"
- Q
- A ;EP
- D ;EP
- I ;EP
- F ACG=1,2,4,5,12,16,17,19,20,21 I $P(^ACGS(ACGRDA,"DT"),U,ACG)="" S ACGCNTX="",^TMP("ACGC",$J,ACG2,ACG5,ACG)=ACGRDA
- F ACG=22,23,25,27,28,29,32 S ACGX=ACG-21 I $P(^ACGS(ACGRDA,"DT1"),U,ACGX)="" S ACGCNTX="",^TMP("ACGC",$J,ACG2,ACG5,ACG)=ACGRDA
- F ACG=37,45,51,53 S ACGX=ACG-35 I $P(^ACGS(ACGRDA,"DT2"),U,ACGX)="" S:ACG'=37 ^TMP("ACGC",$J,ACG2,ACG5,ACG)=ACGRDA I ACG=37,$P(^ACGS(ACGRDA,"DT1"),U,5)'="",$P(^("DT1"),U,5)'=0 S ^TMP("ACGC",$J,ACG2,ACG5,ACG)=ACGRDA
- I $D(ACGCNTX) S ACGCNT=ACGCNT+1 K ACGCNTX
- Q
- C ;EP
- M ;EP
- R ;EP
- F ACG=1,2,4,5,12,17,19,20 I $P(^ACGS(ACGRDA,"DT"),U,ACG)="" S ACGCNTX="",^TMP("ACGC",$J,ACG2,ACG5,ACG)=ACGRDA
- F ACG=22,27,28 S ACGX=ACG-21 I $P(^ACGS(ACGRDA,"DT1"),U,ACGX)="" S ACGCNTX="",^TMP("ACGC",$J,ACG2,ACG5,ACG)=ACGRDA
- F ACG=37,45,51,53 S ACGX=ACG-35 I $P(^ACGS(ACGRDA,"DT2"),U,ACGX)="" S:ACG'=37 ^TMP("ACGC",$J,ACG2,ACG5,ACG)=ACGRDA I ACG=37,$P(^ACGS(ACGRDA,"DT1"),U,5)'="",$P(^("DT1"),U,5)'=0 S ^TMP("ACGC",$J,ACG2,ACG5,ACG)=ACGRDA
- I $D(ACGCNTX) S ACGCNT=ACGCNT+1 K ACGCNTX
- Q
- Q ;EP
- F ACG=1,2,4,5,12,17:1:19,20 I $P(^ACGS(ACGRDA,"DT"),U,ACG)="" S ACGCNTX="",^TMP("ACGC",$J,ACG2,ACG5,ACG)=ACGRDA
- F ACG=22,27,28 S ACGX=ACG-21 I $P(^ACGS(ACGRDA,"DT1"),U,ACGX)="" S ACGCNTX="",^TMP("ACGC",$J,ACG2,ACG5,ACG)=ACGRDA
- F ACG=45,51,53 S ACGX=ACG-35 S:$P(^ACGS(ACGRDA,"DT2"),U,ACGX)="" ^TMP("ACGC",$J,ACG2,ACG5,ACG)=ACGRDA
- I $D(ACGCNTX) S ACGCNT=ACGCNT+1 K ACGCNTX
- Q
- G ;EP
- N ;EP
- F ACG=1,2,4,5,12,17,19,20 I $P(^ACGS(ACGRDA,"DT"),U,ACG)="" S ACGCNTX="",^TMP("ACGC",$J,ACG2,ACG5,ACG)=ACGRDA
- F ACG=22,27,28 S ACGX=ACG-21 I $P(^ACGS(ACGRDA,"DT1"),U,ACGX)="" S ACGCNTX="",^TMP("ACGC",$J,ACG2,ACG5,ACG)=ACGRDA
- F ACG=45,51,53 S ACGX=ACG-35 S:$P(^ACGS(ACGRDA,"DT2"),U,ACGX)="" ^TMP("ACGC",$J,ACG2,ACG5,ACG)=ACGRDA
- I $D(ACGCNTX) S ACGCNT=ACGCNT+1 K ACGCNTX
- Q
- B ;EP
- F ACG=1,2,4,5,12,13,17:1:20 I $P(^ACGS(ACGRDA,"DT"),U,ACG)="" S ACGCNTX="",^TMP("ACGC",$J,ACG2,ACG5,ACG)=ACGRDA
- F ACG=30 S ACGX=ACG-21 S:$P(^ACGS(ACGRDA,"DT1"),U,ACGX)="" ^TMP("ACGC",$J,ACG2,ACG5,ACG)=ACGRDA
- I $D(ACGCNTX) S ACGCNT=ACGCNT+1 K ACGCNTX
- Q
- O ;EP
- F ACG=1,2,4,5,12,17,19,20 I P(^ACGS(ACGRDA,"DT"),U,ACG)="" S ACGCNTX="",^TMP("ACGC",$J,ACG2,ACG5,ACG)=ACGRDA
- F ACG=22,27,28 S ACGX=ACG-21 I $P(^ACGS(ACGRDA,"DT1"),U,ACGX)="" S ACGCNTX="",^TMP("ACGC",$J,ACG2,ACG5,ACG)=ACGRDA
- I $D(ACGCNTX) S ACGCNT=ACGCNT+1 K ACGCNTX
- Q
- P ;EP
- F ACG=1,2,4,5,12,13,15:1:19 I $P(^ACGS(ACGRDA,"DT"),U,ACG)="" S ACGCNTX="",^TMP("ACGC",$J,ACG2,ACG5,ACG)=ACGRDA
- F ACG=22,27:1:31 S ACGX=ACG-21 I $P(^ACGS(ACGRDA,"DT1"),U,ACGX)="" S ACGCNTX="",^TMP("ACGC",$J,ACG2,ACG5,ACG)=ACGRDA
- F ACG=45,51,53 S ACGX=ACG-35 S:$P(^ACGS(ACGRDA,"DT2"),U,ACGX)="" ^TMP("ACGC",$J,ACG2,ACG5,ACG)=ACGRDA
- I $D(ACGCNTX) S ACGCNT=ACGCNT+1 K ACGCNTX
- Q
- T ;EP
- U ;EP
- F ACG=1,2,4,5,12,13,17,19,20 I $P(^ACGS(ACGRDA,"DT"),U,ACG)="" S ACGCNTX="",^TMP("ACGC",$J,ACG2,ACG5,ACG)=ACGRDA
- F ACG=45,51,53 S ACGX=ACG-35 S:$P(^ACGS(ACGRDA,"DT2"),U,ACGX)="" ^TMP("ACGC",$J,ACG2,ACG5,ACG)=ACGRDA
- I $D(ACGCNTX) S ACGCNT=ACGCNT+1 K ACGCNTX
- Q
- DIR D ^DIR S:$D(DIRUT) ACGQUIT="" K DIR,DIRUT,DUOUT,DTOUT Q
- ;
- ACGSRQDC ;IHS/OIRM/DSD/THL,AEF - CHECK REQUIRED FIELDS FOR DATA; [ 03/27/2000 2:22 PM ]
- +1 ;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
- +2 ;;CHECK TO ENSURE THAT ALL REQUIRED FIELDS OF DATA ARE ENTERED
- EN DO EN1
- EXIT KILL ACG,ACGC,ACGCNT,ACGX,ACGRDA,ACGO,ACG1,^TMP("ACGC",$JOB),ACGQUIT,ACG2,ACG5,ACGF,ACGCNTX
- +1 QUIT
- EN1 KILL ACGQUIT,^TMP("ACGC")
- +1 WRITE !!,"The following procedure will check all contract actions for missing data.",!,"This could take several minutes."
- +2 SET DIR(0)="YO"
- SET DIR("A")="Sure you want to continue"
- SET DIR("B")="NO"
- +3 DO DIR^ACGSDIC
- +4 IF Y'=1
- QUIT
- +5 DO CHK^ACGSRQD1
- +6 QUIT
- CHK ;EP
- +1 IF '$DATA(ZTQUEUED)
- WRITE !,"DATA INTEGRITY CHECK IN PROGRESS. DO NOT INTERRUPT."
- +2 SET (ACGO,ACGCNT)=0
- +3 FOR
- SET ACGO=$ORDER(^ACGS("C",ACGO))
- IF 'ACGO
- QUIT
- IF $PIECE(^ACGS(ACGO,"IHS"),U,22)=1
- Begin DoDot:1
- +4 SET ACGRDA=0
- +5 FOR
- SET ACGRDA=$ORDER(^ACGS("C",ACGO,ACGRDA))
- IF 'ACGRDA
- QUIT
- IF $DATA(^ACGS(ACGRDA,0))
- IF $DATA(^("DT"))
- IF $DATA(^("DT1"))
- IF $DATA(^("DT2"))
- Begin DoDot:2
- +6 IF '$DATA(^ACGS(ACGRDA,0))
- KILL ^ACGS("C",ACGO,ACGRDA)
- QUIT
- +7 SET ACG1=$SELECT($PIECE(^ACGS(ACGRDA,"DT"),U):$PIECE(^ACGTPA($PIECE(^ACGS(ACGRDA,"DT"),U),0),U),1:"D")
- SET ACG5=$PIECE(^ACGS(ACGRDA,"DT"),U,5)
- SET ACG2=$PIECE(^("DT"),U,2)
- +8 IF ACG5'=""
- IF ACG2
- DO @ACG1
- End DoDot:2
- End DoDot:1
- +9 IF '$DATA(^TMP("ACGC",$JOB))
- WRITE !!,"DATA INTEGRITY CHECK PASSED WITHOUT ERRORS"
- +10 QUIT
- A ;EP
- D ;EP
- I ;EP
- +1 FOR ACG=1,2,4,5,12,16,17,19,20,21
- IF $PIECE(^ACGS(ACGRDA,"DT"),U,ACG)=""
- SET ACGCNTX=""
- SET ^TMP("ACGC",$JOB,ACG2,ACG5,ACG)=ACGRDA
- +2 FOR ACG=22,23,25,27,28,29,32
- SET ACGX=ACG-21
- IF $PIECE(^ACGS(ACGRDA,"DT1"),U,ACGX)=""
- SET ACGCNTX=""
- SET ^TMP("ACGC",$JOB,ACG2,ACG5,ACG)=ACGRDA
- +3 FOR ACG=37,45,51,53
- SET ACGX=ACG-35
- IF $PIECE(^ACGS(ACGRDA,"DT2"),U,ACGX)=""
- IF ACG'=37
- SET ^TMP("ACGC",$JOB,ACG2,ACG5,ACG)=ACGRDA
- IF ACG=37
- IF $PIECE(^ACGS(ACGRDA,"DT1"),U,5)'=""
- IF $PIECE(^("DT1"),U,5)'=0
- SET ^TMP("ACGC",$JOB,ACG2,ACG5,ACG)=ACGRDA
- +4 IF $DATA(ACGCNTX)
- SET ACGCNT=ACGCNT+1
- KILL ACGCNTX
- +5 QUIT
- C ;EP
- M ;EP
- R ;EP
- +1 FOR ACG=1,2,4,5,12,17,19,20
- IF $PIECE(^ACGS(ACGRDA,"DT"),U,ACG)=""
- SET ACGCNTX=""
- SET ^TMP("ACGC",$JOB,ACG2,ACG5,ACG)=ACGRDA
- +2 FOR ACG=22,27,28
- SET ACGX=ACG-21
- IF $PIECE(^ACGS(ACGRDA,"DT1"),U,ACGX)=""
- SET ACGCNTX=""
- SET ^TMP("ACGC",$JOB,ACG2,ACG5,ACG)=ACGRDA
- +3 FOR ACG=37,45,51,53
- SET ACGX=ACG-35
- IF $PIECE(^ACGS(ACGRDA,"DT2"),U,ACGX)=""
- IF ACG'=37
- SET ^TMP("ACGC",$JOB,ACG2,ACG5,ACG)=ACGRDA
- IF ACG=37
- IF $PIECE(^ACGS(ACGRDA,"DT1"),U,5)'=""
- IF $PIECE(^("DT1"),U,5)'=0
- SET ^TMP("ACGC",$JOB,ACG2,ACG5,ACG)=ACGRDA
- +4 IF $DATA(ACGCNTX)
- SET ACGCNT=ACGCNT+1
- KILL ACGCNTX
- +5 QUIT
- Q ;EP
- +1 FOR ACG=1,2,4,5,12,17:1:19,20
- IF $PIECE(^ACGS(ACGRDA,"DT"),U,ACG)=""
- SET ACGCNTX=""
- SET ^TMP("ACGC",$JOB,ACG2,ACG5,ACG)=ACGRDA
- +2 FOR ACG=22,27,28
- SET ACGX=ACG-21
- IF $PIECE(^ACGS(ACGRDA,"DT1"),U,ACGX)=""
- SET ACGCNTX=""
- SET ^TMP("ACGC",$JOB,ACG2,ACG5,ACG)=ACGRDA
- +3 FOR ACG=45,51,53
- SET ACGX=ACG-35
- IF $PIECE(^ACGS(ACGRDA,"DT2"),U,ACGX)=""
- SET ^TMP("ACGC",$JOB,ACG2,ACG5,ACG)=ACGRDA
- +4 IF $DATA(ACGCNTX)
- SET ACGCNT=ACGCNT+1
- KILL ACGCNTX
- +5 QUIT
- G ;EP
- N ;EP
- +1 FOR ACG=1,2,4,5,12,17,19,20
- IF $PIECE(^ACGS(ACGRDA,"DT"),U,ACG)=""
- SET ACGCNTX=""
- SET ^TMP("ACGC",$JOB,ACG2,ACG5,ACG)=ACGRDA
- +2 FOR ACG=22,27,28
- SET ACGX=ACG-21
- IF $PIECE(^ACGS(ACGRDA,"DT1"),U,ACGX)=""
- SET ACGCNTX=""
- SET ^TMP("ACGC",$JOB,ACG2,ACG5,ACG)=ACGRDA
- +3 FOR ACG=45,51,53
- SET ACGX=ACG-35
- IF $PIECE(^ACGS(ACGRDA,"DT2"),U,ACGX)=""
- SET ^TMP("ACGC",$JOB,ACG2,ACG5,ACG)=ACGRDA
- +4 IF $DATA(ACGCNTX)
- SET ACGCNT=ACGCNT+1
- KILL ACGCNTX
- +5 QUIT
- B ;EP
- +1 FOR ACG=1,2,4,5,12,13,17:1:20
- IF $PIECE(^ACGS(ACGRDA,"DT"),U,ACG)=""
- SET ACGCNTX=""
- SET ^TMP("ACGC",$JOB,ACG2,ACG5,ACG)=ACGRDA
- +2 FOR ACG=30
- SET ACGX=ACG-21
- IF $PIECE(^ACGS(ACGRDA,"DT1"),U,ACGX)=""
- SET ^TMP("ACGC",$JOB,ACG2,ACG5,ACG)=ACGRDA
- +3 IF $DATA(ACGCNTX)
- SET ACGCNT=ACGCNT+1
- KILL ACGCNTX
- +4 QUIT
- O ;EP
- +1 FOR ACG=1,2,4,5,12,17,19,20
- IF P(^ACGS(ACGRDA,"DT"),U,ACG)=""
- SET ACGCNTX=""
- SET ^TMP("ACGC",$JOB,ACG2,ACG5,ACG)=ACGRDA
- +2 FOR ACG=22,27,28
- SET ACGX=ACG-21
- IF $PIECE(^ACGS(ACGRDA,"DT1"),U,ACGX)=""
- SET ACGCNTX=""
- SET ^TMP("ACGC",$JOB,ACG2,ACG5,ACG)=ACGRDA
- +3 IF $DATA(ACGCNTX)
- SET ACGCNT=ACGCNT+1
- KILL ACGCNTX
- +4 QUIT
- P ;EP
- +1 FOR ACG=1,2,4,5,12,13,15:1:19
- IF $PIECE(^ACGS(ACGRDA,"DT"),U,ACG)=""
- SET ACGCNTX=""
- SET ^TMP("ACGC",$JOB,ACG2,ACG5,ACG)=ACGRDA
- +2 FOR ACG=22,27:1:31
- SET ACGX=ACG-21
- IF $PIECE(^ACGS(ACGRDA,"DT1"),U,ACGX)=""
- SET ACGCNTX=""
- SET ^TMP("ACGC",$JOB,ACG2,ACG5,ACG)=ACGRDA
- +3 FOR ACG=45,51,53
- SET ACGX=ACG-35
- IF $PIECE(^ACGS(ACGRDA,"DT2"),U,ACGX)=""
- SET ^TMP("ACGC",$JOB,ACG2,ACG5,ACG)=ACGRDA
- +4 IF $DATA(ACGCNTX)
- SET ACGCNT=ACGCNT+1
- KILL ACGCNTX
- +5 QUIT
- T ;EP
- U ;EP
- +1 FOR ACG=1,2,4,5,12,13,17,19,20
- IF $PIECE(^ACGS(ACGRDA,"DT"),U,ACG)=""
- SET ACGCNTX=""
- SET ^TMP("ACGC",$JOB,ACG2,ACG5,ACG)=ACGRDA
- +2 FOR ACG=45,51,53
- SET ACGX=ACG-35
- IF $PIECE(^ACGS(ACGRDA,"DT2"),U,ACGX)=""
- SET ^TMP("ACGC",$JOB,ACG2,ACG5,ACG)=ACGRDA
- +3 IF $DATA(ACGCNTX)
- SET ACGCNT=ACGCNT+1
- KILL ACGCNTX
- +4 QUIT
- DIR DO ^DIR
- IF $DATA(DIRUT)
- SET ACGQUIT=""
- KILL DIR,DIRUT,DUOUT,DTOUT
- QUIT
- +1 ;
