ECXSCX3 ;ALB/DHE- DSS Clinic & Stop Codes Validity Report 728.44 ;2/11/14 17:03
;;3.0;DSS EXTRACTS;**120,144,149,154**;Dec 22, 1997;Build 13
EN ;entry point from option
;
N ZTDESC,ZTRTN,ZTSAVE,ZTSK,ZUSR,ZTDTH,POP,ECXPORT,CNT,NUM ;144
W !!,"This report will display stop code information of the ACTIVE ",!,"clinics in the Clinics and Stop Code file (#728.44). It will",!,"display stop codes that do not conform to the Business Rules for ",!,"Valid Stop Codes." ;144
W !!,"**REMINDER - The CREATE option last ran on ",$S($D(^ECX(728.44,"C")):$$FMTE^XLFDT($O(^ECX(728.44,"C"," "),-1),2),1:"- No date on file"),"." ;154
W !,"If the most recent clinic changes from the HOSPITAL LOCATION file #44",!,"are desired, run the CREATE option before running a report.**" ;154
I '$D(^ECX(728.44)) W !,"DSS Clinic stop code file does not exist",!! R X:5 K X Q
S ECXPORT=$$EXPORT^ECXUTL1 Q:ECXPORT=-1 I ECXPORT D Q ;144
.K ^TMP($J,"ECXPORT") ;144
.S ^TMP($J,"ECXPORT",0)="IEN^CLINIC NAME^STOP CODE^CREDIT STOP CODE^CHAR4 CODE^ERROR 1^ERROR 2^ERROR 3^WARNING" ;144,149,154
.S CNT=1 ;144
.D START ;144
.D EXPDISP^ECXUTL1 ;144
.K ECXERR,WARNING D ^ECXKILL ;144
S %ZIS="Q" D ^%ZIS G:POP EXIT
I $D(IO("Q")) D Q
.K ZTSAVE S ZTDESC="DSS Identify Invalid Stop and Credit Stop Codes",ZTRTN="START^ECXSCX3",ZTDTH=$H
.D ^%ZTLOAD
.D ^%ZISC,HOME^%ZIS
.W !,$S($D(ZTSK):"REQUEST QUEUED!",1:"REQUEST CANCELLED!")
D START
EXIT D ^%ZISC,HOME^%ZIS
Q
START ; queued entry to print report
U IO
N CLIEN,CODE,ERR,QUIT,WRN,TOT,CODE1,CODE2,CODE3,CODE4,CODE5,CLNAME,DATE
N I,INACT,Y,HEAD,NONAME,QFLG,LN,PG,DAT,REACT
K WARNING,ECXERR,TYPE
S QFLG=0,$P(LN,"-",80)="",PG=0
S TOT=0,QUIT=""
I '$G(ECXPORT) D HEAD ;144
S CLIEN=0 F S CLIEN=$O(^ECX(728.44,CLIEN)) Q:'CLIEN D Q:QUIT
.Q:'$D(^ECX(728.44,CLIEN,0))
.I $P($G(^SC(CLIEN,0)),U,3)'="C" Q ;149 Don't include it on report if it's not a clinic
.S DAT=$G(^SC(CLIEN,"I")),INACT=+DAT,REACT=$P(DAT,"^",2)
.;S INACT=$P(^ECX(728.44,CLIEN,0),"^",10)
.;I (INACT'>DT)&(INACT'="") Q
.I INACT,('REACT),INACT'>DT Q
.I INACT,INACT'>DT I REACT,DT<REACT Q
.S CLNAME=$S($G(CLIEN)>0:$E($$GET1^DIQ(44,CLIEN,.01,"E"),1,30),1:NONAME)
.K WARNING,ECXERR,TYPE,ERR,WRN
.S DATE=DT
.S CODE1=$P(^ECX(728.44,CLIEN,0),"^",2),TYPE="Stop Code" D STOP^ECXSTOP(CODE1,TYPE,CLIEN,DATE)
.S CODE2=$P(^ECX(728.44,CLIEN,0),"^",3),TYPE="Credit Stop Code" D STOP^ECXSTOP(CODE2,TYPE,CLIEN,DATE)
.;S CODE3=$P(^ECX(728.44,CLIEN,0),"^",4),TYPE="DSS Stop Code" D STOP^ECXSTOP(CODE3,TYPE,CLIEN,DATE) ;154
.;S CODE4=$P(^ECX(728.44,CLIEN,0),"^",5),TYPE="DSS Credit Stop Code" D STOP^ECXSTOP(CODE4,TYPE,CLIEN,DATE) ;154
.S CODE5=$P(^ECX(728.44,CLIEN,0),"^",8),TYPE="CHAR4 Code" D STOP^ECXSTOP(CODE5,TYPE,CLIEN,DATE) ;149 CVW
.I $D(ECXERR)!($D(WARNING)) S TOT=TOT+1 D Q:QUIT
..I (CODE5'="")&($$GET1^DIQ(728.441,CODE5,.01)'="") S CODE5=$$GET1^DIQ(728.441,CODE5,.01)
..I $G(ECXPORT) D Q ;144
...S ^TMP($J,"ECXPORT",CNT)=CLIEN_"^"_CLNAME_"^"_$G(CODE1)_"^"_$G(CODE2)_"^"_$G(CODE5)_"^" ;144 154
...S NUM=0 F I=1:1:3 S:NUM'="" NUM=$O(ECXERR(NUM)) S ^TMP($J,"ECXPORT",CNT)=^TMP($J,"ECXPORT",CNT)_$S(NUM'="":$G(ECXERR(NUM)),1:"")_"^" ;144
...S NUM=+$O(WARNING(0)) S ^TMP($J,"ECXPORT",CNT)=^TMP($J,"ECXPORT",CNT)_$G(WARNING(NUM)),CNT=CNT+1 ;144
..I $Y>(IOSL-5) D HEAD
..W !!,CLIEN,?13,CLNAME,?53,$G(CODE1),?63,$G(CODE2),?72,$G(CODE5) ;149,154
..I $D(ECXERR) W !,"ERRORS:" D
...S I=0 F S I=$O(ECXERR(I)) Q:'I D Q:QUIT
....W !?6,ECXERR(I) D ADD
..I $D(WARNING) W !,"WARNINGS:" D
...S I=0 F S I=$O(WARNING(I)) Q:'I D Q:QUIT
....W !?6,WARNING(I) D ADD
Q:QUIT!($G(ECXPORT)) ;144
;
OUT ;
I TOT'>0 W !!!?6,"NO PROBLEMS FOUND."
E W !!!,?10,TOT," PROBLEM CLINICS FOUND."
W:$Y @IOF D ^%ZISC S ZTREQ="@"
K QFLG,PG,LN,ECXERR,WARNING
D ^ECXKILL
Q
;
HEAD ; header for worksheet
W:$E(IOST,1,2)["C-"!(PG>1) @IOF S PG=PG+1
W !,"CLINIC & STOP CODES VALIDITY REPORT",?71,"Page: ",PG
W !!,"IEN#",?13,"CLINIC NAME",?53,"STOP",?63,"CREDIT",?72,"CHAR4" ;144,154 CVW
W !?53,"CODE",?63,"STOP",?72,"CODE" ;144,149,154 CVW
W !?63,"CODE" ;149,154 CVW
W !,LN
Q
;
PAUSE N DIR,DIRUT,X,Y
F Q:$Y>(IOSL-3) W !
S DIR(0)="E"
D ^DIR
I ('(+Y))!($D(DIRUT)) S QUIT=1
Q
ADD I $E(IOST,1,2)="C-",($Y>(IOSL-5)) D
. D PAUSE Q:QUIT
. D HEAD
I $E(IOST,1,2)'="C-",($Y>(IOSL-5)) D HEAD
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXSCX3 4388 printed Dec 13, 2024@01:53:54 Page 2
ECXSCX3 ;ALB/DHE- DSS Clinic & Stop Codes Validity Report 728.44 ;2/11/14 17:03
+1 ;;3.0;DSS EXTRACTS;**120,144,149,154**;Dec 22, 1997;Build 13
EN ;entry point from option
+1 ;
+2 ;144
NEW ZTDESC,ZTRTN,ZTSAVE,ZTSK,ZUSR,ZTDTH,POP,ECXPORT,CNT,NUM
+3 ;144
WRITE !!,"This report will display stop code information of the ACTIVE ",!,"clinics in the Clinics and Stop Code file (#728.44). It will",!,"display stop codes that do not conform to the Business Rules for ",!,"Valid Stop Codes."
+4 ;154
WRITE !!,"**REMINDER - The CREATE option last ran on ",$SELECT($DATA(^ECX(728.44,"C")):$$FMTE^XLFDT($ORDER(^ECX(728.44,"C"," "),-1),2),1:"- No date on file"),"."
+5 ;154
WRITE !,"If the most recent clinic changes from the HOSPITAL LOCATION file #44",!,"are desired, run the CREATE option before running a report.**"
+6 IF '$DATA(^ECX(728.44))
WRITE !,"DSS Clinic stop code file does not exist",!!
READ X:5
KILL X
QUIT
+7 ;144
SET ECXPORT=$$EXPORT^ECXUTL1
if ECXPORT=-1
QUIT
IF ECXPORT
Begin DoDot:1
+8 ;144
KILL ^TMP($JOB,"ECXPORT")
+9 ;144,149,154
SET ^TMP($JOB,"ECXPORT",0)="IEN^CLINIC NAME^STOP CODE^CREDIT STOP CODE^CHAR4 CODE^ERROR 1^ERROR 2^ERROR 3^WARNING"
+10 ;144
SET CNT=1
+11 ;144
DO START
+12 ;144
DO EXPDISP^ECXUTL1
+13 ;144
KILL ECXERR,WARNING
DO ^ECXKILL
End DoDot:1
QUIT
+14 SET %ZIS="Q"
DO ^%ZIS
if POP
GOTO EXIT
+15 IF $DATA(IO("Q"))
Begin DoDot:1
+16 KILL ZTSAVE
SET ZTDESC="DSS Identify Invalid Stop and Credit Stop Codes"
SET ZTRTN="START^ECXSCX3"
SET ZTDTH=$HOROLOG
+17 DO ^%ZTLOAD
+18 DO ^%ZISC
DO HOME^%ZIS
+19 WRITE !,$SELECT($DATA(ZTSK):"REQUEST QUEUED!",1:"REQUEST CANCELLED!")
End DoDot:1
QUIT
+20 DO START
EXIT DO ^%ZISC
DO HOME^%ZIS
+1 QUIT
START ; queued entry to print report
+1 USE IO
+2 NEW CLIEN,CODE,ERR,QUIT,WRN,TOT,CODE1,CODE2,CODE3,CODE4,CODE5,CLNAME,DATE
+3 NEW I,INACT,Y,HEAD,NONAME,QFLG,LN,PG,DAT,REACT
+4 KILL WARNING,ECXERR,TYPE
+5 SET QFLG=0
SET $PIECE(LN,"-",80)=""
SET PG=0
+6 SET TOT=0
SET QUIT=""
+7 ;144
IF '$GET(ECXPORT)
DO HEAD
+8 SET CLIEN=0
FOR
SET CLIEN=$ORDER(^ECX(728.44,CLIEN))
if 'CLIEN
QUIT
Begin DoDot:1
+9 if '$DATA(^ECX(728.44,CLIEN,0))
QUIT
+10 ;149 Don't include it on report if it's not a clinic
IF $PIECE($GET(^SC(CLIEN,0)),U,3)'="C"
QUIT
+11 SET DAT=$GET(^SC(CLIEN,"I"))
SET INACT=+DAT
SET REACT=$PIECE(DAT,"^",2)
+12 ;S INACT=$P(^ECX(728.44,CLIEN,0),"^",10)
+13 ;I (INACT'>DT)&(INACT'="") Q
+14 IF INACT
IF ('REACT)
IF INACT'>DT
QUIT
+15 IF INACT
IF INACT'>DT
IF REACT
IF DT<REACT
QUIT
+16 SET CLNAME=$SELECT($GET(CLIEN)>0:$EXTRACT($$GET1^DIQ(44,CLIEN,.01,"E"),1,30),1:NONAME)
+17 KILL WARNING,ECXERR,TYPE,ERR,WRN
+18 SET DATE=DT
+19 SET CODE1=$PIECE(^ECX(728.44,CLIEN,0),"^",2)
SET TYPE="Stop Code"
DO STOP^ECXSTOP(CODE1,TYPE,CLIEN,DATE)
+20 SET CODE2=$PIECE(^ECX(728.44,CLIEN,0),"^",3)
SET TYPE="Credit Stop Code"
DO STOP^ECXSTOP(CODE2,TYPE,CLIEN,DATE)
+21 ;S CODE3=$P(^ECX(728.44,CLIEN,0),"^",4),TYPE="DSS Stop Code" D STOP^ECXSTOP(CODE3,TYPE,CLIEN,DATE) ;154
+22 ;S CODE4=$P(^ECX(728.44,CLIEN,0),"^",5),TYPE="DSS Credit Stop Code" D STOP^ECXSTOP(CODE4,TYPE,CLIEN,DATE) ;154
+23 ;149 CVW
SET CODE5=$PIECE(^ECX(728.44,CLIEN,0),"^",8)
SET TYPE="CHAR4 Code"
DO STOP^ECXSTOP(CODE5,TYPE,CLIEN,DATE)
+24 IF $DATA(ECXERR)!($DATA(WARNING))
SET TOT=TOT+1
Begin DoDot:2
+25 IF (CODE5'="")&($$GET1^DIQ(728.441,CODE5,.01)'="")
SET CODE5=$$GET1^DIQ(728.441,CODE5,.01)
+26 ;144
IF $GET(ECXPORT)
Begin DoDot:3
+27 ;144 154
SET ^TMP($JOB,"ECXPORT",CNT)=CLIEN_"^"_CLNAME_"^"_$GET(CODE1)_"^"_$GET(CODE2)_"^"_$GET(CODE5)_"^"
+28 ;144
SET NUM=0
FOR I=1:1:3
if NUM'=""
SET NUM=$ORDER(ECXERR(NUM))
SET ^TMP($JOB,"ECXPORT",CNT)=^TMP($JOB,"ECXPORT",CNT)_$SELECT(NUM'="":$GET(ECXERR(NUM)),1:"")_"^"
+29 ;144
SET NUM=+$ORDER(WARNING(0))
SET ^TMP($JOB,"ECXPORT",CNT)=^TMP($JOB,"ECXPORT",CNT)_$GET(WARNING(NUM))
SET CNT=CNT+1
End DoDot:3
QUIT
+30 IF $Y>(IOSL-5)
DO HEAD
+31 ;149,154
WRITE !!,CLIEN,?13,CLNAME,?53,$GET(CODE1),?63,$GET(CODE2),?72,$GET(CODE5)
+32 IF $DATA(ECXERR)
WRITE !,"ERRORS:"
Begin DoDot:3
+33 SET I=0
FOR
SET I=$ORDER(ECXERR(I))
if 'I
QUIT
Begin DoDot:4
+34 WRITE !?6,ECXERR(I)
DO ADD
End DoDot:4
if QUIT
QUIT
End DoDot:3
+35 IF $DATA(WARNING)
WRITE !,"WARNINGS:"
Begin DoDot:3
+36 SET I=0
FOR
SET I=$ORDER(WARNING(I))
if 'I
QUIT
Begin DoDot:4
+37 WRITE !?6,WARNING(I)
DO ADD
End DoDot:4
if QUIT
QUIT
End DoDot:3
End DoDot:2
if QUIT
QUIT
End DoDot:1
if QUIT
QUIT
+38 ;144
if QUIT!($GET(ECXPORT))
QUIT
+39 ;
OUT ;
+1 IF TOT'>0
WRITE !!!?6,"NO PROBLEMS FOUND."
+2 IF '$TEST
WRITE !!!,?10,TOT," PROBLEM CLINICS FOUND."
+3 if $Y
WRITE @IOF
DO ^%ZISC
SET ZTREQ="@"
+4 KILL QFLG,PG,LN,ECXERR,WARNING
+5 DO ^ECXKILL
+6 QUIT
+7 ;
HEAD ; header for worksheet
+1 if $EXTRACT(IOST,1,2)["C-"!(PG>1)
WRITE @IOF
SET PG=PG+1
+2 WRITE !,"CLINIC & STOP CODES VALIDITY REPORT",?71,"Page: ",PG
+3 ;144,154 CVW
WRITE !!,"IEN#",?13,"CLINIC NAME",?53,"STOP",?63,"CREDIT",?72,"CHAR4"
+4 ;144,149,154 CVW
WRITE !?53,"CODE",?63,"STOP",?72,"CODE"
+5 ;149,154 CVW
WRITE !?63,"CODE"
+6 WRITE !,LN
+7 QUIT
+8 ;
PAUSE NEW DIR,DIRUT,X,Y
+1 FOR
if $Y>(IOSL-3)
QUIT
WRITE !
+2 SET DIR(0)="E"
+3 DO ^DIR
+4 IF ('(+Y))!($DATA(DIRUT))
SET QUIT=1
+5 QUIT
ADD IF $EXTRACT(IOST,1,2)="C-"
IF ($Y>(IOSL-5))
Begin DoDot:1
+1 DO PAUSE
if QUIT
QUIT
+2 DO HEAD
End DoDot:1
+3 IF $EXTRACT(IOST,1,2)'="C-"
IF ($Y>(IOSL-5))
DO HEAD
+4 QUIT
+5 ;
