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

ACHSEOB1.m

Go to the documentation of this file. 
  1. ACHSEOB1 ; IHS/ITSC/TPF/PMF - PROCESS EOBRS (2/6) - READ IN, PROCESS ; 15 Feb 2016  5:00 PM
  1.  ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**21,22,23**;JUN 11, 2001;Build 43
  1.  ;
  1.  K ^TMP("ACHSEOB",$J)
  1.  D NOW^ACHS
  1.  S ACHSTIME=$$C^XBFUNC(ACHSTIME,80)
  1.  ;ACHS*3.1*23 ADDED ACHSEDXT TO NXT LINE
  1.  S (ACHSEDXT,ACHSTERR,ACHSZRC,ACHSCTR,ACHSEFL9)=0,(ACHSOLD,ACHSZFLC)=""
  1.  ;
  1.  D ^ACHSEOBM                ;BUILD CHS EOBR ERROR MESSAGE FILE
  1.  ;
  1.  I $D(ACHSAEND) S ACHSTERR=1 Q
  1. MAIN ;
  1.  U IO
  1.  R ACHSEOBR:300   ;SAC-FILE READ
  1.  ;I 'ACHSISAO H 1  ;ACHS*3.1*23
  1.  U IO(0)
  1.  I ACHSEOBR="" S ACHSTERR=1 W !,"Unexpected End Of File!  This file is incomplete." G TERR
  1.  ;I ACHSISAO=1 S ACHSEOBR=$E(ACHSEOBR,3,85)  ;ACHS*3.1*21
  1.  I ACHSISAO S ACHSEOBR=$S($$OS^ACHS=2:$E(ACHSEOBR,1,82),1:$E(ACHSEOBR,3,85))   ;ACHS*3.1*21
  1.  ;
  1.  ;GO PRINT THE PROPER REPORT AND UPDATE DOCUMENT DEPENDING ON PARM
  1.  ;ACHS*3.1*22;IF ICD-9 FILE FIX GO TO ACHSEOB9
  1.  ;I ACHSEOBR=""!($E(ACHSEOBR,1,2)="**") D M1^ACHSEOBB D END Q  ;RETURNS ACHSTERR
  1.  I ACHSEOBR=""!($E(ACHSEOBR,1,2)="**") D @($S($P(ACHSMEDA,".",2)="ICD":"M1^ACHSEOB9",1:"M1^ACHSEOBB")) D END Q  ;RETURNS ACHSTERR
  1.  I ACHSOLD="" S ACHSOLD=$E(ACHSEOBR,1,18)
  1.  ;ACHS*3.1*22;IF ICD-9 FILE FIX GO TO ACHSEOB9
  1.  ;I ACHSOLD'=$E(ACHSEOBR,1,18) D M1^ACHSEOBB Q:ACHSTERR   ;QUIT IF SEQ ERROR
  1.  I ACHSOLD'=$E(ACHSEOBR,1,18) D @($S($P(ACHSMEDA,".",2)="ICD":"M1^ACHSEOB9",1:"M1^ACHSEOBB")) Q:ACHSTERR   ;QUIT IF SEQ ERROR
  1.  ;
  1.  ;
  1.  D REC^ACHSEOBB ;BEGIN PROCESS OF RECORDS INTO LOCAL ARRAYS ACHSEOBR(A-I
  1.  G TERR:ACHSTERR
  1.  ;
  1.  I ACHSZFLC=$E(ACHSEOBR,1,6) S ACHSZFLC=$E(ACHSEOBR,1,6) G WRITE
  1.  ;
  1.  S ACHSZZ=$E(ACHSEOBR,1,6)   ;ASUFAC CODE
  1.  ;CHECK LOCATION ASUFAC INDEX X-REF FOR IEN
  1.  S ACHSZFPT="",ACHSZFPT=$O(^AUTTLOC("C",ACHSZZ,ACHSZFPT)) ;GET AREA IEN
  1.  ;
  1.  ;
  1.  ;IF CANT FIND AREA IEN IN ASUFAC INDEX TRY ASUFAC CODE X-REF
  1.  I +ACHSZFPT=0 S ACHSZFPT="",ACHSZFPT=$O(^AUTTLOC("CTOO",ACHSZZ,""))
  1.  ;
  1.  S ACHSZ3=$E(ACHSEOBR,55,57) ;GET FINANCIAL LOCATION CODE
  1.  ;CHECK FINANCIAL LOCATION CODE X-REF FOR LOCATION IEN
  1.  S ACHSZPT3="",ACHSZPT3=$O(^AUTTLOC("FLC",ACHSZ3,ACHSZPT3))
  1.  ;
  1.  ;IF FINANCIAL LOCATION IEN >0 & FINANCIAL LOC. SAME AS DOC LOC. CONT
  1.  I +ACHSZPT3>0,ACHSZFPT=ACHSZPT3 G CONT
  1.  ;
  1.  ;IF FINACIAL CODE DEFINED BUT NOT SAME AS DOC USE DOC. LOCATION
  1.  I +ACHSZPT3>0 U IO(0) W !,"FACILITY CODE PROBLEM -- USING DOCUMENT LOCATION" S ACHSZFPT=ACHSZPT3 G CONT
  1.  ;IF DOC LOC NOT FOUND TRY USING FIANANCIAL LOC CODE LAST DITCH TRY
  1.  I 'ACHSZFPT S ACHSZFPT=$$FLC(ACHSZ3)
  1.  ;
  1.  ;IF STILL CANT FIND LOCATION QUIT THIS MUST BE FIXED 
  1.  I +ACHSZFPT=0 U IO(0) D  D TERR Q
  1.  .W *7,!!,"Invalid Facility Code ",$E(ACHSEOBR,1,6)," in EOBR Data."
  1.  .W !,"File ",$P(ACHSUFLS(+Y)," ")," contains a facility code that"
  1.  .W !,"cannot be found on the system -- JOB CANCELLED" S ACHSTERR=20
  1. CONT ;
  1.  ;GET INSTITUTION NAME
  1.  S ACHSZFNM=$P($G(^DIC(4,ACHSZFPT,0),"UNDEFINED"),U)
  1.  ;
  1.  U IO(0)
  1.  W !!?10,"Processing EOBR Data for: ",ACHSZFNM,!!
  1.  ;
  1.  S ACHSZFLC=$E(ACHSEOBR,1,6)   ;RESET TO FACILITY ASUFAC
  1.  ;
  1. WRITE ;
  1.  S ACHSCTR=ACHSCTR+1   ;INCREMENT COUNTER
  1.  ;
  1.  S ^ACHSEOBR(ACHSZFPT,ACHSCTR)=ACHSEOBR
  1.  ;
  1.  ;IF RECORD IS TYPE "H" SUMMARY RECORD
  1.  ;DO SUMM IF PRINT EOBR'S PARAMETER IS Y OR PRINT SUMM OPTION USED AND
  1.  ;PRINT CANCEL DOCUMENTS IS Y
  1.  I $E(ACHSEOBR,19)="H" D SUMM:$S(ACHSISAO:$$AOP^ACHS(2,6)="Y",1:$$PARM^ACHS(2,14)="Y")
  1.  ;ALL RECORD TYPES BUT "A" GO GET ANOTHER RECORD OTHERWISE KEEP COUNT
  1.  I $E(ACHSEOBR,19)'="A" G MAIN
  1.  ;
  1.  ;KEEP COUNT OF FACILITIES,TOTAL RECORD COUNT, AND WRITE USER FEEDBACK
  1.  S:'$D(ACHSZFCT(ACHSZFPT)) ACHSZFCT(ACHSZFPT)=0
  1.  S ACHSZFCT(ACHSZFPT)=ACHSZFCT(ACHSZFPT)+1
  1.  S ACHSCTR(1)=ACHSCTR
  1.  S ACHSZRC=ACHSZRC+1
  1.  I ACHSZRC#10=0 U IO(0) W $J(ACHSZRC,8)
  1.  F X="B","C","D","E","F","G","I","J" K ACHSEOBR(X)  ;ACHS*3.1*23
  1.  G MAIN
  1.  ;
  1. GBLD ;EP - Build ACHSEOBR("M") MESSAGE ARRAY from "F" records.
  1.  S:'$D(ACHSEOBR("M","ACHSMSEQ")) ACHSEOBR("M","ACHSMSEQ")=0
  1.  S ACHSMSG=""
  1.  ;
  1.  S:$D(ACHSEOBR("F",14)) ACHSMSG=ACHSEOBR("F",14) ;GET MESSAGE
  1.  Q:ACHSMSG=""!("RM"'[$E(ACHSMSG,1,1))          ;??????
  1.  S ACHSMSEQ=ACHSEOBR("M","ACHSMSEQ")+1  ;CAN WE COMBINE THIS AND NEXT LINE????
  1.  S ACHSEOBR("M","ACHSMSEQ")=ACHSMSEQ
  1.  S:'$D(ACHSEOBR("M","B",ACHSMSG)) ACHSEOBR("M",ACHSMSEQ)=ACHSMSG,ACHSEOBR("M","B",ACHSMSG)=""
  1.  Q
  1.  ;
  1. SIGN ;EP - Extract the Sign of the field from the last character in
  1.  ;     the field.
  1.  ;S Y=$E(ACHSEOBR,$P(X,".",3))
  1.  S Y=$E(ACHSREC,$P(X,".",3))
  1.  I "}JKLMNOPQR"[Y S ACHSREC=$E(ACHSREC,1,$P(X,".",2)-1)_"-"_$E(ACHSREC,$P(X,".",2)+1,$P(X,".",3)-1)_$S(Y="}":0,1:$C($A(Y)-25))_$E(ACHSREC,$P(X,".",3)+1,80) Q
  1.  I "{ABCDEFGHI"[Y S ACHSREC=$E(ACHSREC,1,$P(X,".",3)-1)_$S(Y="{":0,1:$C($A(Y)-16))_$E(ACHSREC,$P(X,".",3)+1,80)
  1.  Q
  1.  ;
  1. SUMM ;THIS IS THE SUMMARY
  1.  D REC1^ACHSEOBB
  1.  I ACHSEOIO'=IO S IOP=ACHSEOIO D ^%ZIS   ;ACHS*3.1*21
  1.  U ACHSEOIO
  1.  W @IOF,!!?24,"--- SUMMARY OF EOBR PROCESSED ---",!!,$$C^XBFUNC(ACHSTIME,80),!!!
  1.  ;
  1.  W ?5,"INDIAN HEALTH SERVICE",?40,"CONTRACT HEALTH SERVICES",!!,"AO: ",$S($G(ACHSEOBR("H",1))'="":$P(^AUTTAREA($O(^AUTTAREA("C",ACHSEOBR("H",1),0)),0),U),1:"UNDEFINED")
  1.  ;
  1.  W !!,"SU: "
  1.  I $G(ACHSEOBR("H",1))'="",($G(ACHSEOBR("H",2))'="") W $P(^AUTTSU($O(^AUTTSU("C",ACHSEOBR("H",1)_ACHSEOBR("H",2),0)),0),U)
  1.  E  W "INCOMPLETE INFORMATION TO FIND SERVICE UNIT"
  1.  ;
  1.  W !!!?23,"FISCAL YEAR:  ",$G(ACHSEOBR("H",4))
  1.  ;
  1.  W !!!!!?15,"AUTHORIZING FACILITY:  "
  1.  I $G(ACHSEOBR("H",8))'="" D
  1.  .S Y=$O(^AUTTLOC("C",ACHSEOBR("H",8)))
  1.  .I 'Y W "UNDEFINED" Q
  1.  .S Y=$P($G(^AUTTLOC(Y,0)),U,2)
  1.  .W $G(Y,"UNDEFINED"),!!
  1.  ;
  1.  W ?20,"PERIOD COVER(S):  "
  1.  I +$G(ACHSEOBR("H",9)) D
  1.  .W $$FMTE^XLFDT($S(+$E(ACHSEOBR("H",9),1,2)>50:2,1:3)_"000000"+ACHSEOBR("H",9))
  1.  ;
  1.  I +$G(ACHSEOBR("H",10)) W !?38,$$FMTE^XLFDT($S(+$E(ACHSEOBR("H",10),1,2)>50:2,1:3)_"000000"+ACHSEOBR("H",10))
  1.  ;
  1.  W !!?21,"TYPE 43 CLAIMS:",$J(+$G(ACHSEOBR("H",11)),13),!!?21,"TYPE 57 CLAIMS:",$J(+$G(ACHSEOBR("H",12)),13),!!?21,"TYPE 64 CLAIMS:",$J(+$G(ACHSEOBR("H",13)),13)
  1.  ;
  1.  W !!?18,"TOTAL OF PAYMENTS: $"
  1.  S X=$E($G(ACHSEOBR("H",14)),1,8)_"."_$E($G(ACHSEOBR("H",14)),9,10)
  1.  K X1,X2
  1.  D COMMA^%DTC
  1.  W X,!!," NET ADJ. OF PAYMENT VS. OBLIGATION: $"
  1.  S X=$E($G(ACHSEOBR("H",15)),1,8)_"."_$E($G(ACHSEOBR("H",15)),9,10)
  1.  D COMMA^%DTC
  1.  W X,@IOF
  1.  D HOME^%ZIS   ;ACHS*3.1*21
  1.  Q
  1.  ;
  1. END ;
  1.  I $G(ACHSZRC)>0 U IO(0) W !!,"Total EOBR Records Processed = ",ACHSZRC,!!
  1. KYL ; Close device, kill vars, quit.
  1.  I (IO(0)'=IO)!($D(IO("S"))) D ^%ZISC
  1.  I $D(ACHSEOIO),ACHSEOIO'=IO S IO=ACHSEOIO D ^%ZISC
  1.  D CLOSEALL^ACHS
  1.  K ACHSEOBR,ACHSEOIO,ACHSERRA,ACHSOLD,ACHSTIME,ACHSX
  1.  Q
  1.  ;
  1. ERR ;
  1.  U IO(0)
  1.  W *7,*7,!!,"AN ERROR HAS BEEN DETECTED IN THE",!,"FINANCE PARAMETERS OR DATA GLOBAL STRUCTURE.",!!,"PLEASE CONTACT YOUR SITEMANAGER FOR ASSISTANCE",!!
  1.  S X=$$DIR^XBDIR("E","Press <RETURN> To Continue....")
  1.  D KYL
  1.  Q
  1.  ;
  1. TERR ;
  1.  U IO(0)
  1.  W *7,!!,"EOBR PROCESSING ERROR.",!!,"Notify your supervisor.",!
  1.  I $G(ACHSTERR)=5 W !,"PROBLEM HINT AT NODE ^ACHSEOBR(""SEQ-ERROR"")=",$G(ACHSEOBR)," POSSIBLE CHAR 19 IN RECORD IMPROPER"
  1.  I $G(ACHSTERR)=10 W !,"IMPROPER RECORD TYPE - ",$E(ACHSEOBR,19)
  1.  I $G(ACHSTERR)=20 W !,"INVALID FACILITY CODE - ",$E(ACHSEOBR,1,6)
  1.  ;
  1.  ;
  1.  S X=$$DIR^XBDIR("E","Press <RETURN> To Continue....")
  1.  D END
  1.  Q
  1.  ;
  1. END1 ;EP.
  1.  U IO(0)
  1.  W !!,"No CHS EOBR Data Processed"
  1.  S X=$$DIR^XBDIR("E","Press <RETURN> To Continue....")
  1.  D KYL
  1.  Q
  1.  ;
  1. FLC(ACHSZ3) ;
  1.  ; Attempt to find Location based on FLC of EOBR.
  1.  ; The ASUFAC code for any given facility may have changed since
  1.  ;  the document left the facility, and the EOBR created.
  1.  ; Assume the ^AUTTLOC("FLC" x-ref has a bug, if you get this far,
  1.  ;  (that's why you got this far) and use the ^AUTTLOC("FL" x-ref
  1.  ;  and the single-character code from the AREA file.
  1.  ; Once the "FLC" x-ref is corrected, this code not needed.
  1.  ;
  1.  N X,Y
  1.  S (X,Y)=0
  1.  F  S X=$O(^AUTTLOC("FL",X)) Q:'$L(X)!Y  S Y=0 F  S Y=$O(^AUTTLOC("FL",X,Y)) Q:'Y  I Y,$P(^AUTTAREA($P(^AUTTLOC(Y,0),U,4),0),U,3)_$E(X,2,3)=ACHSZ3 Q
  1.  Q Y
  1.  ;