ACHSNEW.m

ACHSNEW ; IHS/ITSC/PMF - SET UP A NEW FISCAL YEAR FOR A FACILITY ;   [ 10/16/2001   8:16 AM ]

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

 ;

 S ACHS("SETNEW")=""

 D ^ACHSVAR

 I $D(ACHSXQT) G K

 D FY^ACHSUF,C0SUB^ACHSUF

 I $D(ACHSERR),ACHSERR=1 G GLOBERR^ACHSUF

 S ACHS("FYX")=$O(ACHSFYWK(DUZ(2),9999),-1)

 S ACHS("ACWKX")=ACHSFYWK(DUZ(2),ACHS("FYX"))

 G GLOBERR^ACHSUF:'$D(^ACHS(9,DUZ(2),"FY",ACHS("FYX"),"W",ACHS("ACWKX")))

BD ;

 W !!,"Which fiscal year? ("

 S ACHS("YR")=1700+$E(DT,1,3)

 W ACHS("YR")-2," to ",ACHS("YR")+1,") "

 D READ^ACHSFU

 G K:$D(DTOUT)!$D(DUOUT)!(Y="")

 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

 S ACHS("YR")=+Y

 I $D(^ACHS(9,DUZ(2),"FY",ACHS("YR"))) W *7,!!,"This fiscal year is already on file and cannot be reset.",!! G BD

 I $E($O(^ACHSF(DUZ(2),"D","B","1"_$E(ACHS("YR"),4)_"00000")),2)=$E(ACHS("YR"),4) D  G BD

 . 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,"."

 .Q

 D WAIT^DICD

AUTO ;EP - For automatic setup of new FY.

 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

 ; S ACHSACY=ACHS("YR")-1,ACHSASK=1,R=+ACHSFYWK(DUZ(2),ACHSACY),ACHS("DCR")="",ACHSNUM=1

 S ACHSACY=ACHS("YR")-1,ACHSASK=1,ACHS("DCR")="",ACHSNUM=1

 G DCR3^ACHSODQ

 ;

AUTO1 ;EP

 I $D(ACHSERR),ACHSERR=1 G K

 U IO(0)

 W !!,"Initializing New Registers.  Please Wait...",!

 D INIT^ACHSUF

AUTO2 ;

 K ^ACHS(9,DUZ(2),"FY",ACHS("YR"))

 S:'$D(^ACHS(9,DUZ(2),0)) ^ACHS(9,DUZ(2),0)=DUZ(2)_"^^"_DUZ(2)_"^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))=""

 S:'$D(^ACHS(9,DUZ(2),"FY",0)) ^ACHS(9,DUZ(2),"FY",0)=$$ZEROTH^ACHS(9002069,10)

 S X=$G(^ACHS(9,DUZ(2),"FY",0))

 S $P(^ACHS(9,DUZ(2),"FY",0),U,3)=ACHS("YR")

 S $P(^ACHS(9,DUZ(2),"FY",0),U,4)=+$P(X,U,4)+1

 S ^ACHS(9,DUZ(2),"FY",ACHS("YR"),"C")="0^0^0"

 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

 I '$D(ACHSAUTO) S DA=DUZ(2),DR="10///"_ACHS("YR"),DR(2,9002069.01)="1",DIE="^ACHS(9," D ^DIE

 I '$D(ACHSAUTO) K DR S DA=DUZ(2),DR="10///"_ACHS("YR"),DR(2,9002069.01)="2//1" D ^DIE

 I '$D(ACHSAUTO) S DIE="^ACHS(9,"_DUZ(2)_","_"""FY"""_",",DR="3//0",DA=ACHS("YR") D ^DIE

 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"

 W !!,"FINISHED....",!!

 G K

 ;

CANNOT ;

 W *7,!!,"Cannot Add New Fiscal Year Until After ",$$FMTE^XLFDT(ACHSFYDT),".",!

 I $$DIR^XBDIR("E")

K ;

 K DA,DIC,DIE,DR

 I $D(ACHSAUTO) K ACHS,ACHSAUTO

 Q

 ;

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

 +2       ;

 +3        SET ACHS("SETNEW")=""

 +4        DO ^ACHSVAR

 +5        IF $DATA(ACHSXQT)

               GOTO K

 +6        DO FY^ACHSUF

           DO C0SUB^ACHSUF

 +7        IF $DATA(ACHSERR)

               IF ACHSERR=1

                   GOTO GLOBERR^ACHSUF

 +8        SET ACHS("FYX")=$ORDER(ACHSFYWK(DUZ(2),9999),-1)

 +9        SET ACHS("ACWKX")=ACHSFYWK(DUZ(2),ACHS("FYX"))

 +10       IF '$DATA(^ACHS(9,DUZ(2),"FY",ACHS("FYX"),"W",ACHS("ACWKX")))

               GOTO GLOBERR^ACHSUF

