ACRFDT.m

ACRFDT ;IHS/OIRM/DSD/THL,AEF - ARMS VENDOR DISCOUNT TERMS;  [ 05/11/2005  10:23 AM ]

 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**16,17**;MAY 15, 2001

 ;;

 ;UTILITY TO EDIT VENDOR DISCOUNT TERMS

 D VENDOR

 Q:'$G(ACRVDA)

DT ;EP;DISCOUNT TERMS

 N J,X,Y,Z,ACRTYPE,ACRQUIT

 F  D DT1 Q:$D(ACRQUIT)!$D(ACROUT)

 K ACRQUIT

 Q

DT1 I '$O(^ACRDT("B",ACRVDA,0)) D  Q:$D(ACRQUIT)!$D(ACROUT)

 .W !!,"There are no DISCOUNT TERMS on record for ",$P($G(^AUTTVNDR(+$G(ACRVDA),0)),U)

 .W !,"Enter applicable DISCOUNT TERMS below."

 .D DTADD

 D DTH

 ;S DIR(0)="SO^1:Edit Discount Terms;2:Add Discount Terms;3:Delete Discount Terms"  ;ACR*2.1*16.06 IM15505

 ;S:'$G(ACRDOCDA) DIR(0)=DIR(0)_";4:Select Discount Terms for this Payment"  ;ACR*2.1*16.06 IM15505

 S DIR(0)="SO^1:Edit Discount Terms"                          ;ACR*2.1*16.06 IM15505

 S DIR(0)=DIR(0)_";2:Add Discount Terms"                      ;ACR*2.1*16.06 IM15505

 S DIR(0)=DIR(0)_";3:Delete Discount Terms"                   ;ACR*2.1*16.06 IM15505

 S DIR(0)=DIR(0)_";4:Select Discount Terms for this Payment"  ;ACR*2.1*16.06 IM15505

 S DIR("A")="Which one"

 D DIR^ACRFDIC

 I Y=1 D DTEDIT Q

 I Y=2 D DTADD Q

 I Y=3 D DTDEL Q

 I Y=4 D DTSEL1 Q

 Q

DTH W @IOF

DTH1 ;EP;

 K X,J

 W !?10,"Discount Terms for"

 W !?10,@ACRON,$P(^AUTTVNDR(ACRVDA,0),U),@ACROF

 W !!?10,"NO.",?15,"DAYS",?21,"PERCENT"

 W !?10,"---",?15,"----",?21,"-------"

 D DTH2

 S (J,X)=0

 F  S X=$O(J(X)) Q:'X  D

 .S J=J+1

 .S X(J)=J(X)

 .S Y=$P(J(X),U,2)

 .W !?10,J,?15,X,?21,Y

 W !?10,"---",?15,"----",?21,"-------"

 Q

DTH2 ;EP;SET ARRAY OF VENDOR'S DISCOUNT TERMS

 S J=0

 F  S J=$O(^ACRDT("B",ACRVDA,J)) Q:'J  D

 .S Y=^ACRDT(J,"DT")

 .Q:'+Y

 .S J(+Y)=J_U_$P(Y,U,2)

 S (J,X)=0

 F  S X=$O(J(X)) Q:'X  D

 .S J=J+1

 .S X(J)=J(X)

 Q

DTSEL ;EP;SELECT TERMS APPLICABLE TO THIS PAYMENT

 Q:'$O(^ACRDT("B",ACRVDA,0))

 D DTH1

DTSEL1 ;EP;

 N ACRTMP        ;ACR*2.1*16.06 IM15505

 S:'$D(ACRTYPE) ACRTYPE="SELECT"

 S DIR(0)="NO^1:"_J

 S DIR("A",1)="Which discount term do you want"

 W !

 D DIR^ACRFDIC

 Q:$D(ACROUT)                                ;ACR*2.1*16.06 IM15505

 I '$G(X(+Y)) S ACRQUIT="" Q

 S ACRDTDA=+X(Y)

 S ACRDTDA=$G(^ACRDT(ACRDTDA,"DT"))          ;ACR*2.1*16.06 IM15505

 S ACRT=1                                    ;ACR*2.1*16.06 IM15505

 W !!?10,"Discount has been calculated "     ;ACR*2.1*16.06 IM15505

 D PAUSE^ACRFWARN                            ;ACR*2.1*16.06 IM15505

 Q

DTEDIT ;EDIT DISCOUNT TERMS

 S DIR("A")="to EDIT"

 S ACRTYPE="EDIT"

 D DTSEL1

 I '$G(ACRDTDA) K ACRQUIT Q

 ;S DA=ACRDTDA                                ;ACR*2.1*17.08 IM17313

 S DA=+ACRDTDA                                ;ACR*2.1*17.08 IM17313

 S DIE="^ACRDT("

 S DR="1T;2T"

 W !

 D DIE^ACRFDIC

 Q

