ACHSEOBS ; IHS/ITSC/TPF/PMF - SELECT EOBR FILE FOR PROCESSING ;
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**22**;JUN 11, 2001;Build 43
;
W @IOF,$$REPEAT^XLFSTR("*",79),!,$$C^XBFUNC("*** SELECT EOBR FILE FOR PROCESSING ***")
I ACHSISAO W !,$$C^XBFUNC("LAST AREA OFFICE SEQUENCE NUMBER = "_$$AOP^ACHS(2,9)),!,$$C^XBFUNC("FI/EOBR Files Archive Directory = '"_$$AOP^ACHS(2,7)_"'.")
W !,$$REPEAT^XLFSTR("*",79),!
D ^ACHSEOBY ;GET LIST OF FILES AVAILABLE
I $D(ACHSJFLG) G ABEND
D0 ;
S (ACHSI,ACHSII)="",ACHSISEQ=0
K ACHSSEL
U IO(0)
W !!,"NUMBER FILE NAME FI PROCESS DATE # RCDS SEQ #"
W !,"------ --------------- --------------- ------ ------"
D1 ;
S ACHSII=$O(ACHSUFLS("C",ACHSII))
G DEND:+ACHSII=0
D2 ;
S ACHSI=$O(ACHSUFLS("C",ACHSII,ACHSI))
G D1:+ACHSI=0
G D1:$P(ACHSUFLS(ACHSI),U,2)'="OK"
S ACHSISEQ=ACHSISEQ+1
W !,$J(ACHSISEQ,6),?9,$P(ACHSUFLS(ACHSI),U,1)
S X=$P(ACHSUFLS(ACHSI),U,3),X=$E(X,5,6)_$E(X,1,4),X=$S($E(X,1,2)>50:2,1:3)_X
;W ?28,$J($$FMTE^XLFDT(X),15),?52,$J($FN($P(ACHSUFLS(ACHSI),U,4),",",0),6),?60,$J($P(ACHSUFLS(ACHSI),U,5),3)
W ?35,$$FMTE^XLFDT(X),?50,$J($FN($P(ACHSUFLS(ACHSI),U,4),",",0),6),?60,$J($P(ACHSUFLS(ACHSI),U,5),3)
S ACHSSEL(ACHSISEQ)=ACHSI
G D2
;
DEND ;
W !
S X=$$DIR^XBDIR("NO^1:"_ACHSISEQ,"Enter NUMBER of EOBR FILE From Above List to Process")
I $D(DTOUT)!$D(DUOUT)!('X) S ACHSAEND=2 Q
I '$D(ACHSSEL(X)) G ABEND
S ACHSFILE=+ACHSSEL(X),ACHSZFN=$P(ACHSUFLS(ACHSFILE),U,1),ACHSEOBD=$P(ACHSUFLS(ACHSFILE),U,3)
I ACHSISAO S X=ACHSEOBD,X=$E(X,5,6)_$E(X,1,4),ACHSEOBD=$S($E(X,1,2)>50:2,1:3)_X
S ACHSLEOB=$P(^ACHSAOP(DUZ(2),2),U,11)
I 'ACHSISAO G CONT
;
I +$P(^ACHSAOP(DUZ(2),2),U,9)=0 G SEQOK
I +$P(^ACHSAOP(DUZ(2),2),U,9)=999 S $P(^ACHSAOP(DUZ(2),2),U,9)=0
I $P(^ACHSAOP(DUZ(2),2),U,9)+1=$P(ACHSUFLS(ACHSFILE),U,5) G SEQOK
G:$P(ACHSUFLS(ACHSFILE),U,5)="ICD" FACCK ;ACHS*3.1*22 ICD-9 FIX
K DIR
U IO(0)
W !,*7,"Wrong BCBS Report (Sequence) Number Selected ",!
S DIR(0)="E"
D ^DIR
G D0:Y=1,ABEND:Y=0,D0:Y=""
SEQOK ;
;CHECK IF B X-REF FOR 'EOBR PROCESS DATE' HAS BEEN SET IF SO THEN
;THE FILE HAS BEEN PROCESSED. FILE IS 'CHS AREA OFFICE PARAMETERS'
I '$D(^ACHSAOP(DUZ(2),17,"B",ACHSEOBD)) G CONT
U IO(0)
W *7,!
I $$DIR^XBDIR("E","FI EOBR FILE has already been PROCESSED -- Enter <RETURN> to Continue")
G ABEND
;
FACCK ;ACHS*3.1*22 FAC ICD9 FILE ALREADY PROCESSED
S X=0,X=$O(^AUTTLOC("C",$P(ACHSUFLS(ACHSFILE),U,6),X))
I $P(^ACHSAOP(DUZ(2),16,X,0),U,6)'="Y" G CONT
U IO(0)
W *7,!
I $$DIR^XBDIR("E","FI ICD EOBR FILE has already been PROCESSED -- Enter <RETURN> to Continue")
G ABEND
;
CONT ;
S ACHSMEDA=ACHSZFN
Q
;
ABEND ;
S ACHSAEND=1
VKILL ; Kill vars, quit.
K ACHSZDEV,ACHSZFN,ACHSZFO,ACHSZIN,ACHSCMD,ACHSERDT,ACHSERR,ACHSERRC,ACHSLMT,ACHSRCT,ACHSCMD,ACHSFILE,ACHSFNAM,ACHSFSIZ,ACHSHFS1,ACHSI,ACHSISEQ,ACHSSEL,ACHSUFLS,ACHSLCTR,DIR,X,Y,ACHSXX,ACHSLEOB
Q
;
ACHSEOBS ; IHS/ITSC/TPF/PMF - SELECT EOBR FILE FOR PROCESSING ;
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**22**;JUN 11, 2001;Build 43
+2 ;
+3 WRITE @IOF,$$REPEAT^XLFSTR("*",79),!,$$C^XBFUNC("*** SELECT EOBR FILE FOR PROCESSING ***")
+4 IF ACHSISAO
WRITE !,$$C^XBFUNC("LAST AREA OFFICE SEQUENCE NUMBER = "_$$AOP^ACHS(2,9)),!,$$C^XBFUNC("FI/EOBR Files Archive Directory = '"_$$AOP^ACHS(2,7)_"'.")
+5 WRITE !,$$REPEAT^XLFSTR("*",79),!
+6 ;GET LIST OF FILES AVAILABLE
DO ^ACHSEOBY
+7 IF $DATA(ACHSJFLG)
GOTO ABEND
D0 ;
+1 SET (ACHSI,ACHSII)=""
SET ACHSISEQ=0
+2 KILL ACHSSEL
+3 USE IO(0)
+4 WRITE !!,"NUMBER FILE NAME FI PROCESS DATE # RCDS SEQ #"
+5 WRITE !,"------ --------------- --------------- ------ ------"
D1 ;
+1 SET ACHSII=$ORDER(ACHSUFLS("C",ACHSII))
+2 IF +ACHSII=0
GOTO DEND
D2 ;
+1 SET ACHSI=$ORDER(ACHSUFLS("C",ACHSII,ACHSI))
+2 IF +ACHSI=0
GOTO D1
+3 IF $PIECE(ACHSUFLS(ACHSI),U,2)'="OK"
GOTO D1
+4 SET ACHSISEQ=ACHSISEQ+1
+5 WRITE !,$JUSTIFY(ACHSISEQ,6),?9,$PIECE(ACHSUFLS(ACHSI),U,1)
+6 SET X=$PIECE(ACHSUFLS(ACHSI),U,3)
SET X=$EXTRACT(X,5,6)_$EXTRACT(X,1,4)
SET X=$SELECT($EXTRACT(X,1,2)>50:2,1:3)_X
+7 ;W ?28,$J($$FMTE^XLFDT(X),15),?52,$J($FN($P(ACHSUFLS(ACHSI),U,4),",",0),6),?60,$J($P(ACHSUFLS(ACHSI),U,5),3)
+8 WRITE ?35,$$FMTE^XLFDT(X),?50,$JUSTIFY($FNUMBER($PIECE(ACHSUFLS(ACHSI),U,4),",",0),6),?60,$JUSTIFY($PIECE(ACHSUFLS(ACHSI),U,5),3)
+9 SET ACHSSEL(ACHSISEQ)=ACHSI
+10 GOTO D2
+11 ;
DEND ;
+1 WRITE !
+2 SET X=$$DIR^XBDIR("NO^1:"_ACHSISEQ,"Enter NUMBER of EOBR FILE From Above List to Process")
+3 IF $DATA(DTOUT)!$DATA(DUOUT)!('X)
SET ACHSAEND=2
QUIT
+4 IF '$DATA(ACHSSEL(X))
GOTO ABEND
+5 SET ACHSFILE=+ACHSSEL(X)
SET ACHSZFN=$PIECE(ACHSUFLS(ACHSFILE),U,1)
SET ACHSEOBD=$PIECE(ACHSUFLS(ACHSFILE),U,3)
+6 IF ACHSISAO
SET X=ACHSEOBD
SET X=$EXTRACT(X,5,6)_$EXTRACT(X,1,4)
SET ACHSEOBD=$SELECT($EXTRACT(X,1,2)>50:2,1:3)_X
+7 SET ACHSLEOB=$PIECE(^ACHSAOP(DUZ(2),2),U,11)
+8 IF 'ACHSISAO
GOTO CONT
+9 ;
+10 IF +$PIECE(^ACHSAOP(DUZ(2),2),U,9)=0
GOTO SEQOK
+11 IF +$PIECE(^ACHSAOP(DUZ(2),2),U,9)=999
SET $PIECE(^ACHSAOP(DUZ(2),2),U,9)=0
+12 IF $PIECE(^ACHSAOP(DUZ(2),2),U,9)+1=$PIECE(ACHSUFLS(ACHSFILE),U,5)
GOTO SEQOK
+13 ;ACHS*3.1*22 ICD-9 FIX
IF $PIECE(ACHSUFLS(ACHSFILE),U,5)="ICD"
GOTO FACCK
+14 KILL DIR
+15 USE IO(0)
+16 WRITE !,*7,"Wrong BCBS Report (Sequence) Number Selected ",!
+17 SET DIR(0)="E"
+18 DO ^DIR
+19 IF Y=1
GOTO D0
IF Y=0
GOTO ABEND
IF Y=""
GOTO D0
SEQOK ;
+1 ;CHECK IF B X-REF FOR 'EOBR PROCESS DATE' HAS BEEN SET IF SO THEN
+2 ;THE FILE HAS BEEN PROCESSED. FILE IS 'CHS AREA OFFICE PARAMETERS'
+3 IF '$DATA(^ACHSAOP(DUZ(2),17,"B",ACHSEOBD))
GOTO CONT
+4 USE IO(0)
+5 WRITE *7,!
+6 IF $$DIR^XBDIR("E","FI EOBR FILE has already been PROCESSED -- Enter <RETURN> to Continue")
+7 GOTO ABEND
+8 ;
FACCK ;ACHS*3.1*22 FAC ICD9 FILE ALREADY PROCESSED
+1 SET X=0
SET X=$ORDER(^AUTTLOC("C",$PIECE(ACHSUFLS(ACHSFILE),U,6),X))
+2 IF $PIECE(^ACHSAOP(DUZ(2),16,X,0),U,6)'="Y"
GOTO CONT
+3 USE IO(0)
+4 WRITE *7,!
+5 IF $$DIR^XBDIR("E","FI ICD EOBR FILE has already been PROCESSED -- Enter <RETURN> to Continue")
+6 GOTO ABEND
+7 ;
CONT ;
+1 SET ACHSMEDA=ACHSZFN
+2 QUIT
+3 ;
ABEND ;
+1 SET ACHSAEND=1
VKILL ; Kill vars, quit.
+1 KILL ACHSZDEV,ACHSZFN,ACHSZFO,ACHSZIN,ACHSCMD,ACHSERDT,ACHSERR,ACHSERRC,ACHSLMT,ACHSRCT,ACHSCMD,ACHSFILE,ACHSFNAM,ACHSFSIZ,ACHSHFS1,ACHSI,ACHSISEQ,ACHSSEL,ACHSUFLS,ACHSLCTR,DIR,X,Y,ACHSXX,ACHSLEOB
+2 QUIT
+3 ;