BD        ;

 +1        WRITE !!,"Which fiscal year? ("

 +2        SET ACHS("YR")=1700+$EXTRACT(DT,1,3)

 +3        WRITE ACHS("YR")-2," to ",ACHS("YR")+1,") "

 +4        DO READ^ACHSFU

 +5        IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")

               GOTO K

 +6        IF $LENGTH(Y)'=4!(+Y>(ACHS("YR")+1))!(+Y<(ACHS("YR")-2))

               WRITE !!,"Enter a four-digit fiscal year - see listed examples."

               DO SB1^ACHSFU

               GOTO BD

 +7        SET ACHS("YR")=+Y

 +8        IF $DATA(^ACHS(9,DUZ(2),"FY",ACHS("YR")))

               WRITE *7,!!,"This fiscal year is already on file and cannot be reset.",!!

               GOTO BD

 +9        IF $EXTRACT($ORDER(^ACHSF(DUZ(2),"D","B","1"_$EXTRACT(ACHS("YR"),4)_"00000")),2)=$EXTRACT(ACHS("YR"),4)

               Begin DoDot:1

 +10               WRITE *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,"."

 +11               QUIT 

               End DoDot:1

               GOTO BD

 +12       DO WAIT^DICD

AUTO      ;EP - For automatic setup of new FY.

 +1        IF $DATA(ACHSFYWK(DUZ(2),ACHS("YR")-1))

               IF ACHSFYWK(DUZ(2),ACHS("YR")-1)

                   IF $PIECE(^ACHS(9,DUZ(2),"FY",ACHS("YR")-1,"W",ACHSFYWK(DUZ(2),ACHS("YR")-1),0),U,2)

                       WRITE !!,"Registers Already Closed....",!!

                       GOTO AUTO1

 +2       ; S ACHSACY=ACHS("YR")-1,ACHSASK=1,R=+ACHSFYWK(DUZ(2),ACHSACY),ACHS("DCR")="",ACHSNUM=1

 +3        SET ACHSACY=ACHS("YR")-1

           SET ACHSASK=1

           SET ACHS("DCR")=""

           SET ACHSNUM=1

 +4        GOTO DCR3^ACHSODQ

 +5       ;

AUTO1     ;EP

 +1        IF $DATA(ACHSERR)

               IF ACHSERR=1

                   GOTO K

 +2        USE IO(0)

 +3        WRITE !!,"Initializing New Registers.  Please Wait...",!

 +4        DO INIT^ACHSUF

AUTO2     ;

 +1        KILL ^ACHS(9,DUZ(2),"FY",ACHS("YR"))

 +2        IF '$DATA(^ACHS(9,DUZ(2),0))

               SET ^ACHS(9,DUZ(2),0)=DUZ(2)_"^^"_DUZ(2)_"^1^1"

 +3        SET ^ACHS(9,DUZ(2),"FY",ACHS("YR"),0)=ACHS("YR")_"^0^0"

           SET ^ACHS(9,DUZ(2),"FY",ACHS("YR"),1)="0^0^0^0^0^0^0"

           SET ^ACHS(9,"B",DUZ(2),DUZ(2))=""

 +4        IF '$DATA(^ACHS(9,DUZ(2),"FY",0))

               SET ^ACHS(9,DUZ(2),"FY",0)=$$ZEROTH^ACHS(9002069,10)

 +5        SET X=$GET(^ACHS(9,DUZ(2),"FY",0))

 +6        SET $PIECE(^ACHS(9,DUZ(2),"FY",0),U,3)=ACHS("YR")

 +7        SET $PIECE(^ACHS(9,DUZ(2),"FY",0),U,4)=+$PIECE(X,U,4)+1

 +8        SET ^ACHS(9,DUZ(2),"FY",ACHS("YR"),"C")="0^0^0"

 +9        IF '$DATA(^ACHS(9,DUZ(2),"FY",ACHS("YR"),"W",0))

               SET ^ACHS(9,DUZ(2),"FY",ACHS("YR"),"W",0)="^9002069.02A^1^1"

               SET ^(1,0)=1

 +10       IF '$DATA(ACHSAUTO)

               SET DA=DUZ(2)

               SET DR="10///"_ACHS("YR")

               SET DR(2,9002069.01)="1"

               SET DIE="^ACHS(9,"

               DO ^DIE

 +11       IF '$DATA(ACHSAUTO)

               KILL DR

               SET DA=DUZ(2)

               SET DR="10///"_ACHS("YR")

               SET DR(2,9002069.01)="2//1"

               DO ^DIE

 +12       IF '$DATA(ACHSAUTO)

               SET DIE="^ACHS(9,"_DUZ(2)_","_"""FY"""_","

               SET DR="3//0"

               SET DA=ACHS("YR")

               DO ^DIE

 +13       IF '$DATA(^ACHS(9,DUZ(2),"FY",ACHS("YR"),"W",$ORDER(^ACHS(9,DUZ(2),"FY",ACHS("YR"),"W",0)),1))

               SET ^(1)="0^0^0^0^0^0^0"

 +14       WRITE !!,"FINISHED....",!!

 +15       GOTO K

 +16      ;

CANNOT    ;

 +1        WRITE *7,!!,"Cannot Add New Fiscal Year Until After ",$$FMTE^XLFDT(ACHSFYDT),".",!

 +2        IF $$DIR^XBDIR("E")

K         ;

 +1        KILL DA,DIC,DIE,DR

 +2        IF $DATA(ACHSAUTO)

               KILL ACHS,ACHSAUTO

 +3        QUIT 

 +4       ;