Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACHSEOBS

ACHSEOBS.m

Go to the documentation of this file. 
  1. ACHSEOBS ; IHS/ITSC/TPF/PMF - SELECT EOBR FILE FOR PROCESSING ; 
  1.  ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**22**;JUN 11, 2001;Build 43
  1.  ;
  1.  W @IOF,$$REPEAT^XLFSTR("*",79),!,$$C^XBFUNC("***   SELECT EOBR FILE FOR PROCESSING   ***")
  1.  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)_"'.")
  1.  W !,$$REPEAT^XLFSTR("*",79),!
  1.  D ^ACHSEOBY                    ;GET LIST OF FILES AVAILABLE
  1.  I $D(ACHSJFLG) G ABEND
  1. D0 ;
  1.  S (ACHSI,ACHSII)="",ACHSISEQ=0
  1.  K ACHSSEL
  1.  U IO(0)
  1.  W !!,"NUMBER   FILE NAME               FI PROCESS DATE  # RCDS   SEQ #"
  1.  W !,"------   ---------------         ---------------  ------   ------"
  1. D1 ;
  1.  S ACHSII=$O(ACHSUFLS("C",ACHSII))
  1.  G DEND:+ACHSII=0
  1. D2 ;
  1.  S ACHSI=$O(ACHSUFLS("C",ACHSII,ACHSI))
  1.  G D1:+ACHSI=0
  1.  G D1:$P(ACHSUFLS(ACHSI),U,2)'="OK"
  1.  S ACHSISEQ=ACHSISEQ+1
  1.  W !,$J(ACHSISEQ,6),?9,$P(ACHSUFLS(ACHSI),U,1)
  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
  1.  ;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)
  1.  W ?35,$$FMTE^XLFDT(X),?50,$J($FN($P(ACHSUFLS(ACHSI),U,4),",",0),6),?60,$J($P(ACHSUFLS(ACHSI),U,5),3)
  1.  S ACHSSEL(ACHSISEQ)=ACHSI
  1.  G D2
  1.  ;
  1. DEND ;
  1.  W !
  1.  S X=$$DIR^XBDIR("NO^1:"_ACHSISEQ,"Enter NUMBER of EOBR FILE From Above List to Process")
  1.  I $D(DTOUT)!$D(DUOUT)!('X) S ACHSAEND=2 Q
  1.  I '$D(ACHSSEL(X)) G ABEND
  1.  S ACHSFILE=+ACHSSEL(X),ACHSZFN=$P(ACHSUFLS(ACHSFILE),U,1),ACHSEOBD=$P(ACHSUFLS(ACHSFILE),U,3)
  1.  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
  1.  S ACHSLEOB=$P(^ACHSAOP(DUZ(2),2),U,11)
  1.  I 'ACHSISAO G CONT
  1.  ;
  1.  I +$P(^ACHSAOP(DUZ(2),2),U,9)=0 G SEQOK
  1.  I +$P(^ACHSAOP(DUZ(2),2),U,9)=999 S $P(^ACHSAOP(DUZ(2),2),U,9)=0
  1.  I $P(^ACHSAOP(DUZ(2),2),U,9)+1=$P(ACHSUFLS(ACHSFILE),U,5) G SEQOK
  1.  G:$P(ACHSUFLS(ACHSFILE),U,5)="ICD" FACCK   ;ACHS*3.1*22 ICD-9 FIX
  1.  K DIR
  1.  U IO(0)
  1.  W !,*7,"Wrong BCBS Report (Sequence) Number Selected ",!
  1.  S DIR(0)="E"
  1.  D ^DIR
  1.  G D0:Y=1,ABEND:Y=0,D0:Y=""
  1. SEQOK ;
  1.  ;CHECK IF B X-REF FOR 'EOBR PROCESS DATE' HAS BEEN SET IF SO THEN
  1.  ;THE FILE HAS BEEN PROCESSED. FILE IS 'CHS AREA OFFICE PARAMETERS'
  1.  I '$D(^ACHSAOP(DUZ(2),17,"B",ACHSEOBD)) G CONT
  1.  U IO(0)
  1.  W *7,!
  1.  I $$DIR^XBDIR("E","FI EOBR FILE has already been PROCESSED -- Enter <RETURN> to Continue")
  1.  G ABEND
  1.  ;
  1. FACCK ;ACHS*3.1*22 FAC ICD9 FILE ALREADY PROCESSED
  1.  S X=0,X=$O(^AUTTLOC("C",$P(ACHSUFLS(ACHSFILE),U,6),X))
  1.  I $P(^ACHSAOP(DUZ(2),16,X,0),U,6)'="Y" G CONT
  1.  U IO(0)
  1.  W *7,!
  1.  I $$DIR^XBDIR("E","FI ICD EOBR FILE has already been PROCESSED -- Enter <RETURN> to Continue")
  1.  G ABEND
  1.  ;
  1. CONT ;
  1.  S ACHSMEDA=ACHSZFN
  1.  Q
  1.  ;
  1. ABEND ;
  1.  S ACHSAEND=1
  1. VKILL ; Kill vars, quit.
  1.  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
  1.  Q
  1.  ;