ECUNTRPT ;ALB/DHE DSS Units Errors Report ;3/7/18 15:25
;;2.0;EVENT CAPTURE;**107,119,139**;8 May 96;Build 7
;
;This report displays DSS Units with any Associated Stop Codes
;with any errors or warnings.
;
;Routine entry point, START if from roll and scroll, EN if
;from GUI
;
;need to set up output device and taskman
START ;
W @IOF,!!,"This option displays DSS Units with Associated Stop Code Errors.",!!
S %ZIS="QM" D ^%ZIS G EXIT:POP
I $D(IO("Q")) D Q
. N ZTRTN,ZTDESC
. S ZTRTN="EN^ECUNTRPT",ZTDESC="DSS Units with Assoc Stop Codes"
. D ^%ZTLOAD D HOME^%ZIS K IO("Q") Q
U IO
EN ;
N I,CNTR,DATE,ECERR,ECNAME,ECOUT,ECRDT,ECSTOP,ECSTOP1,ERR,INACT,LN
N PG,RTYPE,STR,UNITNM,UNT,CNT ;119
;
S %H=$H,ECRDT=$$HTE^XLFDT(%H,"5M"),ECOUT=0
S CNTR=0,PG=1,UNT=0,$P(LN,"-",80)=""
I $G(ECPTYP)'="E" D HEAD ;119
I $G(ECPTYP)="E" S CNT=1,^TMP($J,"ECRPT",CNT)="DSS UNIT #^DSS UNIT NAME^STOP CODE^STOP CODE NAME^ERROR #1^ERROR #2^ERROR #3" ;119
F S UNT=$O(^ECD(UNT)) Q:'UNT D I ECOUT Q
.Q:'$D(^ECD(UNT,0))
.;check to see if unit is inactive
.I $P(^ECD(UNT,0),"^",6)=1 Q
.;get associated stop code
.S ECSTOP=$P(^ECD(UNT,0),"^",10) Q:$G(ECSTOP)=0!(ECSTOP="")
.;
.S UNITNM=$P($G(^ECD(UNT,0)),U),ERR=0
.S STR=$G(^DIC(40.7,ECSTOP,0))
.I $G(STR)="" S ERR=ERR+1,ECERR(ERR)="CODE DOES NOT EXIST IN FILE 40.7",ECNAME="" Q
.S ECNAME=$P(STR,U),ECSTOP1=$P(STR,U,2),INACT=$P(STR,U,3),RTYPE=$P(STR,U,6)
.I $L(ECSTOP1)'=3 S ERR=ERR+1,ECERR(ERR)="CODE MUST BE 3 DIGITS"
.I $G(INACT),((DT>INACT)!(DT=INACT)) S ERR=ERR+1,ECERR(ERR)="INACTIVE CODE"
.I (RTYPE'=("P"))&(RTYPE'=("E")) S ERR=ERR+1,ECERR(ERR)="SECONDARY CODE"
.I $P(^ECD(UNT,0),U,14)="OOS" D ;139
..I '$$EX^SDCOU2(ECSTOP,DT) S ERR=ERR+1,ECERR(ERR)="INVALID OR INACTIVE STOP CODE ASSOCIATED WITH AN OOS DSS UNIT" ;139
.I $G(ECPTYP)'="E" I ($Y+4)>IOSL D PAGE Q:ECOUT D HEAD ;119
.;if errors, loop through array, write, then kill
.I ERR D S ERR=0 K ECERR
..I $G(ECPTYP)="E" D EXPORT Q ;119
..W !!,"DSS Unit: ",?12,UNT,?19,UNITNM
..W !,"Stop Code: ",?12,ECSTOP1,?19,ECNAME
..F I=1:1:ERR W !,"Reason: ",ECERR(I) ;119
Q
EXIT ;
K POP,QUIT,ZTQUEUED
Q
;
HEAD ;header
W:$E(IOST,1,2)="C-"!(PG>1) @IOF
W !!,"DSS UNITS WITH ANY ASSOCIATED STOP CODE ERRORS"
W !,"Page: ",PG,?53,"Run Date: ",ECRDT,!,LN
S PG=PG+1
Q
PAGE ;
N SS,JJ
I $D(PG),$E(IOST,1,2)="C-" D
.S SS=22-$Y F JJ=1:1:22 W !
.S DIR(0)="E" W ! D ^DIR K DIR I 'Y S ECOUT=1
Q
;
STRTGUI ; if called from GUI, enter routine here
D EN
Q
;
EXPORT ;Section added in 119, puts data in exportable format
N I
S CNT=CNT+1,^TMP($J,"ECRPT",CNT)=UNT_U_UNITNM_U_ECSTOP1_U_ECNAME
F I=1:1:ERR S ^TMP($J,"ECRPT",CNT)=^TMP($J,"ECRPT",CNT)_U_ECERR(I)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECUNTRPT 2759 printed Dec 13, 2024@01:59:10 Page 2
ECUNTRPT ;ALB/DHE DSS Units Errors Report ;3/7/18 15:25
+1 ;;2.0;EVENT CAPTURE;**107,119,139**;8 May 96;Build 7
+2 ;
+3 ;This report displays DSS Units with any Associated Stop Codes
+4 ;with any errors or warnings.
+5 ;
+6 ;Routine entry point, START if from roll and scroll, EN if
+7 ;from GUI
+8 ;
+9 ;need to set up output device and taskman
START ;
+1 WRITE @IOF,!!,"This option displays DSS Units with Associated Stop Code Errors.",!!
+2 SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO EXIT
+3 IF $DATA(IO("Q"))
Begin DoDot:1
+4 NEW ZTRTN,ZTDESC
+5 SET ZTRTN="EN^ECUNTRPT"
SET ZTDESC="DSS Units with Assoc Stop Codes"
+6 DO ^%ZTLOAD
DO HOME^%ZIS
KILL IO("Q")
QUIT
End DoDot:1
QUIT
+7 USE IO
EN ;
+1 NEW I,CNTR,DATE,ECERR,ECNAME,ECOUT,ECRDT,ECSTOP,ECSTOP1,ERR,INACT,LN
+2 ;119
NEW PG,RTYPE,STR,UNITNM,UNT,CNT
+3 ;
+4 SET %H=$HOROLOG
SET ECRDT=$$HTE^XLFDT(%H,"5M")
SET ECOUT=0
+5 SET CNTR=0
SET PG=1
SET UNT=0
SET $PIECE(LN,"-",80)=""
+6 ;119
IF $GET(ECPTYP)'="E"
DO HEAD
+7 ;119
IF $GET(ECPTYP)="E"
SET CNT=1
SET ^TMP($JOB,"ECRPT",CNT)="DSS UNIT #^DSS UNIT NAME^STOP CODE^STOP CODE NAME^ERROR #1^ERROR #2^ERROR #3"
+8 FOR
SET UNT=$ORDER(^ECD(UNT))
if 'UNT
QUIT
Begin DoDot:1
+9 if '$DATA(^ECD(UNT,0))
QUIT
+10 ;check to see if unit is inactive
+11 IF $PIECE(^ECD(UNT,0),"^",6)=1
QUIT
+12 ;get associated stop code
+13 SET ECSTOP=$PIECE(^ECD(UNT,0),"^",10)
if $GET(ECSTOP)=0!(ECSTOP="")
QUIT
+14 ;
+15 SET UNITNM=$PIECE($GET(^ECD(UNT,0)),U)
SET ERR=0
+16 SET STR=$GET(^DIC(40.7,ECSTOP,0))
+17 IF $GET(STR)=""
SET ERR=ERR+1
SET ECERR(ERR)="CODE DOES NOT EXIST IN FILE 40.7"
SET ECNAME=""
QUIT
+18 SET ECNAME=$PIECE(STR,U)
SET ECSTOP1=$PIECE(STR,U,2)
SET INACT=$PIECE(STR,U,3)
SET RTYPE=$PIECE(STR,U,6)
+19 IF $LENGTH(ECSTOP1)'=3
SET ERR=ERR+1
SET ECERR(ERR)="CODE MUST BE 3 DIGITS"
+20 IF $GET(INACT)
IF ((DT>INACT)!(DT=INACT))
SET ERR=ERR+1
SET ECERR(ERR)="INACTIVE CODE"
+21 IF (RTYPE'=("P"))&(RTYPE'=("E"))
SET ERR=ERR+1
SET ECERR(ERR)="SECONDARY CODE"
+22 ;139
IF $PIECE(^ECD(UNT,0),U,14)="OOS"
Begin DoDot:2
+23 ;139
IF '$$EX^SDCOU2(ECSTOP,DT)
SET ERR=ERR+1
SET ECERR(ERR)="INVALID OR INACTIVE STOP CODE ASSOCIATED WITH AN OOS DSS UNIT"
End DoDot:2
+24 ;119
IF $GET(ECPTYP)'="E"
IF ($Y+4)>IOSL
DO PAGE
if ECOUT
QUIT
DO HEAD
+25 ;if errors, loop through array, write, then kill
+26 IF ERR
Begin DoDot:2
+27 ;119
IF $GET(ECPTYP)="E"
DO EXPORT
QUIT
+28 WRITE !!,"DSS Unit: ",?12,UNT,?19,UNITNM
+29 WRITE !,"Stop Code: ",?12,ECSTOP1,?19,ECNAME
+30 ;119
FOR I=1:1:ERR
WRITE !,"Reason: ",ECERR(I)
End DoDot:2
SET ERR=0
KILL ECERR
End DoDot:1
IF ECOUT
QUIT
+31 QUIT
EXIT ;
+1 KILL POP,QUIT,ZTQUEUED
+2 QUIT
+3 ;
HEAD ;header
+1 if $EXTRACT(IOST,1,2)="C-"!(PG>1)
WRITE @IOF
+2 WRITE !!,"DSS UNITS WITH ANY ASSOCIATED STOP CODE ERRORS"
+3 WRITE !,"Page: ",PG,?53,"Run Date: ",ECRDT,!,LN
+4 SET PG=PG+1
+5 QUIT
PAGE ;
+1 NEW SS,JJ
+2 IF $DATA(PG)
IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:1
+3 SET SS=22-$Y
FOR JJ=1:1:22
WRITE !
+4 SET DIR(0)="E"
WRITE !
DO ^DIR
KILL DIR
IF 'Y
SET ECOUT=1
End DoDot:1
+5 QUIT
+6 ;
STRTGUI ; if called from GUI, enter routine here
+1 DO EN
+2 QUIT
+3 ;
EXPORT ;Section added in 119, puts data in exportable format
+1 NEW I
+2 SET CNT=CNT+1
SET ^TMP($JOB,"ECRPT",CNT)=UNT_U_UNITNM_U_ECSTOP1_U_ECNAME
+3 FOR I=1:1:ERR
SET ^TMP($JOB,"ECRPT",CNT)=^TMP($JOB,"ECRPT",CNT)_U_ECERR(I)
+4 QUIT
