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

ACHSUF.m

Go to the documentation of this file. 
  1. ACHSUF ; IHS/ITSC/PMF - SET CHS FACILITY VARS, CHECK DATA INTEGRITY ;   [ 10/16/2001   8:16 AM ]
  1.  ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
  1.  ;
  1.  I $D(ACHSCHSS) S ACHSCHSS="V"
  1.  E  S ACHSCHSS=""
  1.  I '$D(^ACHS(9,DUZ(2),"CHK")) S ^ACHS(9,DUZ(2),"CHK")=""
  1.  D FC
  1.  I $D(ACHSERR),ACHSERR=1 G K
  1.  D C0SUB
  1.  I $D(ACHSERR),ACHSERR=1 G GLOBERR
  1.  G ERR:'$D(^ACHS(9,DUZ(2),0))
  1.  D FY
  1.  G S16:'$D(ACHSFYWK(DUZ(2),ACHSCFY))
  1.  S ACHSACWK=ACHSFYWK(DUZ(2),ACHSCFY)
  1.  I ACHSACWK=0,'$D(^ACHS(9,DUZ(2),"FY",ACHSACFY,0)) G S16
  1.  I $D(^ACHS(9,DUZ(2),"FY",ACHSACFY,"W",ACHSACWK,0)) S ACHS("ZL")=$P(^(0),U,2) G END:ACHS("ZL")="",S15:+ACHS("ZL")'<DT!(+ACHS("ZL")=DT)
  1.  I ACHSACWK,$D(^ACHS(9,DUZ(2),"FY",ACHSACFY,"W",ACHSACWK,0)) S ACHS("ZL")=$P(^(0),U,2) G END:ACHS("ZL")="",S15:ACHS("ZL")'<DT!(+ACHS("ZL")=DT)
  1.  ;
  1.  G END:$D(^ACHS(9,DUZ(2),"FY",ACHSACFY,"W",ACHSACWK+1,0))
  1.  G S17:'$D(^ACHS(9,DUZ(2),"FY",ACHSACFY,"W",ACHSACWK,1))
  1.  ;
  1. INIT ;EP
  1.  S R=0
  1.  I '$$LOCK^ACHS("^ACHS(9,DUZ(2))","+") W !,"LOCK FAILED AT INIT+2^ACHSUF" S ACHSERR=10 Q
  1. I1 ;
  1.  S R=$O(ACHSFYWK(DUZ(2),R))
  1.  G INITEND:+R=0
  1.  S X=+ACHSFYWK(DUZ(2),R),ACHSXX=$G(^ACHS(9,DUZ(2),"FY",R,"W",X,1))
  1.  S ^ACHS(9,DUZ(2),"FY",R,"W",X+1,0)=X+1
  1.  S ^ACHS(9,DUZ(2),"FY",R,"W",X+1,1)=ACHSXX
  1.  S $P(^ACHS(9,DUZ(2),"FY",R,"W",0),U,4)=$P(^ACHS(9,DUZ(2),"FY",R,"W",0),U,4)+1,$P(^(0),U,3)=X+1
  1.  G I1
  1.  ;
  1. INITEND ;
  1.  I '$$LOCK^ACHS("^ACHS(9,DUZ(2))","-")
  1. END ;
  1.  S ACHSERR=0
  1.  K ACHSGCHK
  1.  D C0SUB
  1.  G GLOBERR:ACHSERR>0
  1.  S ^ACHS(9,DUZ(2),"CHK")=DT
  1. K ;
  1.  K ACHS("FYX"),ACHS("ZL"),ACHSACWK,ACHSCHSS,ACHSXX
  1.  Q
  1.  ;
  1. ERR ;
  1.  W:'$D(ACHSISAO) *7,!!,"  The Parameters For This Facility Are Incomplete"
  1. ERR1 ;
  1.  S ACHSERR=1
  1.  W:'$D(ACHSISAO) !!?15,"PLEASE CONTACT YOUR SITE MANAGER FOR ASSISTANCE",!
  1.  G K
  1.  ;
  1. INERR ;
  1.  W:'$D(ACHSISAO) *7,!!,"  THE PARAMETER FILE FOR THIS FACILITY HAS NOT BEEN INITIALIZED,",!
  1.  G ERR1
  1.  ;
  1. FNCDERR ;
  1.  W:'$D(ACHSISAO) *7,!!?10,"THE FINANCE PARAMETERS FOR THIS FACILITY ARE INCOMPLETE,",!
  1.  G ERR1
  1.  ;
  1. GLOBERR ;EP.
  1.  W:'$D(ACHSISAO) *7,!!,"  AN ERROR HAS BEEN DETECTED IN GLOBAL STRUCTURE OF 'CHS DATA CONTROL' FILE"
  1.  G ERR1
  1.  ;
  1. S15 ;
  1.  W:ACHSCHSS'="V"&('$D(ACHSISAO)) !!,"The Control Register Has Been CLOSED For This Date"
  1.  G S18
  1.  ;
  1. S16 ;
  1.  Q:$D(ACHS("SETNEW"))
  1.  Q:$D(ACHSISAO)
  1.  U IO(0)
  1.  W *7,*7,!!!,"THE CHS SYSTEM HAS NOT BEEN INITIALIZED FOR THE CURRENT FISCAL YEAR",!!
  1.  S Y=$$DIR^XBDIR("Y","SHALL I SET IT UP FOR YOU NOW","NO","","","^D HELP^ACHS(""H"",""ACHSUF"")")
  1.  I $D(DUOUT)!$D(DTOUT)!('Y) S ACHSERR=1 G K
  1.  S ACHS("YR")=ACHSACFY,ACHSAUTO=""
  1.  W !!,"SETTING UP NEW FISCAL YEAR.  PLEASE WAIT........"
  1.  D AUTO^ACHSNEW
  1.  I $D(ACHSERR),ACHSERR=1 G ERR1
  1.  D C0SUB
  1.  U IO(0)
  1.  W *7,*7,!!,"A NEW FISCAL YEAR "_ACHSCFY_" HAS BEEN SET UP.",!,"PLEASE NOTIFY THE CONTRACT HEALTH MANAGER.",!
  1.  I $$DIR^XBDIR("E","Press RETURN...")
  1.  Q
  1.  ;
  1. S17 ;
  1.  U IO(0)
  1.  W:'$D(ACHSISAO) !!,"SYSTEM ERROR"
  1. S18 ;
  1.  W:ACHSCHSS'="V"&('$D(ACHSISAO)) *7,!!
  1.  G END
  1.  ;
  1. C0SUB ;EP - Ensure the number of registers agree with 0th node.
  1.  ; Set the ACHSFYWK array.
  1.  ; ACHSRX is Fiscal Year.  ACHSRXX is Register (DCR) number.
  1.  I ^ACHS(9,DUZ(2),"CHK")=DT D WK Q
  1.  S (ACHSRX,ACHSRXX)=0
  1. C1 ;
  1.  S ACHSRX=$O(^ACHS(9,DUZ(2),"FY",ACHSRX))
  1.  G C1:ACHSRX=0,CEND:+ACHSRX=0
  1.  S (ACHSRXX,ACHSTCNT)=0
  1.  S ACHSSRXX=""
  1. C2 ;
  1.  F ACHS=0:0 S ACHSRXX=$O(^ACHS(9,DUZ(2),"FY",ACHSRX,"W",ACHSRXX)) Q:+ACHSRXX=0  S ACHSFYWK(DUZ(2),ACHSRX)=ACHSRXX,ACHSTCNT=ACHSTCNT+1,ACHSSRXX=ACHSRXX,ACHS("FYX")=ACHSRX
  1. C3 ;
  1.  I '$D(^ACHS(9,DUZ(2),"FY",ACHSRX,"W")) S ACHSERR=1 G CEND
  1.  I ACHSTCNT'=$P(^ACHS(9,DUZ(2),"FY",ACHSRX,"W",0),U,4) S ACHSERR=1
  1.  I ACHSSRXX'=$P(^ACHS(9,DUZ(2),"FY",ACHSRX,"W",0),U,3) S ACHSERR=1
  1.  G C1
  1.  ;
  1. CEND ;
  1.  K ACHSTCNT,ACHSRX,ACHSRXX,ACHSSRXX
  1.  Q
  1.  ;
  1. FY ;EP - Set FY and Current FY.
  1.  S ACHSACFY=$E(DT,1,3)
  1.  ;
  1.  ; IHS facilities FY start date is Oct 1.
  1.  I $P(^ACHSF(DUZ(2),0),U,8)'="Y" S $P(^ACHSF(DUZ(2),0),U,6)="1001",$P(^ACHSF(DUZ(2),0),U,7)=1
  1.  ;
  1.  ; 638 facilities not having FY start date will default to Oct 1.
  1.  I '$P(^ACHSF(DUZ(2),0),U,6) S $P(^(0),U,6)="1001",$P(^(0),U,7)=1
  1.  ;
  1.  ; Calculate when the next FY starts.
  1.  S ACHSFYDT=$E(DT,1,3)_$P($G(^ACHSF(DUZ(2),0)),U,6)
  1.  I $E(DT,4,7)>($E(ACHSFYDT,4,7)-1) S ACHSFYDT=ACHSFYDT+10000
  1.  ;
  1.  ; Check if today is after FY start date, adjust with parameter.
  1.  I $E(DT,4,7)>($P($G(^ACHSF(DUZ(2),0)),U,6)-1) S ACHSACFY=ACHSACFY+$P($G(^(0)),U,7)
  1.  ; Some 638 facilities do not start FY until after the CY starts.
  1.  I $E(DT,4,7)<($P($G(^ACHSF(DUZ(2),0)),U,6)),'$P($G(^(0)),U,7) S ACHSACFY=ACHSACFY-1
  1.  S ACHSACFY=ACHSACFY+1700,ACHSCFY=ACHSACFY
  1.  Q
  1.  ;
  1. FC ;EP - Set Finance Code.
  1.  K ACHSERR
  1.  S ACHSFC=$P($G(^AUTTLOC(DUZ(2),0)),U,17)
  1.  I $L(ACHSFC)'=3 G FNCDERR
  1.  S ACHSFC=$P($G(^AUTTAREA($P($G(^AUTTLOC(DUZ(2),0)),U,4),0)),U,3)_$E(ACHSFC,2,3)
  1.  Q
  1.  ;
  1. WK ;SET ACHSFYWK ARRAY
  1.  S ACHSRX=0
  1. WK1 ;
  1.  S ACHSRX=$O(^ACHS(9,DUZ(2),"FY",ACHSRX))
  1.  G WK1:ACHSRX=0
  1.  I +ACHSRX=0 K ACHSRX Q
  1.  S ACHSFYWK(DUZ(2),ACHSRX)=$P($G(^ACHS(9,DUZ(2),"FY",ACHSRX,"W",0)),U,3)
  1.  G WK1
  1.  Q
  1.  ;
  1. H ;EP - From DIR via HELP^ACHS().
  1.  ;;@;!,"IF YOU ANSWER 'Y' OR 'YES' A NEW FISCAL YEAR ENTRY WILL BE CREATED."
  1.  ;;@;!,"IF YOU ANSWER 'N' OR 'NO' YOU WILL EXIT BACK TO THE MENU."
  1.  ;;@;!,"IF YOU HAVE QUESTIONS PLEASE CONTACT YOUR CONTRACT HEALTH MANAGER.",!
  1.  ;;@;$S($$DIR^XBDIR("E","Press <RETURN> To Continue...."):"",1:"")
  1.  ;;###
  1.  ;