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

ACHSNEW.m

Go to the documentation of this file. 
  1. ACHSNEW ; IHS/ITSC/PMF - SET UP A NEW FISCAL YEAR FOR A FACILITY ;   [ 10/16/2001   8:16 AM ]
  1.  ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
  1.  ;
  1.  S ACHS("SETNEW")=""
  1.  D ^ACHSVAR
  1.  I $D(ACHSXQT) G K
  1.  D FY^ACHSUF,C0SUB^ACHSUF
  1.  I $D(ACHSERR),ACHSERR=1 G GLOBERR^ACHSUF
  1.  S ACHS("FYX")=$O(ACHSFYWK(DUZ(2),9999),-1)
  1.  S ACHS("ACWKX")=ACHSFYWK(DUZ(2),ACHS("FYX"))
  1.  G GLOBERR^ACHSUF:'$D(^ACHS(9,DUZ(2),"FY",ACHS("FYX"),"W",ACHS("ACWKX")))
  1. BD ;
  1.  W !!,"Which fiscal year? ("
  1.  S ACHS("YR")=1700+$E(DT,1,3)
  1.  W ACHS("YR")-2," to ",ACHS("YR")+1,") "
  1.  D READ^ACHSFU
  1.  G K:$D(DTOUT)!$D(DUOUT)!(Y="")
  1.  I $L(Y)'=4!(+Y>(ACHS("YR")+1))!(+Y<(ACHS("YR")-2)) W !!,"Enter a four-digit fiscal year - see listed examples." D SB1^ACHSFU G BD
  1.  S ACHS("YR")=+Y
  1.  I $D(^ACHS(9,DUZ(2),"FY",ACHS("YR"))) W *7,!!,"This fiscal year is already on file and cannot be reset.",!! G BD
  1.  I $E($O(^ACHSF(DUZ(2),"D","B","1"_$E(ACHS("YR"),4)_"00000")),2)=$E(ACHS("YR"),4) D  G BD
  1.  . W *7,!!,"P.O.s still exist for FY ",ACHS("YR")-10," that will interfere with ",ACHS("YR")," P.O. entry.",!,"Use the ^ACHSYFYD programmer utility to delete P.O.'s for FY ",ACHS("YR")-10,"."
  1.  .Q
  1.  D WAIT^DICD
  1. AUTO ;EP - For automatic setup of new FY.
  1.  I $D(ACHSFYWK(DUZ(2),ACHS("YR")-1)),ACHSFYWK(DUZ(2),ACHS("YR")-1),$P(^ACHS(9,DUZ(2),"FY",ACHS("YR")-1,"W",ACHSFYWK(DUZ(2),ACHS("YR")-1),0),U,2) W !!,"Registers Already Closed....",!! G AUTO1
  1.  ; S ACHSACY=ACHS("YR")-1,ACHSASK=1,R=+ACHSFYWK(DUZ(2),ACHSACY),ACHS("DCR")="",ACHSNUM=1
  1.  S ACHSACY=ACHS("YR")-1,ACHSASK=1,ACHS("DCR")="",ACHSNUM=1
  1.  G DCR3^ACHSODQ
  1.  ;
  1. AUTO1 ;EP
  1.  I $D(ACHSERR),ACHSERR=1 G K
  1.  U IO(0)
  1.  W !!,"Initializing New Registers.  Please Wait...",!
  1.  D INIT^ACHSUF
  1. AUTO2 ;
  1.  K ^ACHS(9,DUZ(2),"FY",ACHS("YR"))
  1.  S:'$D(^ACHS(9,DUZ(2),0)) ^ACHS(9,DUZ(2),0)=DUZ(2)_"^^"_DUZ(2)_"^1^1"
  1.  S ^ACHS(9,DUZ(2),"FY",ACHS("YR"),0)=ACHS("YR")_"^0^0",^ACHS(9,DUZ(2),"FY",ACHS("YR"),1)="0^0^0^0^0^0^0",^ACHS(9,"B",DUZ(2),DUZ(2))=""
  1.  S:'$D(^ACHS(9,DUZ(2),"FY",0)) ^ACHS(9,DUZ(2),"FY",0)=$$ZEROTH^ACHS(9002069,10)
  1.  S X=$G(^ACHS(9,DUZ(2),"FY",0))
  1.  S $P(^ACHS(9,DUZ(2),"FY",0),U,3)=ACHS("YR")
  1.  S $P(^ACHS(9,DUZ(2),"FY",0),U,4)=+$P(X,U,4)+1
  1.  S ^ACHS(9,DUZ(2),"FY",ACHS("YR"),"C")="0^0^0"
  1.  S:'$D(^ACHS(9,DUZ(2),"FY",ACHS("YR"),"W",0)) ^ACHS(9,DUZ(2),"FY",ACHS("YR"),"W",0)="^9002069.02A^1^1",^(1,0)=1
  1.  I '$D(ACHSAUTO) S DA=DUZ(2),DR="10///"_ACHS("YR"),DR(2,9002069.01)="1",DIE="^ACHS(9," D ^DIE
  1.  I '$D(ACHSAUTO) K DR S DA=DUZ(2),DR="10///"_ACHS("YR"),DR(2,9002069.01)="2//1" D ^DIE
  1.  I '$D(ACHSAUTO) S DIE="^ACHS(9,"_DUZ(2)_","_"""FY"""_",",DR="3//0",DA=ACHS("YR") D ^DIE
  1.  I '$D(^ACHS(9,DUZ(2),"FY",ACHS("YR"),"W",$O(^ACHS(9,DUZ(2),"FY",ACHS("YR"),"W",0)),1)) S ^(1)="0^0^0^0^0^0^0"
  1.  W !!,"FINISHED....",!!
  1.  G K
  1.  ;
  1. CANNOT ;
  1.  W *7,!!,"Cannot Add New Fiscal Year Until After ",$$FMTE^XLFDT(ACHSFYDT),".",!
  1.  I $$DIR^XBDIR("E")
  1. K ;
  1.  K DA,DIC,DIE,DR
  1.  I $D(ACHSAUTO) K ACHS,ACHSAUTO
  1.  Q
  1.  ;