DTADD ;ADD DISCOUNT TERMS

 S DIR(0)="NOA^1:99"

 S DIR("A")="Number of days for discount: "

 W !

 D DIR^ACRFDIC

 I Y<1 K ACRQUIT Q

 S ACRDAYS=Y

 I $D(^ACRDT("AC",ACRVDA,ACRDAYS)) S ACRJ=$O(^(ACRDAYS,0)) I ACRJ D DTEDIT Q

 S DIR(0)="NOA^1:99"

 S DIR("A")="Percent of discount........: "

 D DIR^ACRFDIC

 Q:Y<1

 S ACRPCNT=Y

 S X=ACRVDA

 S DIC="^ACRDT("

 S DIC(0)="L"

 S DIC("DR")="1////"_ACRDAYS_";2////"_ACRPCNT

 W !

 D FILE^ACRFDIC

 K ACRDAYS,ACRPCNT

 Q

DTDEL ;DELETE DISCOUNT TERMS

 S DIR("A")="to DELETE"

 S ACRTYPE="EDIT"

 D DTSEL1

 I '$G(ACRDTDA) K ACRQUIT Q

 S DA=+ACRDTDA

 S DIK="^ACRDT("

 W !

 D DIK^ACRFDIC

DTEND Q

VENDOR ;SELECT VENDOR

 S DIC="^AUTTVNDR("

 S DIC(0)="AEMQZ"

 S DIC("A")="Select VENDOR/CONTRACTOR: "

 W !

 D DIC^ACRFDIC

 I +Y<1 S ACRQUIT="" Q

 S ACRVDA=+Y

 Q

ACRFDT    ;IHS/OIRM/DSD/THL,AEF - ARMS VENDOR DISCOUNT TERMS;  [ 05/11/2005  10:23 AM ]

 +1       ;;2.1;ADMIN RESOURCE MGT SYSTEM;**16,17**;MAY 15, 2001

 +2       ;;

 +3       ;UTILITY TO EDIT VENDOR DISCOUNT TERMS

 +4        DO VENDOR

 +5        IF '$GET(ACRVDA)

               QUIT 

DT        ;EP;DISCOUNT TERMS

 +1        NEW J,X,Y,Z,ACRTYPE,ACRQUIT

 +2        FOR 

               DO DT1

               IF $DATA(ACRQUIT)!$DATA(ACROUT)

                   QUIT 

 +3        KILL ACRQUIT

 +4        QUIT 

DT1        IF '$ORDER(^ACRDT("B",ACRVDA,0))

               Begin DoDot:1

 +1                WRITE !!,"There are no DISCOUNT TERMS on record for ",$PIECE($GET(^AUTTVNDR(+$GET(ACRVDA),0)),U)

 +2                WRITE !,"Enter applicable DISCOUNT TERMS below."

 +3                DO DTADD

               End DoDot:1

               IF $DATA(ACRQUIT)!$DATA(ACROUT)

                   QUIT 

 +4        DO DTH

 +5       ;S DIR(0)="SO^1:Edit Discount Terms;2:Add Discount Terms;3:Delete Discount Terms"  ;ACR*2.1*16.06 IM15505

 +6       ;S:'$G(ACRDOCDA) DIR(0)=DIR(0)_";4:Select Discount Terms for this Payment"  ;ACR*2.1*16.06 IM15505

 +7       ;ACR*2.1*16.06 IM15505

           SET DIR(0)="SO^1:Edit Discount Terms"

 +8       ;ACR*2.1*16.06 IM15505

           SET DIR(0)=DIR(0)_";2:Add Discount Terms"

 +9       ;ACR*2.1*16.06 IM15505

           SET DIR(0)=DIR(0)_";3:Delete Discount Terms"

 +10      ;ACR*2.1*16.06 IM15505

           SET DIR(0)=DIR(0)_";4:Select Discount Terms for this Payment"

 +11       SET DIR("A")="Which one"

 +12       DO DIR^ACRFDIC

 +13       IF Y=1

               DO DTEDIT

               QUIT 

 +14       IF Y=2

               DO DTADD

               QUIT 

 +15       IF Y=3

               DO DTDEL

               QUIT 

 +16       IF Y=4

               DO DTSEL1

               QUIT 

 +17       QUIT 

DTH        WRITE @IOF

DTH1      ;EP;

 +1        KILL X,J

 +2        WRITE !?10,"Discount Terms for"

 +3        WRITE !?10,@ACRON,$PIECE(^AUTTVNDR(ACRVDA,0),U),@ACROF

 +4        WRITE !!?10,"NO.",?15,"DAYS",?21,"PERCENT"

 +5        WRITE !?10,"---",?15,"----",?21,"-------"

 +6        DO DTH2

 +7        SET (J,X)=0

 +8        FOR 

               SET X=$ORDER(J(X))

               IF 'X

                   QUIT 

               Begin DoDot:1

 +9                SET J=J+1

 +10               SET X(J)=J(X)

 +11               SET Y=$PIECE(J(X),U,2)

 +12               WRITE !?10,J,?15,X,?21,Y

               End DoDot:1

 +13       WRITE !?10,"---",?15,"----",?21,"-------"

 +14       QUIT 

