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
