- 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 Feb 18, 2025@23:25:34 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