- ACGSRQP ;IHS/OIRM/DSD/THL,AEF - PRINT DATA INTEGRITY REPORT; [ 03/27/2000 2:22 PM ]
- ;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
- ;;PRINT DATA INTEGRITY REPORT
- EN S ZTRTN="EN1^ACGSRQP",ZTDESC="CIS DATA INTEGRITY REPORT"
- D ^ACGSZIS
- D:'$D(ACGQUIT) EN1
- EXIT K ACGX,^TMP("ACG")
- Q
- EN1 ;EP;FOR QUEUED ROUTINE TO PRINT REPORT
- I '$D(ZTQUEUED) S (ACGIOP,IOP)=ACGION D ^%ZIS I POP S ACGQUIT="" Q
- U IO
- D ^XBKVAR,^ACGSRQ
- EN4 D DATE,PAGE,EN2
- W:$D(^TMP("ACG",$J,"T")) !!,^("T")," RECORDS FOUND WITH ERRORS."
- I $D(IOST),$E(IOST,1,2)="C-" D HOLD^ACGSMENU
- W @IOF
- D DONE^ACGSZIS
- Q
- EN2 ;EP;TO DISPLAY ERRORS IN CIS ACTION
- D DATE,PAGE
- Q:'$D(^TMP("ACG",$J))
- S ACGJ=$O(^TMP("ACG",$J,""))
- Q:ACGJ=""
- S ACGJ=""
- F S ACGJ=$O(^TMP("ACG",$J,ACGJ)) Q:ACGJ=""!$D(ACGQUIT) D EN21
- Q
- EN21 S ACG2=0
- F S ACG2=$O(^TMP("ACG",$J,ACGJ,ACG2)) Q:'ACG2!$D(ACGQUIT) D
- .I $D(^TMP("ACG",$J,ACGJ,ACG2))=1 S ACGX=^(ACG2) D P Q
- .S ACGA=0
- .F S ACGA=$O(^TMP("ACG",$J,ACGJ,ACG2,ACGA)) Q:'ACGA!$D(ACGQUIT) D
- ..I $D(^TMP("ACG",$J,ACGJ,ACG2,ACGA))=1 S ACGX=^(ACGA) D P Q
- ..I $D(^TMP("ACG",$J,ACGJ,ACG2,ACGA))=10 S ACGB=0 F S ACGB=$O(^TMP("ACG",$J,ACGJ,ACG2,ACGA,ACGB)) Q:'ACGB D
- ...I $D(^TMP("ACG",$J,ACGJ,ACG2,ACGA,ACGB))=1 S ACGX=^(ACGB) D P
- ...I $D(^TMP("ACG",$J,ACGJ,ACG2,ACGA,ACGB))=10 S ACGC=0 F S ACGC=$O(^TMP("ACG",$J,ACGJ,ACG2,ACGA,ACGB,ACGC)) Q:'ACGC S ACGX=^(ACGC) D P
- Q
- PAGE I $D(ACGQUIT) W @IOF Q
- S ACGPAGE=ACGPAGE+1
- W @IOF,!,"CIS ERROR REPORT, PRINTED ON: ",ACGDT,?60,"PAGE: ",ACGPAGE,!,"--------------------------------------------------------------------------------",!
- Q
- DATE D NOW^%DTC S Y=%,ACGPAGE=0 X ^DD("DD") S ACGDT=Y
- Q
- P W !,"CONTRACT NUMBER: ",ACGJ
- W !,"Item ",ACG2," errors: "
- S ACGI=$P(ACGX,U),ACGX=$P(ACGX,U,2,999)
- F Y=1:1:3 S ACG(Y)=$P(ACGI,";",Y)
- W ?15,"Item ",+ACG(1)," = ",$S($P(ACG(1),"++",2)'="":$P(ACG(1),"++",2),1:"Null")
- W:ACG(2)'="" " and Item ",+ACG(2)," = ",$S($P(ACG(2),"++",2)'="":$P(ACG(2),"++",2),1:"Null")
- W:ACG(3)'="" " and Item ",+ACG(3)," = ",$S($P(ACG(3),"++",2)'="":$P(ACG(3),"++",2),1:"Null")
- X ACGX W ! I $Y>(IOSL-5) D:$E(IOST,1,2)="C-" HOLD^ACGSMENU D PAGE
- F X=1:1:3 S:ACG(X)'="" ACGXX(+ACG(X))=""
- Q
- ACGSRQP ;IHS/OIRM/DSD/THL,AEF - PRINT DATA INTEGRITY REPORT; [ 03/27/2000 2:22 PM ]
- +1 ;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
- +2 ;;PRINT DATA INTEGRITY REPORT
- EN SET ZTRTN="EN1^ACGSRQP"
- SET ZTDESC="CIS DATA INTEGRITY REPORT"
- +1 DO ^ACGSZIS
- +2 IF '$DATA(ACGQUIT)
- DO EN1
- EXIT KILL ACGX,^TMP("ACG")
- +1 QUIT
- EN1 ;EP;FOR QUEUED ROUTINE TO PRINT REPORT
- +1 IF '$DATA(ZTQUEUED)
- SET (ACGIOP,IOP)=ACGION
- DO ^%ZIS
- IF POP
- SET ACGQUIT=""
- QUIT
- +2 USE IO
- +3 DO ^XBKVAR
- DO ^ACGSRQ
- EN4 DO DATE
- DO PAGE
- DO EN2
- +1 IF $DATA(^TMP("ACG",$JOB,"T"))
- WRITE !!,^("T")," RECORDS FOUND WITH ERRORS."
- +2 IF $DATA(IOST)
- IF $EXTRACT(IOST,1,2)="C-"
- DO HOLD^ACGSMENU
- +3 WRITE @IOF
- +4 DO DONE^ACGSZIS
- +5 QUIT
- EN2 ;EP;TO DISPLAY ERRORS IN CIS ACTION
- +1 DO DATE
- DO PAGE
- +2 IF '$DATA(^TMP("ACG",$JOB))
- QUIT
- +3 SET ACGJ=$ORDER(^TMP("ACG",$JOB,""))
- +4 IF ACGJ=""
- QUIT
- +5 SET ACGJ=""
- +6 FOR
- SET ACGJ=$ORDER(^TMP("ACG",$JOB,ACGJ))
- IF ACGJ=""!$DATA(ACGQUIT)
- QUIT
- DO EN21
- +7 QUIT
- EN21 SET ACG2=0
- +1 FOR
- SET ACG2=$ORDER(^TMP("ACG",$JOB,ACGJ,ACG2))
- IF 'ACG2!$DATA(ACGQUIT)
- QUIT
- Begin DoDot:1
- +2 IF $DATA(^TMP("ACG",$JOB,ACGJ,ACG2))=1
- SET ACGX=^(ACG2)
- DO P
- QUIT
- +3 SET ACGA=0
- +4 FOR
- SET ACGA=$ORDER(^TMP("ACG",$JOB,ACGJ,ACG2,ACGA))
- IF 'ACGA!$DATA(ACGQUIT)
- QUIT
- Begin DoDot:2
- +5 IF $DATA(^TMP("ACG",$JOB,ACGJ,ACG2,ACGA))=1
- SET ACGX=^(ACGA)
- DO P
- QUIT
- +6 IF $DATA(^TMP("ACG",$JOB,ACGJ,ACG2,ACGA))=10
- SET ACGB=0
- FOR
- SET ACGB=$ORDER(^TMP("ACG",$JOB,ACGJ,ACG2,ACGA,ACGB))
- IF 'ACGB
- QUIT
- Begin DoDot:3
- +7 IF $DATA(^TMP("ACG",$JOB,ACGJ,ACG2,ACGA,ACGB))=1
- SET ACGX=^(ACGB)
- DO P
- +8 IF $DATA(^TMP("ACG",$JOB,ACGJ,ACG2,ACGA,ACGB))=10
- SET ACGC=0
- FOR
- SET ACGC=$ORDER(^TMP("ACG",$JOB,ACGJ,ACG2,ACGA,ACGB,ACGC))
- IF 'ACGC
- QUIT
- SET ACGX=^(ACGC)
- DO P
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +9 QUIT
- PAGE IF $DATA(ACGQUIT)
- WRITE @IOF
- QUIT
- +1 SET ACGPAGE=ACGPAGE+1
- +2 WRITE @IOF,!,"CIS ERROR REPORT, PRINTED ON: ",ACGDT,?60,"PAGE: ",ACGPAGE,!,"--------------------------------------------------------------------------------",!
- +3 QUIT
- DATE DO NOW^%DTC
- SET Y=%
- SET ACGPAGE=0
- XECUTE ^DD("DD")
- SET ACGDT=Y
- +1 QUIT
- P WRITE !,"CONTRACT NUMBER: ",ACGJ
- +1 WRITE !,"Item ",ACG2," errors: "
- +2 SET ACGI=$PIECE(ACGX,U)
- SET ACGX=$PIECE(ACGX,U,2,999)
- +3 FOR Y=1:1:3
- SET ACG(Y)=$PIECE(ACGI,";",Y)
- +4 WRITE ?15,"Item ",+ACG(1)," = ",$SELECT($PIECE(ACG(1),"++",2)'="":$PIECE(ACG(1),"++",2),1:"Null")
- +5 IF ACG(2)'=""
- WRITE " and Item ",+ACG(2)," = ",$SELECT($PIECE(ACG(2),"++",2)'="":$PIECE(ACG(2),"++",2),1:"Null")
- +6 IF ACG(3)'=""
- WRITE " and Item ",+ACG(3)," = ",$SELECT($PIECE(ACG(3),"++",2)'="":$PIECE(ACG(3),"++",2),1:"Null")
- +7 XECUTE ACGX
- WRITE !
- IF $Y>(IOSL-5)
- IF $EXTRACT(IOST,1,2)="C-"
- DO HOLD^ACGSMENU
- DO PAGE
- +8 FOR X=1:1:3
- IF ACG(X)'=""
- SET ACGXX(+ACG(X))=""
- +9 QUIT
