ACHSEOBY ; IHS/ITSC/TPF/PMF - CHECK STATUS OF BCBS EOBR REPORTS ;
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**21,22**;JUN 11, 2001;Build 43
;
I '$L($$AOP^ACHS(2,1)) D NODIR Q
K ACHSUNMS,ACHSUFLS
S ACHSLCTR=0
;I $$LIST^%ZISH($$AOP^ACHS(2,1),"bcbseob*",.ACHSUFLS) S ACHSEMSG="M10" D ERROR^ACHSTCK1 G ABEND ;ACHS*3.1*21
I $$LIST^%ZISH($$AOP^ACHS(2,1),"bcbseob*",.ACHSUFLS) S ACHSEMSG="M15" D ERROR^ACHSTCK1 G END ;ACHS*3.1*21
S ACHSI=0
C1 ;
S ACHSI=$O(ACHSUFLS(ACHSI))
G C1A:+ACHSI=0
S ACHSXX=ACHSUFLS(ACHSI),ACHSUFLS(ACHSI)=ACHSUFLS(ACHSI)_"^"
D TESTEX,^%ZISC
G C1
;
C1A ;
G FILDEL
;
TESTEX ;
I $$OPEN^%ZISH($$AOP^ACHS(2,1),ACHSXX,"R") S ACHSEMSG="M10" D ERROR^ACHSTCK1 G ABEND
S ACHSLMT=100,ACHSRCT=0
TESTRD ;
U IO
R ACHSXX:1 ;SAC-FILE READ
Q:'$T
G EOF:$$STATUS^%ZISH
;I ACHSISAO S ACHSXX=$E(ACHSXX,3,85) ;ACHS*3.1*21
I ACHSISAO S ACHSXX=$S($$OS^ACHS=2:$E(ACHSXX,1,82),1:$E(ACHSXX,3,85)) ;ACHS*3.1*21
S ACHSRCT=ACHSRCT+1
I ACHSRCT>ACHSLMT G EOF
I $E(ACHSXX,1,2)'="$$" G TESTRD
S ACHSERDT=$E(ACHSXX,3,8),ACHSERRC=+$E(ACHSXX,10,18)
;ACHS*3.1*22 ADDED TO VIEW THE FILE WITH ICD9 FIXES
;S $P(ACHSUFLS(ACHSI),U,3)=$E(ACHSXX,3,8),$P(ACHSUFLS(ACHSI),U,4)=+$E(ACHSXX,10,18),$P(ACHSUFLS(ACHSI),U,5)=+$E(ACHSXX,20,22)
S $P(ACHSUFLS(ACHSI),U,3)=$E(ACHSXX,3,8),$P(ACHSUFLS(ACHSI),U,4)=+$E(ACHSXX,10,18),$P(ACHSUFLS(ACHSI),U,5)=$S($E(ACHSXX,20,22)?1N.N:+$E(ACHSXX,20,22),1:$E(ACHSXX,20,22))
S $P(ACHSUFLS(ACHSI),U,6)=$E(ACHSXX,25,30) ;ACHS*3.1*22 ADDED FOR ICD9 FILE
S $P(ACHSUFLS(ACHSI),U,2)="OK"
Q
;
EOF ;
S $P(ACHSUFLS(ACHSI),U,2)=""
Q
;
FILDEL ; Delete HFS files.
S ACHSI=""
FILDELA ;
S ACHSI=$O(ACHSUFLS(ACHSI))
G FILDELC:+ACHSI=0
S ACHSDATE=$P(ACHSUFLS(ACHSI),U,3)
G FILDELA:$L(ACHSDATE)=0
S X=ACHSDATE,X=$E(X,5,6)_$E(X,1,4),X=$S($E(X,1,2)>50:2,1:3)_X
S ACHSDATE=X,ACHSRDAT=9999999-ACHSDATE,ACHSUFLS("C",ACHSRDAT,ACHSI)=""
G FILDELA
;
FILDELC ;
S (ACHSR,ACHSRR,ACHSDELD,ACHSCNT,ACHSDSAV)=0
FILDELC1 ;
S ACHSR=$O(ACHSUFLS("C",ACHSR))
G FILDELF:+ACHSR=0
FILDELC2 ;
S ACHSRR=$O(ACHSUFLS("C",ACHSR,ACHSRR))
G FILDELC1:+ACHSRR=0
S ACHSCNT=ACHSCNT+1
I ACHSCNT=6 S ACHSDELD=9999999-ACHSR
G FILDELC2
;
FILDELF ;
G FILDEND:+ACHSDELD=0
S Y=$$FMTE^XLFDT(ACHSDELD)
U IO(0)
S Y=$$DIR^XBDIR("Y","Delete ALL FI EOBR FILES With Process Date BEFORE "_Y,"Y","","","",2)
I Y=1 G FILDELK
G FILDEND
;
FILDELK ;
S ACHSR=9999999-ACHSDELD
FILDELK1 ;
S ACHSR=$O(ACHSUFLS("C",ACHSR))
G FILDEND:+ACHSR=0
S ACHSRR="",ACHSRR=$O(ACHSUFLS("C",ACHSR,ACHSRR))
G FILDELK1:+ACHSRR=0
I $$AOP^ACHS(2,9)<10,$P(ACHSUFLS(ACHSRR),U,5)>990 G FILDELK2
G FILDELK1:$P(ACHSUFLS(ACHSRR),U,5)'<$$AOP^ACHS(2,9)
FILDELK2 ;
G FILDELK1:$P(ACHSUFLS(ACHSRR),U,5)=$$AOP^ACHS(2,9)
FILDELK3 ;
S ACHSZFN=$P(ACHSUFLS(ACHSRR),U,1)
I '$$DEL^%ZISH($$AOP^ACHS(2,1),ACHSZFN) U IO(0) W !!?10,ACHSZFN," has been DELETED" K ACHSUFLS("C",ACHSR,ACHSRR),ACHSUFLS(ACHSRR)
G FILDELK1
;
FILDEND ;
Q
;
END ; ;ACHS*3.1*21 NEW SUB
U IO(0)
D CLOSEALL^ACHS
Q
ABEND ;
U IO(0)
W *7,!!,$$C^XBFUNC("JOB ENDED WITH ERROR(S) - NOTIFY SUPERVISOR"),!
D CLOSEALL^ACHS
I $$DIR^XBDIR("E","Enter <RETURN> to CONTINUE")
Q
;
NODIR ;
U IO(0)
W *7,!,$$C^XBFUNC("Your EOBR IMPORT DIRECTORY is not defined in your")
W !,$$C^XBFUNC("CHS AREA OFFICE PARAMETERS file.")
W !,$$C^XBFUNC("The directory is usually"),!,$$C^XBFUNC("/usr/spool/chsdata"),!,$$C^XBFUNC("for unix systems, and"),!,$$C^XBFUNC("c:\usr\spool\chsdata"),!,$$C^XBFUNC("for DOS systems.")
G ABEND
;
ACHSEOBY ; IHS/ITSC/TPF/PMF - CHECK STATUS OF BCBS EOBR REPORTS ;
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**21,22**;JUN 11, 2001;Build 43
+2 ;
+3 IF '$LENGTH($$AOP^ACHS(2,1))
DO NODIR
QUIT
+4 KILL ACHSUNMS,ACHSUFLS
+5 SET ACHSLCTR=0
+6 ;I $$LIST^%ZISH($$AOP^ACHS(2,1),"bcbseob*",.ACHSUFLS) S ACHSEMSG="M10" D ERROR^ACHSTCK1 G ABEND ;ACHS*3.1*21
+7 ;ACHS*3.1*21
IF $$LIST^%ZISH($$AOP^ACHS(2,1),"bcbseob*",.ACHSUFLS)
SET ACHSEMSG="M15"
DO ERROR^ACHSTCK1
GOTO END
+8 SET ACHSI=0
C1 ;
+1 SET ACHSI=$ORDER(ACHSUFLS(ACHSI))
+2 IF +ACHSI=0
GOTO C1A
+3 SET ACHSXX=ACHSUFLS(ACHSI)
SET ACHSUFLS(ACHSI)=ACHSUFLS(ACHSI)_"^"
+4 DO TESTEX
DO ^%ZISC
+5 GOTO C1
+6 ;
C1A ;
+1 GOTO FILDEL
+2 ;
TESTEX ;
+1 IF $$OPEN^%ZISH($$AOP^ACHS(2,1),ACHSXX,"R")
SET ACHSEMSG="M10"
DO ERROR^ACHSTCK1
GOTO ABEND
+2 SET ACHSLMT=100
SET ACHSRCT=0
TESTRD ;
+1 USE IO
+2 ;SAC-FILE READ
READ ACHSXX:1
+3 IF '$TEST
QUIT
+4 IF $$STATUS^%ZISH
GOTO EOF
+5 ;I ACHSISAO S ACHSXX=$E(ACHSXX,3,85) ;ACHS*3.1*21
+6 ;ACHS*3.1*21
IF ACHSISAO
SET ACHSXX=$SELECT($$OS^ACHS=2:$E(ACHSXX,1,82),1:$EXTRACT(ACHSXX,3,85))
+7 SET ACHSRCT=ACHSRCT+1
+8 IF ACHSRCT>ACHSLMT
GOTO EOF
+9 IF $EXTRACT(ACHSXX,1,2)'="$$"
GOTO TESTRD
+10 SET ACHSERDT=$EXTRACT(ACHSXX,3,8)
SET ACHSERRC=+$EXTRACT(ACHSXX,10,18)
+11 ;ACHS*3.1*22 ADDED TO VIEW THE FILE WITH ICD9 FIXES
+12 ;S $P(ACHSUFLS(ACHSI),U,3)=$E(ACHSXX,3,8),$P(ACHSUFLS(ACHSI),U,4)=+$E(ACHSXX,10,18),$P(ACHSUFLS(ACHSI),U,5)=+$E(ACHSXX,20,22)
+13 SET $PIECE(ACHSUFLS(ACHSI),U,3)=$EXTRACT(ACHSXX,3,8)
SET $PIECE(ACHSUFLS(ACHSI),U,4)=+$EXTRACT(ACHSXX,10,18)
SET $PIECE(ACHSUFLS(ACHSI),U,5)=$SELECT($EXTRACT(ACHSXX,20,22)?1N.N:+$EXTRACT(ACHSXX,20,22),1:$EXTRACT(ACHSXX,20,22))
+14 ;ACHS*3.1*22 ADDED FOR ICD9 FILE
SET $PIECE(ACHSUFLS(ACHSI),U,6)=$EXTRACT(ACHSXX,25,30)
+15 SET $PIECE(ACHSUFLS(ACHSI),U,2)="OK"
+16 QUIT
+17 ;
EOF ;
+1 SET $PIECE(ACHSUFLS(ACHSI),U,2)=""
+2 QUIT
+3 ;
FILDEL ; Delete HFS files.
+1 SET ACHSI=""
FILDELA ;
+1 SET ACHSI=$ORDER(ACHSUFLS(ACHSI))
+2 IF +ACHSI=0
GOTO FILDELC
+3 SET ACHSDATE=$PIECE(ACHSUFLS(ACHSI),U,3)
+4 IF $LENGTH(ACHSDATE)=0
GOTO FILDELA
+5 SET X=ACHSDATE
SET X=$EXTRACT(X,5,6)_$EXTRACT(X,1,4)
SET X=$SELECT($EXTRACT(X,1,2)>50:2,1:3)_X
+6 SET ACHSDATE=X
SET ACHSRDAT=9999999-ACHSDATE
SET ACHSUFLS("C",ACHSRDAT,ACHSI)=""
+7 GOTO FILDELA
+8 ;
FILDELC ;
+1 SET (ACHSR,ACHSRR,ACHSDELD,ACHSCNT,ACHSDSAV)=0
FILDELC1 ;
+1 SET ACHSR=$ORDER(ACHSUFLS("C",ACHSR))
+2 IF +ACHSR=0
GOTO FILDELF
FILDELC2 ;
+1 SET ACHSRR=$ORDER(ACHSUFLS("C",ACHSR,ACHSRR))
+2 IF +ACHSRR=0
GOTO FILDELC1
+3 SET ACHSCNT=ACHSCNT+1
+4 IF ACHSCNT=6
SET ACHSDELD=9999999-ACHSR
+5 GOTO FILDELC2
+6 ;
FILDELF ;
+1 IF +ACHSDELD=0
GOTO FILDEND
+2 SET Y=$$FMTE^XLFDT(ACHSDELD)
+3 USE IO(0)
+4 SET Y=$$DIR^XBDIR("Y","Delete ALL FI EOBR FILES With Process Date BEFORE "_Y,"Y","","","",2)
+5 IF Y=1
GOTO FILDELK
+6 GOTO FILDEND
+7 ;
FILDELK ;
+1 SET ACHSR=9999999-ACHSDELD
FILDELK1 ;
+1 SET ACHSR=$ORDER(ACHSUFLS("C",ACHSR))
+2 IF +ACHSR=0
GOTO FILDEND
+3 SET ACHSRR=""
SET ACHSRR=$ORDER(ACHSUFLS("C",ACHSR,ACHSRR))
+4 IF +ACHSRR=0
GOTO FILDELK1
+5 IF $$AOP^ACHS(2,9)<10
IF $PIECE(ACHSUFLS(ACHSRR),U,5)>990
GOTO FILDELK2
+6 IF $PIECE(ACHSUFLS(ACHSRR),U,5)'<$$AOP^ACHS(2,9)
GOTO FILDELK1
FILDELK2 ;
+1 IF $PIECE(ACHSUFLS(ACHSRR),U,5)=$$AOP^ACHS(2,9)
GOTO FILDELK1
FILDELK3 ;
+1 SET ACHSZFN=$PIECE(ACHSUFLS(ACHSRR),U,1)
+2 IF '$$DEL^%ZISH($$AOP^ACHS(2,1),ACHSZFN)
USE IO(0)
WRITE !!?10,ACHSZFN," has been DELETED"
KILL ACHSUFLS("C",ACHSR,ACHSRR),ACHSUFLS(ACHSRR)
+3 GOTO FILDELK1
+4 ;
FILDEND ;
+1 QUIT
+2 ;
END ; ;ACHS*3.1*21 NEW SUB
+1 USE IO(0)
+2 DO CLOSEALL^ACHS
+3 QUIT
ABEND ;
+1 USE IO(0)
+2 WRITE *7,!!,$$C^XBFUNC("JOB ENDED WITH ERROR(S) - NOTIFY SUPERVISOR"),!
+3 DO CLOSEALL^ACHS
+4 IF $$DIR^XBDIR("E","Enter <RETURN> to CONTINUE")
+5 QUIT
+6 ;
NODIR ;
+1 USE IO(0)
+2 WRITE *7,!,$$C^XBFUNC("Your EOBR IMPORT DIRECTORY is not defined in your")
+3 WRITE !,$$C^XBFUNC("CHS AREA OFFICE PARAMETERS file.")
+4 WRITE !,$$C^XBFUNC("The directory is usually"),!,$$C^XBFUNC("/usr/spool/chsdata"),!,$$C^XBFUNC("for unix systems, and"),!,$$C^XBFUNC("c:\usr\spool\chsdata"),!,$$C^XBFUNC("for DOS systems.")
+5 GOTO ABEND
+6 ;
