ACHSEOBY.m

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       ;