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

ACHSEOB.m

Go to the documentation of this file. 
  1. ACHSEOB ;IHS/ITSC/PMF - PROCESS EOBRS (1/6) - READ IN, PROCESS ; 22 Feb 2016  11:50 AM
  1.  ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**5,6,21,22,23**;JUNE 11, 2001;Build 43
  1.  ;IHS/SET/GTH ACHS*3.1*5 12/06/2002 - Remove $ETRAP; direct ref to ^%ZIS(1.
  1.  ;IHS/SET/JVK ACHS*3.1*6 4/9/2003 - CHECK FOR ACTIVE CHS JOBS
  1.  ;Why do some of our errors record and others do not?  The
  1.  ;ACHS routines do not set $ZT or $ETRAP, nor do our options,
  1.  ;but sometimes the error trapping program ^%ZTER gets run
  1.  ;and sometimes not.
  1.  ;
  1.  ;Until now.  This is the first set of $etrap within these
  1.  ;routines.    2/28/01    pmf
  1.  ;S $ETRAP="D ERR^ZU Q:$QUIT 0 Q";IHS/SET/GTH ACHS*3.1*5 12/06/2002
  1.  ;
  1.  I $G(ACHSISAO) G A3        ;IF IS AREA OFFICE SKIP REGISTER CHECK
  1.  ;
  1.  I $D(^ACHS(9,DUZ(2),"FY",ACHSCFY,"W",+ACHSFYWK(DUZ(2),ACHSCFY),0)),+$P(^(0),U,2)>0 W *7,!?10,"CHS Registers are Closed -- EOBR Posting CANCELLED",! D RTRN^ACHS G ENDX
  1.  ;
  1. A3 ;
  1.  ;IF IS AREA OFFICE USE 'PRINT CANCEL DOCUMENTS'
  1.  ;OTHERWISE USE 'PRINT EOBRS'
  1.  ;ACHS*3.1*22  FACILITY PAR DOES NOT WORK SHOULD ALWAYS BE NO
  1.  ;S ACHSPAR=$S(ACHSISAO=0:$$PARM^ACHS(2,14),ACHSISAO=1:$$AOP^ACHS(2,6))
  1.  S ACHSPAR=$S(ACHSISAO=0:"N",ACHSISAO=1:$$AOP^ACHS(2,6))
  1.  ;
  1. A3A ;
  1.  W !!,"Your PRINT EOBR parameter is: ",ACHSPAR,"."
  1.  I ACHSISAO,ACHSPAR="Y" W ! S %ZIS("A")="Print EOBRs on what device:" D ^%ZIS I POP D HOME^%ZIS G ENDX
  1.  ;
  1.  S ACHSEOIO=IO
  1.  ;
  1.  ;IF NOT IS AREA OFFICE RESET TO 'UPDATE DOCUMENT FROM EOBR'
  1.  S ACHSPAR=$S('ACHSISAO:$$PARM^ACHS(2,15),ACHSISAO=1:"")
  1.  I 'ACHSISAO W !!,"Your UPDATE DOCUMENT FROM EOBR parameter is :  ",ACHSPAR,".",!  ;ACHS*3.1*21 ADDED TEST FOR AREA
  1.  ;
  1.  ;GET THE LAST EOBR FILE SEQ. NUMBER
  1.  S ACHSFCSQ=+$P($G(^ACHSF(DUZ(2),2)),U,21)
  1.  ;
  1. S0 ;
  1.  ;IF THERE IS A WORK GLOBAL THERE WARN
  1.  I '$O(^ACHSEOBR("0"))!('ACHSISAO) G S1
  1.  W *7,!!,"The '^ACHSEOBR(' work global is about to be killed.",!!,"Are you sure previously processed EOBRs were sent to your facilities",!,"via the EOBR OUT Area option?"
  1.  S Y=$$DIR^XBDIR("Y","","N")
  1.  ;ACHS*3.1*22; REMOVED ACHSAEND="" FRM NEXT LINE
  1.  I $D(DUOUT)!$D(DTOUT)!('Y) S ACHSISAC=1 D ENDX Q  ;ACHS*3.1*21 ADDED ACHSISAC AND ACHSAEND
  1. S1 ;
  1.  W !
  1.  ;
  1.  ;IF IS AREA OFFICE GO ON TO PRESENT MENU OF WHAT REPORTS YOU WANT
  1.  I ACHSISAO D REPORT^ACHSEOB0 G ENDX:$D(DUOUT)!$D(DTOUT)!$D(DIRUT),S2
  1.  ;
  1.  S %ZIS="OPQ",%ZIS("A")="SELECT PRINTER FOR PROCESSING REPORT AND EOBR'S:"   ;ACHS*3.1*21 ADDED "AND EOBR'S"
  1.  D ^%ZIS
  1.  S:$D(IO("Q")) ACHSIO("Q")=IO("Q")
  1.  I POP D HOME^%ZIS G ENDX
  1.  S ACHSEOIO=IO   ;ACHS*3.1*21
  1.  ;I ^%ZIS(1,IOS,"TYPE")="HFS",$L($G(IOPAR)) S ZTIO("IOPAR")=IOPAR;IHS/SET/GTH ACHS*3.1*5 12/06/2002
  1.  I $$GET1^DIQ(3.5,IOS,2)="HFS",$L($G(IOPAR)) S ZTIO("IOPAR")=IOPAR ;IHS/SET/GTH ACHS*3.1*5 12/06/2002
  1.  S ACHSERPT="D",ZTIO=ION_";"_IOST_";"_IOM_";"_IOSL
  1.  D HOME^%ZIS
  1.  U IO
  1.  ;
  1. S2 ;
  1.  I 'ACHSISAO S ACHSMEDY="F",ACHSMEDA="EB"_$$ASF^ACHS(DUZ(2))_"." G SUF
  1.  S ACHSMEDY="F",ACHSAEND=""
  1.  ;
  1.  D ^ACHSEOBS                       ;ALLOW SELECTION OF EOBR FILE TO
  1.                                    ;PROCESS FOR AREA
  1.  G ABEND:ACHSAEND=1,ENDX:ACHSAEND=2
  1.  K ACHSAEND
  1.  G CONT1
  1.  ;
  1. SUF ;
  1.  D FACSRCH^ACHSEOBB          ;GETS LISTING OF FILES AVAILABLE THIS SITE
  1.  U IO(0)
  1.  I '$O(ACHSUFLS(0)) W !!,*7,"No EOBR Files Available for Processing",! D RTRN^ACHS G ENDX
  1.  S Y=$$DIR^XBDIR("NO^1:"_$O(ACHSUFLS(9999),-1)_":3","Enter the Number of the Facility EOBR File you want to Process","","","","",1)
  1.  G ENDX:$D(DUOUT)!($D(DIRUT))!('Y)
  1.  ;CHECK LAST EOBR FILE SEQ. NUMBER
  1.  S ACHSEOSQ=+$$PARM^ACHS(2,21)
  1.  ;
  1.  I +ACHSEOSQ=0 G SEQOK
  1.  ;
  1.  ;RESET SEQ #  ;ACHS*3.1*21 SET TO "" INSTEAD OF 0 IN NEXT LINE
  1.  I +ACHSEOSQ=999 S $P(^ACHSF(DUZ(2),2),U,21)=""
  1.  ;
  1.  ;LAST EOBR FILE SEQ. NUMBER MUST BE ONE LESS THAN THAT FOUND IN THE
  1.  ;FILE TO BE PROCESSED. LOOK AT SECOND LINE OF unix file EB*.JJJ P^2
  1.  ;ACHS*3.1*23 MULT CHANGE IN NXT SECTION TO ALLOW REPROCESSING OF FILE
  1.  S ACHSREP=0
  1.  I ACHSEOSQ+1=+$P(ACHSUFLS(ACHSK(Y))," ",3) G SEQOK
  1.  U IO(0)
  1.  ;W !!,*7,$G(IORVON),"Sequence numbers are out of sequence!",$G(IORVOFF)
  1.  W !!,*7,$G(IORVON),"FILE selected is out of sequence!",$G(IORVOFF)
  1.  ;ACHS*3.1*21 REMOVED REF TO UNIX
  1.  W !!,"Current EOBR file selected: "
  1.  W $P(ACHSUFLS(ACHSK(Y))," ")," file is ",+$P(ACHSUFLS(ACHSK(Y))," ",3)
  1.  ;W !!,"Last sequence number found in CHS FACILITY file is ",ACHSEOSQ
  1.  W !!,"Last sequence number processed in CHS FACILITY file is ",ACHSEOSQ
  1.  ;W !,"If you wish to re-process this global"
  1.  ;W !,"call the Help desk at 999-999-9999"
  1.  W !!
  1.  I +$P(ACHSUFLS(ACHSK(Y))," ",3)<(ACHSEOSQ+1) D  G:+ACHSREP>0 CONT
  1.  .W !,"This file has already been processed."
  1.  .NEW Y S ACHSREP=$$DIR^XBDIR("Y","Do you wish to reprocess the file","N") NEW
  1.  ;ACHS*3.1*23 END CHANGES
  1.  G ENDX:$$DIR^XBDIR("E"),SUF
  1. SEQOK ;
  1.  S ACHSEOBD=$P(ACHSUFLS(ACHSK(Y))," ",2)
  1.  S ACHSSEQN=+$P(ACHSUFLS(ACHSK(Y))," ",3)
  1. SEQOK1 ;
  1.  ;CLEAR THIS X-REF DATE OUT IF YOU WANT TO REPROCESS A FILE
  1.  ;ALSO SET THE SEQUENCE NUMBER AT ^ACHSF(DUZ(2),2),U,21) TO -1
  1.  ;OF THE ONE FOUND IN THE FILE ITSELF
  1.  ;ACHS*3.1*22 ADDED E TEST FOR CONT WITH PROC THE FI-ICD-9 FILE
  1.  ;I '$D(^ACHSF(DUZ(2),17,"B",ACHSEOBD)) G CONT
  1.  I '$D(^ACHSF(DUZ(2),17,"B",ACHSEOBD)) G CONT
  1.  E  G:ACHSUFLS(ACHSK(Y))["ICD" 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.  D CLOSEALL^ACHS
  1.  G SUF
  1.  ;
  1. CONT ;
  1.  ;
  1.  S ACHSMEDA=$P(ACHSUFLS(ACHSK(Y))," ",1)
  1.  S Y=$$DIR^XBDIR("Y","Process file '"_$$IM^ACHS_ACHSMEDA_"' (Y/N)","N","","","",1)
  1.  G ENDX:+Y=0!($D(DUOUT))!($D(DIRUT))!($D(DTOUT))
  1. CONT1 ;
  1.  ;
  1.  ;IF WE ENTERED FROM OPTION 'ACHSFEOBR' AND FIELD 'UPDATE DOCUMENT FROM
  1.  ;EOBR' = YES
  1.  ;THE IF DO BELOW IS TRYING TO ENSURE THAT DOCUMENTS ARE NOT BEING
  1.  ;UPDATED BY MENU OPTIONS AT THE SAME TIME THIS EOBR PROCESSING IS
  1.  ;UPDATING DOCUMENTS AS WELL. IS IT  LOCKING AT THE APPROPRIATE
  1.  ;TIME???????
  1.  ;IHS/SET/JVK ACHS*3.1*5 CHANGED LINE BELOW TO CHECK FOR ACTIVE CHS JOBS
  1.  ;I 'ACHSISAO,$$PARM^ACHS(2,15)="Y" D  G:'Y ENDX
  1.  I 'ACHSISAO,$$PARM^ACHS(2,15)="Y",$$E^ACHSJCHK("ACHS") D  G:'Y ENDX
  1.  . U IO(0)
  1.  . W !!!!,*7,$$C^XBFUNC("The compiled menu indicates CHS Users are Active -- EOBR'S CANNOT BE POSTED")
  1.  . W !!,$$C^XBFUNC("You can Exercise the"),!,$$C^XBFUNC("'Clean old Job Nodes in XUTL'"),!
  1.  . W $$C^XBFUNC("option (usually) on the site mgr's menu and try again."),!!
  1.  . S DIR(0)="Y",DIR("A")="OR, if you're sure no CHS users are active, you can continue",DIR("B")="N",DIR("?")="You must enter 'Y' to continue."
  1.  . D ^DIR
  1.  . K DIR
  1.  ;ACHS*3.1*23 NEW LINE TO LOCK FILE
  1.  I 'ACHSISAO,'$$LOCK^ACHS("^ACHSF(DUZ(2),""D"")","+") W !!,"CHS file lock failed, make sure all CHS user's are logged off." G ENDX
  1.  S ^ACHSUSE("EOBR")=""         ;SET THE EOBR IN USE GLOBAL FLAG
  1.  ;12/27/00 pmf  change direct kill of work global
  1.  S ^ACHSEOBR="" F  S ^ACHSEOBR=$O(^ACHSEOBR(^ACHSEOBR)) Q:^ACHSEOBR=""  K ^ACHSEOBR(^ACHSEOBR)
  1.  S ^ACHSEOBR("0")="",(ACHSCTR,ACHSCTR(1))=0
  1.  ;
  1.  ;FIND
  1.  I $$OPEN^%ZISH($S(ACHSISAO:$$AOP^ACHS(2,1),1:$$IM^ACHS),ACHSMEDA,"R") S ACHSEMSG="M10" D ERROR^ACHSTCK1 G ENDX    ;M10 OPEN FAILURE ON HFS FILE
  1.  I 'ACHSISAO D SAVDCR("B")
  1.  U IO(0)
  1.  W !
  1. RDHDR ;EP
  1.  D ^ACHSEOB1                             ;READ IN FILE TO PROCESS
  1.  G:ACHSTERR ABEND
  1.  I ACHSISAO D AREA^ACHSEOBB G XIT        ;IS AREA OFFICE
  1.  ;I 'ACHSISAO D FAC^ACHSEOBB,SAVDCR("E")  ;NOT AREA OFFICE ;ACHS*23
  1.  I 'ACHSISAO D:$G(ACHSREP)<1 FAC^ACHSEOBB D SAVDCR("E")  ;NOT AREA OFFICE  ;ACHS*23
  1.  ;
  1. XIT ;
  1.  S ACHSRPT=2
  1.  I ACHSISAO S ACHSRPT=1
  1.  G ENDX:ACHSERPT="N"
  1.  ;
  1.  ;IS THERE A SUMMARY REPORT?
  1.  I ACHSERPT="S" D REPORT^ACHSEOBC G:ACHSERR ABEND D HOME^%ZIS U IO G ENDX
  1.  ;
  1.  ;DO ERROR REPORT
  1.  I '$D(ACHSIO("Q")) S (ACHSEOIO,IOP)=ZTIO S:$L($G(ZTIO("IOPAR"))) %ZIS("IOPAR")=ZTIO("IOPAR") K ZTIO D ^%ZIS,START^ACHSEOB6,HOME^%ZIS U IO G ENDX
  1.  ;
  1.  S %DT="R",X="NOW"
  1.  D ^%DT
  1.  S ZTDTH=Y+.0002
  1.  S:$L($G(ZTIO("IOPAR"))) IOPAR=ZTIO("IOPAR")
  1.  S ZTRTN="START^ACHSEOB6",ZTDESC="CHS EOBR Processing Report, for "_$P(^AUTTLOC(DUZ(2),0),U,2)_"."
  1.  F %="ACHSRPT","ACHSEOBD","ACHSISAO" S ZTSAVE(%)=""
  1.  D ^%ZTLOAD
  1.  G:'$D(ZTSK) ABEND
  1. ENDX ;EP
  1.  ;ACHS*3.1*21
  1.  S IONOFF=""
  1.  ;ACHS*3.1*23 NEW LINE TO LOCK FILE
  1.  I 'ACHSISAO,'$$LOCK^ACHS("^ACHSF(DUZ(2),""D"")","-") W !,"Unlock of CHS Global failed, log out of CHS"
  1.  D CLOSEALL^ACHS,KILL^ACHSEOBB
  1.  K DIR,CONT
  1.  W !!
  1.  D RTRN^ACHS
  1.  I ACHSISAO,'$D(ACHSAEND),$G(ACHSISAC) D ^ACHSEOB8 ;ACHS*3.1*21
  1.  Q
  1.  ;
  1. ABEND ;EP
  1.  G ENDX
  1.  ;
  1. SAVDCR(S) ;EP - Save DCR amounts for EOB Summary Report
  1.  ; S = "B" for begin values, "E" for end values.
  1.  N Y
  1.  S Y=0
  1.  F  S Y=$O(ACHSFYWK(DUZ(2),Y)) Q:'Y  S ^ACHSEOBR("DCR",Y,S)=$G(^ACHS(9,DUZ(2),"FY",Y,"W",ACHSFYWK(DUZ(2),Y),1))
  1.  Q
  1.  ;