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

ACHSYROR.m

Go to the documentation of this file.
  1. ACHSYROR ; IHS/ITSC/PMF - KILLS OFF DATA SO REGISTERS CAN BE REOPENED ; [ 10/16/2001 8:16 AM ]
  1. ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
  1. ;
  1. ; Kills off data so Registers can be reopened if the DCR was run
  1. ; by mistake, or a P.O. positively-absolutely needs to be cut before
  1. ; tomorrow.
  1. ;
  1. ; This should only be run by an experienced CHS programmer.
  1. ;
  1. ; Kernel variables must be defined.
  1. ;
  1. I DUZ(0)'["@" W !!,"Sorry, your Fileman Access does not allow you to perform this option!" G END
  1. I '$D(DUZ(2)) D ^XBSITE I '$D(DUZ(2)) W !!,"Your SITE DUZ(2) is not defined. Cannot REOPEN REGISTERS!!" Q
  1. G END:'$$DIR^XBDIR("Y","Ready to open registers","Y","","","",2)
  1. S ACHSFY=0,ACHSFL=1
  1. START ;
  1. S ACHSFY=$O(^ACHS(9,DUZ(2),"FY",ACHSFY))
  1. G END:ACHSFY=""
  1. S ACHSREG=$P($G(^ACHS(9,DUZ(2),"FY",ACHSFY,"W",0)),U,3)
  1. S:ACHSREG="" ACHSREG="UNDEFINED"
  1. S ACHSDT=$P($G(^ACHS(9,DUZ(2),"FY",ACHSFY,"W",ACHSREG,0)),U,2)
  1. I ACHSFL=1,ACHSDT="" W !!,"Registers for ",$$FMTE^XLFDT(DT)," have not been closed! Can't re-open!" G END
  1. S ACHSFL=0
  1. I ACHSDT'=DT W !!,"Sorry...but I can't open a register that was closed before ",$$FMTE^XLFDT(DT)," (today)." G END
  1. S $P(^ACHS(9,DUZ(2),"FY",ACHSFY,"W",ACHSREG,0),U,2)=""
  1. S ACHSDT=9999999-ACHSDT
  1. K ^ACHS(9,DUZ(2),"FY",ACHSFY,"AR",ACHSDT,ACHSREG)
  1. W !!,"REGISTER ",ACHSREG," FOR ",ACHSFY," HAS BEEN RE-OPENED!"
  1. G START
  1. END ;
  1. I $$DIR^XBDIR("E","Press RETURN....","","","","",4)
  1. K ACHSFL,ACHSFY,ACHSREG,ACHSDT,DIR
  1. Q
  1. ;