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

ACHSVAR.m

Go to the documentation of this file. 
  1. ACHSVAR ; IHS/ITSC/TPF/PMF - VARIABLES, OPTIONS ;     [ 06/15/2001  8:10 AM ]
  1.  ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**18,22,23,26**;JUN 11, 2001;Build 43
  1.  ;ACHS*3.1*18 7/16/2010;IHS/OIT/ABK;Change every occurrance of Deferred to Unmet Need
  1.  ;
  1.  ;this routine sets up certain basic vars for use in chs
  1.  ;expected input:    DUZ array
  1.  ;                   U
  1.  ;                   DT
  1.  ;
  1.  ;a partial list of the output:
  1.  ;ACHSACFY       the Active Current FY
  1.  ;ACHSCFY        the Current FY
  1.  ;ACHSERR        error flag default to off
  1.  ;ACHSFC
  1.  ;ACHSFYDT       the start of the nbext FY, i.e, 3001001
  1.  ;ACHSFYWK       the workbook
  1.  ;
  1.  ;
  1.  I $D(^ACHSUSE("EOBR")) D  Q:$D(XQUIT)
  1.  . S XQUIT=""
  1.  . W @IOF,!!!,*7,*7
  1.  . W $$C^XBFUNC("The global flag indicates EOBRs Are Now Being Processed"),!
  1.  . I '$D(^XUSEC("ACHSZMGR",DUZ)) W $$C^XBFUNC("Please Try Later"),!!!!!! D RTRN^ACHS Q
  1.  . S Y=$$DIR^XBDIR("Y","Do you want to delete the global flag and continue","N","","","^W !!,""You must enter 'Y' to delete the global flag, and provide access.""",1)
  1.  . Q:$D(DIRUT)!('Y)
  1.  . I Y D
  1.  .. S XQUIT="" F  S XQUIT=$O(^ACHSUSE(XQUIT)) Q:XQUIT=""  K ^ACHSUSE(XQUIT)
  1.  .. K XQUIT
  1.  .. Q
  1.  . Q
  1.  ;
  1.  ;ACHS*3.1*16 IHS.OIT.FCJ MODIFIED NXT LINE BECAUSE OF LENGTH
  1.  ;ACHS*3.1*22 IHS.OIT.FCJ ADDED TEST FOR AREA VAR
  1.  ;{ABK,7/16/10}I '$D(^ACHSF(DUZ(2),2)) D NOTSET("Node 2 of the 'CHS FACILITY' file is missing for this facility '$D(^ACHSF("_DUZ(2)_",2)). Editing this file via Fileman or use the 'Parameters' option in the CHS Denial/Deferred Services menu.")
  1.  I '$G(ACHSISAO),'$D(^ACHSF(DUZ(2),2)) D NOTSET("Node 2 of the 'CHS FACILITY' file is missing for this facility '$D(^ACHSF("_DUZ(2)_",2)). Editing this file via Fileman or use the 'Parameters' option in the CHS Denial/Unmet Need menu.")
  1.  ;
  1.  ;5/29/01   pmf  add check for ISAO
  1.  I $G(ACHSISAO) I $P($G(^ACHSAOP(DUZ(2),2)),U)="" D NOTSET("The 'EOBR IMPORT/SPLITOUT EXPORT' field of the 'CHS AREA OFFICE PARAMETERS' file must contain a directory pathname $P(^ACHSAOP("_DUZ(2)_",2),U)=NULL")
  1.  ;
  1.  ;ACHS*3.1*22 IHS.OIT.FCJ ADDED TEST FOR AREA VAR
  1.  D:'$G(ACHSISAO) OPTS
  1.  I '$D(ACHSY) G END
  1.  K ACHSY,ACHSCHSS
  1.  D ^ACHSUF
  1.  I $G(ACHSERR)=1 S XQUIT=1 G END
  1.  D VIDEO^ACHS
  1.  I $P($G(^AUTTLOC(DUZ(2),0)),U,4)'="" D
  1.  .I $E(($P($G(^AUTTAREA(($P(^AUTTLOC(DUZ(2),0),U,4)),0)),U,4)))'="J" D CANZ
  1.  Q
  1.  ;
  1. END ;
  1.  W *7
  1.  I $$DIR^XBDIR("E","Press RETURN...","","","","",2)
  1.  S ACHSXQT=1
  1.  Q
  1.  ;
  1. OPTS ;
  1.  ;
  1.  S ACHSY=""
  1.  F ACHS=2:1 Q:'$D(^DD(9002080,"GL",2,ACHS))  S ACHSY=$P($G(^ACHSF(DUZ(2),2)),U,ACHS)_ACHSY
  1.  I ACHSY]"" Q
  1.  D NOTSET("CHS Facility parameters not set")
  1.  Q
  1.  ;
  1. NOTSET(ACHSMSG) ;
  1.  D VIDEO^ACHS
  1.  W !!,*7,"The " W $G(IORVON) W "DENIAL" W $G(IORVOFF) W " parameters for this site have "
  1.  W $G(IORVON) W "not been properly set." W $G(IORVOFF)
  1.  W !!,$$C^ACHS(ACHSMSG)
  1.  W !!,"Print this screen to a printer."
  1.  W *7,!!,$G(IOBON),$G(IORVON),"Contact your site manager immediately!",$G(IOBOFF),$G(IORVOFF)
  1.  W !!,"Press RETURN..."
  1.  D READ^ACHSFU S ACHS("NOTSET")="",ACHSXQT=1
  1.  Q
  1.  ;
  1. CANZ ;
  1.  S ACHSXARA=$P($G(^AUTTLOC(DUZ(2),0)),U,4)
  1.  I ACHSXARA'="" S ACHSXPFX=$P($G(^AUTTAREA(ACHSXARA,0)),U,4),XCODE=$E(ACHSXPFX,1)
  1.  E  S (ACHSXPFX,XCODE)=""
  1.  G CAN2:XCODE="J"
  1.  W *7,!!,"CAN NUMBER PREFIXES ARE BEING PROCESSED.........."
  1.  D WAIT^DICD
  1.  F R=0:0 S R=$O(^ACHS(2,R)) W "." Q:'R  I $P($G(^ACHS(2,R,0)),U,3)=DUZ(2) D
  1.  . S ACHSXX=$P($G(^ACHS(2,R,0)),U),ACHSX3=$E(ACHSXX,1,3),ACHSX4=$E(ACHSXX,4,7) K ^ACHS(2,"B",ACHSXX,R) S ACHSX3="J"_$E(ACHSX3,2,3)
  1.  . S $P(^ACHS(2,R,0),U)=ACHSX3_ACHSX4,^ACHS(2,"B",ACHSX3_ACHSX4,R)=""
  1.  .Q
  1.  S $P(^AUTTAREA(ACHSXARA,0),U,4)="J"_$E(ACHSXPFX,2,3)
  1. CAN2 ;
  1.  K R,X,ACHSXARA,ACHSXPFX,XCODE,ACHSXX,ACHSX3,ACHSX4
  1.  Q
  1.  ;
  1. MGR ;EP - If options not set, user has mgr key, enter the options.
  1.  I '$D(^XUSEC("ACHSZMGR",DUZ)) Q
  1.  S ACHSSITE=$P($G(^DIC(4,DUZ(2),0)),U)
  1.  D OPTIONS
  1.  K ACHSSITE
  1.  I $D(^ACHSF(DUZ(2),2)),$L(^(2)) S ACHSY=""
  1.  Q
  1.  ;
  1. OPTIONS ;
  1.  N DA,DIC,DIE,DR,DLAYGO
  1.  W !!!,"Edit the CHS facility options for '",ACHSSITE,"'.",!!,"1 question mark (""?"") will get you help.",!!,"2 question marks (""??"") usually gets you more help.",!!
  1.  W "For printed help, print out chapter 1 of the Tech Manual (D ^ACHSTM).",!
  1.  ;ACHS*3.1*16 11.12.2009 IHS.OIT.FCJ ADDED DUNS TO NXT LINE;ACHS*3.1*23 REM EOBR PRINT;3.1*26-ADD FILE DIRECTORY
  1.  S DIE="^ACHSF(",DR="11.03;11.05:14.08;14.11:14.13;14.15:14.18;14.2;14.22;14.24:14.27;14.31;.05",DA=DUZ(2)
  1.  D ^DIE
  1.  Q:$P($G(^ACHSF(DUZ(2),0)),U,8)'="Y"  ; Quit if not a 638 facility.
  1.  S DR="11.04;14.09"
  1.  D ^DIE
  1.  I $P($G(^ACHSF(DUZ(2),0)),U,6),$P($G(^(0)),U,7) Q
  1.  W *7,!!,"THE NEXT 2 PARAMETERS DETERMINE WHEN YOUR FISCAL YEAR STARTS.",!!,"IF YOU HAVE ANY DOUBTS ABOUT HOW TO ANSWER THE QUESTIONS, PLEASE CALL",!!,"DSD AT 999-999-9999 AND ASK FOR THE CHS DEVELOPER.",!
  1.  S DR="11.01;11.02"
  1.  D ^DIE
  1.  Q
  1.  ;
  1. FY(%) ;EP - Given a FY, return beg/end dates.
  1.  N X,Y
  1.  S X=$P($G(^ACHSF(DUZ(2),0)),U,6),Y=+$P($G(^(0)),U,7)
  1.  S %=$S(%>50:2,1:3)_%-Y
  1.  S X=%_X
  1.  S %=$E(X,1,3)
  1.  S Y=%+$S($E(X,4,7)="0101":0,1:1) ; Year
  1.  S %=$E(X,4,5) I $E(X,6,7)="01" S %=%-1 I '% S %=12
  1.  S %="0"_%,%=$E(%,$L(%)-1,$L(%)) ; Month
  1.  S Y=$E(Y,1,3)_%_$P("31^28^31^30^31^30^31^31^30^31^30^31",U,%) ; Day
  1.  I $E(Y,4,5)="02",'((1700+$E(Y,1,3))#4) S Y=$E(Y,1,5)_"29"
  1.  I $E(X,4,5)=$E(Y,4,5) S %=$E(X,6,7),%=%-1,%="0"_%,%=$E(%,$L(%)-1,$L(%)),Y=$E(Y,1,5)_%
  1.  Q X_U_Y
  1.  ;