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