DTH2      ;EP;SET ARRAY OF VENDOR'S DISCOUNT TERMS

 +1        SET J=0

 +2        FOR 

               SET J=$ORDER(^ACRDT("B",ACRVDA,J))

               IF 'J

                   QUIT 

               Begin DoDot:1

 +3                SET Y=^ACRDT(J,"DT")

 +4                IF '+Y

                       QUIT 

 +5                SET J(+Y)=J_U_$PIECE(Y,U,2)

               End DoDot:1

 +6        SET (J,X)=0

 +7        FOR 

               SET X=$ORDER(J(X))

               IF 'X

                   QUIT 

               Begin DoDot:1

 +8                SET J=J+1

 +9                SET X(J)=J(X)

               End DoDot:1

 +10       QUIT 

DTSEL     ;EP;SELECT TERMS APPLICABLE TO THIS PAYMENT

 +1        IF '$ORDER(^ACRDT("B",ACRVDA,0))

               QUIT 

 +2        DO DTH1

DTSEL1    ;EP;

 +1       ;ACR*2.1*16.06 IM15505

           NEW ACRTMP

 +2        IF '$DATA(ACRTYPE)

               SET ACRTYPE="SELECT"

 +3        SET DIR(0)="NO^1:"_J

 +4        SET DIR("A",1)="Which discount term do you want"

 +5        WRITE !

 +6        DO DIR^ACRFDIC

 +7       ;ACR*2.1*16.06 IM15505

           IF $DATA(ACROUT)

               QUIT 

 +8        IF '$GET(X(+Y))

               SET ACRQUIT=""

               QUIT 

 +9        SET ACRDTDA=+X(Y)

 +10      ;ACR*2.1*16.06 IM15505

           SET ACRDTDA=$GET(^ACRDT(ACRDTDA,"DT"))

 +11      ;ACR*2.1*16.06 IM15505

           SET ACRT=1

 +12      ;ACR*2.1*16.06 IM15505

           WRITE !!?10,"Discount has been calculated "

 +13      ;ACR*2.1*16.06 IM15505

           DO PAUSE^ACRFWARN

 +14       QUIT 

DTEDIT    ;EDIT DISCOUNT TERMS

 +1        SET DIR("A")="to EDIT"

 +2        SET ACRTYPE="EDIT"

 +3        DO DTSEL1

 +4        IF '$GET(ACRDTDA)

               KILL ACRQUIT

               QUIT 

 +5       ;S DA=ACRDTDA                                ;ACR*2.1*17.08 IM17313

 +6       ;ACR*2.1*17.08 IM17313

           SET DA=+ACRDTDA

 +7        SET DIE="^ACRDT("

 +8        SET DR="1T;2T"

 +9        WRITE !

 +10       DO DIE^ACRFDIC

 +11       QUIT 

DTADD     ;ADD DISCOUNT TERMS

 +1        SET DIR(0)="NOA^1:99"

 +2        SET DIR("A")="Number of days for discount: "

 +3        WRITE !

 +4        DO DIR^ACRFDIC

 +5        IF Y<1

               KILL ACRQUIT

               QUIT 

 +6        SET ACRDAYS=Y

 +7        IF $DATA(^ACRDT("AC",ACRVDA,ACRDAYS))

               SET ACRJ=$ORDER(^(ACRDAYS,0))

               IF ACRJ

                   DO DTEDIT

                   QUIT 

 +8        SET DIR(0)="NOA^1:99"

 +9        SET DIR("A")="Percent of discount........: "

 +10       DO DIR^ACRFDIC

 +11       IF Y<1

               QUIT 

 +12       SET ACRPCNT=Y

 +13       SET X=ACRVDA

 +14       SET DIC="^ACRDT("

 +15       SET DIC(0)="L"

 +16       SET DIC("DR")="1////"_ACRDAYS_";2////"_ACRPCNT

 +17       WRITE !

 +18       DO FILE^ACRFDIC

 +19       KILL ACRDAYS,ACRPCNT

 +20       QUIT 

DTDEL     ;DELETE DISCOUNT TERMS

 +1        SET DIR("A")="to DELETE"

 +2        SET ACRTYPE="EDIT"

 +3        DO DTSEL1

 +4        IF '$GET(ACRDTDA)

               KILL ACRQUIT

               QUIT 

 +5        SET DA=+ACRDTDA

 +6        SET DIK="^ACRDT("

 +7        WRITE !

 +8        DO DIK^ACRFDIC

DTEND      QUIT 

VENDOR    ;SELECT VENDOR

 +1        SET DIC="^AUTTVNDR("

 +2        SET DIC(0)="AEMQZ"

 +3        SET DIC("A")="Select VENDOR/CONTRACTOR: "

 +4        WRITE !

 +5        DO DIC^ACRFDIC

 +6        IF +Y<1

               SET ACRQUIT=""

               QUIT 

 +7        SET ACRVDA=+Y

 +8        QUIT