ACHSYROR.m

ACHSYROR ; IHS/ITSC/PMF - KILLS OFF DATA SO REGISTERS CAN BE REOPENED ;   [ 10/16/2001   8:16 AM ]

 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001

 ;

 ; Kills off data so Registers can be reopened if the DCR was run

 ; by mistake, or a P.O. positively-absolutely needs to be cut before

 ; tomorrow.

 ;

 ; This should only be run by an experienced CHS programmer.

 ;

 ; Kernel variables must be defined.

 ;

 I DUZ(0)'["@" W !!,"Sorry, your Fileman Access does not allow you to perform this option!" G END

 I '$D(DUZ(2)) D ^XBSITE I '$D(DUZ(2)) W !!,"Your SITE DUZ(2) is not defined. Cannot REOPEN REGISTERS!!" Q

 G END:'$$DIR^XBDIR("Y","Ready to open registers","Y","","","",2)

 S ACHSFY=0,ACHSFL=1

START ;

 S ACHSFY=$O(^ACHS(9,DUZ(2),"FY",ACHSFY))

 G END:ACHSFY=""

 S ACHSREG=$P($G(^ACHS(9,DUZ(2),"FY",ACHSFY,"W",0)),U,3)

 S:ACHSREG="" ACHSREG="UNDEFINED"

 S ACHSDT=$P($G(^ACHS(9,DUZ(2),"FY",ACHSFY,"W",ACHSREG,0)),U,2)

 I ACHSFL=1,ACHSDT="" W !!,"Registers for ",$$FMTE^XLFDT(DT)," have not been closed! Can't re-open!" G END

 S ACHSFL=0

 I ACHSDT'=DT W !!,"Sorry...but I can't open a register that was closed before ",$$FMTE^XLFDT(DT)," (today)." G END

 S $P(^ACHS(9,DUZ(2),"FY",ACHSFY,"W",ACHSREG,0),U,2)=""

 S ACHSDT=9999999-ACHSDT

 K ^ACHS(9,DUZ(2),"FY",ACHSFY,"AR",ACHSDT,ACHSREG)

 W !!,"REGISTER ",ACHSREG," FOR ",ACHSFY," HAS BEEN RE-OPENED!"

 G START

END ;

 I $$DIR^XBDIR("E","Press RETURN....","","","","",4)

 K ACHSFL,ACHSFY,ACHSREG,ACHSDT,DIR

 Q

 ;

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

 +2       ;

 +3       ; Kills off data so Registers can be reopened if the DCR was run

 +4       ; by mistake, or a P.O. positively-absolutely needs to be cut before

 +5       ; tomorrow.

 +6       ;

 +7       ; This should only be run by an experienced CHS programmer.

 +8       ;

 +9       ; Kernel variables must be defined.

 +10      ;

 +11       IF DUZ(0)'["@"

               WRITE !!,"Sorry, your Fileman Access does not allow you to perform this option!"

               GOTO END

 +12       IF '$DATA(DUZ(2))

               DO ^XBSITE

               IF '$DATA(DUZ(2))

                   WRITE !!,"Your SITE DUZ(2) is not defined. Cannot REOPEN REGISTERS!!"

                   QUIT 

 +13       IF '$$DIR^XBDIR("Y","Ready to open registers","Y","","","",2)

               GOTO END

 +14       SET ACHSFY=0

           SET ACHSFL=1

START     ;

 +1        SET ACHSFY=$ORDER(^ACHS(9,DUZ(2),"FY",ACHSFY))

 +2        IF ACHSFY=""

               GOTO END

 +3        SET ACHSREG=$PIECE($GET(^ACHS(9,DUZ(2),"FY",ACHSFY,"W",0)),U,3)

 +4        IF ACHSREG=""

               SET ACHSREG="UNDEFINED"

 +5        SET ACHSDT=$PIECE($GET(^ACHS(9,DUZ(2),"FY",ACHSFY,"W",ACHSREG,0)),U,2)

 +6        IF ACHSFL=1

               IF ACHSDT=""

                   WRITE !!,"Registers for ",$$FMTE^XLFDT(DT)," have not been closed! Can't re-open!"

                   GOTO END

 +7        SET ACHSFL=0

 +8        IF ACHSDT'=DT

               WRITE !!,"Sorry...but I can't open a register that was closed before ",$$FMTE^XLFDT(DT)," (today)."

               GOTO END

 +9        SET $PIECE(^ACHS(9,DUZ(2),"FY",ACHSFY,"W",ACHSREG,0),U,2)=""

 +10       SET ACHSDT=9999999-ACHSDT

 +11       KILL ^ACHS(9,DUZ(2),"FY",ACHSFY,"AR",ACHSDT,ACHSREG)

 +12       WRITE !!,"REGISTER ",ACHSREG," FOR ",ACHSFY," HAS BEEN RE-OPENED!"

 +13       GOTO START

END       ;

 +1        IF $$DIR^XBDIR("E","Press RETURN....","","","","",4)

 +2        KILL ACHSFL,ACHSFY,ACHSREG,ACHSDT,DIR

 +3        QUIT 

 +4       ;