ACRFIV43 ;IHS/OIRM/DSD/AEF,MRS - ARMS TO 1166 PAYMENT INTERFACE; [ 03/18/2005 9:41 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**16**;JUL 31, 2001
;ACR*2.1*16.06 IM15505 ;NEW ROUTINE
;
;UTILITY TO EDIT PAYMENT DATA AFTER INVOICE AUDIT COMPLETED
; CONTINUED FROM ACRFIV41
;
CORRECT(ACRDT,ACRPCNT,ACRIVDC,ACRTERMS,ACRIVTF) ;EP;
;CALLED BY ACRFIV4, ACRFIV41, ACRFIV42, ACRFIV43
;TO VALIDATE INFORMATION CORRECTNESS
K ACRDT
S DIR(0)="YO"
S DIR("A")="Is this correct"
S DIR("B")="NO"
W !
D DIR^ACRFDIC
I +Y=1 D Q
.S ACRDT=""
.Q
K ACRPCNT,ACRIVDC,ACRIVTF,ACRP
Q
PAY(ACRIVPAY,ACRIVT,ACRTERMS,ACRT) ;EP;TO DISPLAY PAYMENT SUMMARY
; Called from ACRFIV4, ACRFIV42, LOCAL/DISCOUNT
;
; INPUT ; ACRIVPAY= LOCAL ARRAY OF AMOUNT TO PAY FOR CAN,OCC
; ACRIVT = TOTAL AMOUNT TO PAY
; ACRTERMS = ONLY SET IF INTEREST PENALTY OR DISCOUNT
; P1=DAYS
; P2=AMOUNT OF PENALTY OR DISCOUNT TAKEN
; P3=INTEREST RATE
; P4=INVOICE NUMBER, NOT SET HERE
; P5=ACRIVT (AMOUNT TO PAY)
; P14=ACRT
; ACRT >0= Discount taken w/percentage
; ACRT =0= Discount taken w/dollar amount
; ACRT =-1= Interest penalty
; ACRT =-2= Discount lost
;
N ACRCANDA,ACROBJDA,ACRTXT,ACRTXT1,ACRTXT2,ACRTXT3,ACRTXT4
I '$D(ACRON) D HOME^ACRFMENU ;SET FORMATTING VARIABLES
D INIT
D TERMS(.ACRTERMS)
D WRT3
Q
INIT ;LOCAL ENTRY TO INITIALIZE LOCAL VARIABLES
S (ACRCANDA,ACRIVT,ACRDCNT)=0
F S ACRCANDA=$O(ACRIVPAY(ACRCANDA)) Q:'ACRCANDA D
.S ACROBJDA=0
.F S ACROBJDA=$O(ACRIVPAY(ACRCANDA,ACROBJDA)) Q:'ACROBJDA D
..S (ACRIVTF,ACRIVT)=ACRIVT+ACRIVPAY(ACRCANDA,ACROBJDA)
..S ACRDCNT=ACRDCNT+1 ;COUNT NUMBER OF OCC
Q
;
TERMS(ACRTERMS) ;LOCAL;TO PROCESS DISCOUNT LOST, INTEREST PENALTY AND DISCOUNT TAKEN
; ALLOWS FOR BOTH DISCOUNT LOST AND INTEREST PENALTY
S ACRT=$P($G(ACRTERMS),U,14)
I ACRT="" S ACRPCNT=0 Q
;
I ACRT=-2 D Q
.S ACRTXT=$$LOST(.ACRTERMS,.ACRIVTF,.ACRIVT)
.D WRT2
;
I ACRT=-1 D Q
.S ACRTXT=$$WRT(.ACRT,.ACRPCNT,.ACRTERMS,.ACRIVTF,ACRIVT,.ACRIVDC,.ACRP)
.D WRT2
;Now process Discounts
S ACRTXT=$$WRT(.ACRT,.ACRPCNT,.ACRTERMS,.ACRIVTF,ACRIVT,.ACRIVDC,.ACRP)
D WRT2
Q
;
WRT2 ;LOCAL ENTRY
S ACRTXT1=$P(ACRTXT,U),ACRTXT2=$P(ACRTXT,U,2),ACRTXT3=$P(ACRTXT,U,3)
W !!?10
W @ACRON
W "***** NOTE *****"
W @ACROF
W !!
W:$D(ACRTXT4) ?3,ACRTXT4
W !!?10,ACRTXT1
W @ACRON
W ACRTXT2
W @ACROF
W ACRTXT3
Q
WRT3 ;LOCAL ENTRY
W !?10,"Amount of payment due...: "
W @ACRON
W $J($FN(ACRIVT,"P,",2),14)
W @ACROF
I $G(ACRP)>0 D
.W !?10,"The interest to be paid.:"
.W @ACRON
.W $J($FN(ACRP,"P,",2),15)
.W @ACROF
I $G(ACRIVDC)>0 D
.W !?10,"The discount to be taken: "
.W @ACRON
.W $J($FN(ACRIVDC,"P,",2),14)
.W @ACROF
W !?10,"Payment to be made......: "
W @ACRON
W $J($FN(ACRIVTF,"P,",2),14)
W @ACROF
Q
;
WRT(ACRT,ACRRATE,ACRTERMS,ACRIVTF,ACRIVT,ACRIVDC,ACRP) ;LOCAL ENTRY
;EXTRINSIC FUNCTION TO WRITE PAYMENT TERMS
; Variables changed when returned:
; ACRTERMS
; ACRIVDC = Discount Amount
; ACRIVTF = Invoice amount
; ACRT = Type Discount/Interest
; ACRP = Interest $ amount
;
N ACRTXT,ACRTXT1,ACRTXT2,ACRTXT3,ACRAMT,A
S A="A "
S ACRDAYS=$P(ACRTERMS,U)
S ACRAMT=$P(ACRTERMS,U,2)
S ACRRATE=$P(ACRTERMS,U,3)
;
DISPC ; LOCAL ENTRY ;Discount taken w/percentage
I ACRT>0 D Q ACRTXT
.S ACRTXT1=ACRRATE_"% discount for payment within "
.S ACRTXT2=+ACRDAYS
.S ACRTXT3=" days will be applied."
.;S ACRTXT4="A reversal obligation for the Discount will be sent to CORE"
.S ACRTXT=A_ACRTXT1_U_ACRTXT2_U_ACRTXT3
.S ACRAMT=$$DOL^ACRFUTL(.ACRAMT) ; Formatting
.S $P(ACRTERMS,U,12)=ACRIVTF ; Invoice amount
.S ACRIVTF=ACRIVT-ACRAMT
.S ACRIVDC=ACRAMT
.S $P(ACRTERMS,U,5)=ACRIVTF ; Payment amount
.Q
DISAMT ;LOCAL ENTRY ;Discount taken w/$dollar amt
I ACRT=0 D Q ACRTXT
.S ACRTXT1=" discount for early payment will be applied."
.S ACRTXT2=$FN(ACRAMT,"P",2)
.;S ACRTXT4="A reversal obligation for the Discount will be sent to CORE"
.S ACRTXT=A_U_ACRTXT2_U_ACRTXT1
.S $P(ACRTERMS,U,12)=ACRIVTF ; Invoice amount
.S ACRIVTF=ACRIVT-ACRAMT
.S ACRAMT=$$DOL^ACRFUTL(.ACRAMT)
.S ACRIVDC=ACRAMT
.S $P(ACRTERMS,U,5)=ACRIVTF ; Payment amount
.Q
INT ;LOCAL ENTRY ; Interest penalty
I ACRT=-1 D Q ACRTXT
.S ACRTXT1="penalty for a late payment of "
.S ACRTXT3=" days will be applied."
.S ACRTXT=A_ACRTXT1_U_ACRDAYS_U_ACRTXT3
.S ACRAMT=$$DOL^ACRFUTL(.ACRAMT)
.S $P(ACRTERMS,U,12)=ACRIVTF ; Invoice amount
.S ACRIVTF=ACRIVT+ACRAMT
.S (ACRP,$P(ACRTERMS,U,2))=ACRAMT
.S $P(ACRTERMS,U,5)=ACRIVT ; payment amount
.Q
;
DISLOST ;LOST DISCOUNT
I ACRT=-2 D Q ACRTXT
.S ACRTXT="Discount Lost will be recorded "
S ACRTXT="Error" ;Housekeeping
Q ACRTXT
;
LOST(ACRTERMS,ACRIVTF,ACRIVT) ;LOCAL ENTRY ;Discount lost
N ACRTXT,ACRTXT1,ACRTXT2,ACRTXT3,ACRAMT
S ACRAMT=$P(ACRTERMS,U,2)
S ACRRATE=$P(ACRTERMS,U,3)
I ACRAMT]"" S ACRTXT1="The discount LOST........: "
I ACRRATE]"" D
.S ACRTXT1="The discount LOST ("
.S ACRTXT1=ACRTXT1_$E("00",1,2-$L(ACRRATE))_ACRRATE_" %): "
.S ACRAMT=(ACRIVT*ACRRATE*.01)
.S ACRAMT=$$DOL^ACRFUTL(.ACRAMT)
.S $P(ACRTERMS,U,2)=ACRAMT ; Discount Lost amount
S $P(ACRTERMS,U,5)=ACRIVT ; payment amount
S $P(ACRTERMS,U,12)=ACRIVTF ; Invoice amount
S ACRTXT2=$J($FN(ACRAMT,"P,",2),14)
S ACRTXT=ACRTXT1_U_ACRTXT2
Q ACRTXT
PAYD(ACRIVPAY,ACRIVT,ACRTERMS,ACRT) ;EP;TO DISPLAY PAYMENT SUMMARY
; Called from ACRFIV4, ACRFIV42, LOCAL/DISCOUNT
;
; INPUT ; ACRIVPAY= LOCAL ARRAY OF AMOUNT TO PAY FOR CAN,OCC
; ACRIVT = TOTAL AMOUNT TO PAY
; ACRTERMS = ONLY SET IF INTEREST PENALTY OR DISCOUNT
; P1=DAYS
; P2=AMOUNT OF PENALTY OR DISCOUNT TAKEN
; P3=INTEREST RATE
; P4=INVOICE NUMBER, NOT SET HERE
; P5=ACRIVT (AMOUNT TO PAY)
; P14=ACRT
; ACRT >0= Discount taken w/percentage
; ACRT =0= Discount taken w/dollar amount
; ACRT =-1= Interest penalty
; ACRT =-2= Discount lost
;
N ACRCANDA,ACROBJDA,ACRTXT,ACRTXT1,ACRTXT2,ACRTXT3,ACRDCNT,ACRTDIS
S ACRDCNT=$$OBJCNT(.ACRIVPAY)
D INITD
D TERMS(.ACRTERMS)
D WRT3
Q
INITD ;LOCAL ENTRY TO INITIALIZE LOCAL VARIABLES
S (ACRCANDA,ACRIVT)=0
F S ACRCANDA=$O(ACRIVPAY(ACRCANDA)) Q:'ACRCANDA D
.S ACROBJDA=0
.F S ACROBJDA=$O(ACRIVPAY(ACRCANDA,ACROBJDA)) Q:'ACROBJDA D
..S (ACRIVTF,ACRIVT)=ACRIVT+ACRIVPAY(ACRCANDA,ACROBJDA)
Q
OBJCNT(ACRIVPAY) ;EP; EXTRINSIC FUNCTION TO RETURN NUMBER OF OCC'S
N ACRX,ACRY,ACRJ
S (ACRX,ACRJ)=0
F S ACRX=$O(ACRIVPAY(ACRX)) Q:'ACRX D
.S ACRY=0
.F S ACRY=$O(ACRIVPAY(ACRX,ACRY)) Q:'ACRY S ACRJ=ACRJ+1
Q ACRJ
ACRFIV43 ;IHS/OIRM/DSD/AEF,MRS - ARMS TO 1166 PAYMENT INTERFACE; [ 03/18/2005 9:41 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**16**;JUL 31, 2001
+2 ;ACR*2.1*16.06 IM15505 ;NEW ROUTINE
+3 ;
+4 ;UTILITY TO EDIT PAYMENT DATA AFTER INVOICE AUDIT COMPLETED
+5 ; CONTINUED FROM ACRFIV41
+6 ;
CORRECT(ACRDT,ACRPCNT,ACRIVDC,ACRTERMS,ACRIVTF) ;EP;
+1 ;CALLED BY ACRFIV4, ACRFIV41, ACRFIV42, ACRFIV43
+2 ;TO VALIDATE INFORMATION CORRECTNESS
+3 KILL ACRDT
+4 SET DIR(0)="YO"
+5 SET DIR("A")="Is this correct"
+6 SET DIR("B")="NO"
+7 WRITE !
+8 DO DIR^ACRFDIC
+9 IF +Y=1
Begin DoDot:1
+10 SET ACRDT=""
+11 QUIT
End DoDot:1
QUIT
+12 KILL ACRPCNT,ACRIVDC,ACRIVTF,ACRP
+13 QUIT
PAY(ACRIVPAY,ACRIVT,ACRTERMS,ACRT) ;EP;TO DISPLAY PAYMENT SUMMARY
+1 ; Called from ACRFIV4, ACRFIV42, LOCAL/DISCOUNT
+2 ;
+3 ; INPUT ; ACRIVPAY= LOCAL ARRAY OF AMOUNT TO PAY FOR CAN,OCC
+4 ; ACRIVT = TOTAL AMOUNT TO PAY
+5 ; ACRTERMS = ONLY SET IF INTEREST PENALTY OR DISCOUNT
+6 ; P1=DAYS
+7 ; P2=AMOUNT OF PENALTY OR DISCOUNT TAKEN
+8 ; P3=INTEREST RATE
+9 ; P4=INVOICE NUMBER, NOT SET HERE
+10 ; P5=ACRIVT (AMOUNT TO PAY)
+11 ; P14=ACRT
+12 ; ACRT >0= Discount taken w/percentage
+13 ; ACRT =0= Discount taken w/dollar amount
+14 ; ACRT =-1= Interest penalty
+15 ; ACRT =-2= Discount lost
+16 ;
+17 NEW ACRCANDA,ACROBJDA,ACRTXT,ACRTXT1,ACRTXT2,ACRTXT3,ACRTXT4
+18 ;SET FORMATTING VARIABLES
IF '$DATA(ACRON)
DO HOME^ACRFMENU
+19 DO INIT
+20 DO TERMS(.ACRTERMS)
+21 DO WRT3
+22 QUIT
INIT ;LOCAL ENTRY TO INITIALIZE LOCAL VARIABLES
+1 SET (ACRCANDA,ACRIVT,ACRDCNT)=0
+2 FOR
SET ACRCANDA=$ORDER(ACRIVPAY(ACRCANDA))
IF 'ACRCANDA
QUIT
Begin DoDot:1
+3 SET ACROBJDA=0
+4 FOR
SET ACROBJDA=$ORDER(ACRIVPAY(ACRCANDA,ACROBJDA))
IF 'ACROBJDA
QUIT
Begin DoDot:2
+5 SET (ACRIVTF,ACRIVT)=ACRIVT+ACRIVPAY(ACRCANDA,ACROBJDA)
+6 ;COUNT NUMBER OF OCC
SET ACRDCNT=ACRDCNT+1
End DoDot:2
End DoDot:1
+7 QUIT
+8 ;
TERMS(ACRTERMS) ;LOCAL;TO PROCESS DISCOUNT LOST, INTEREST PENALTY AND DISCOUNT TAKEN
+1 ; ALLOWS FOR BOTH DISCOUNT LOST AND INTEREST PENALTY
+2 SET ACRT=$PIECE($GET(ACRTERMS),U,14)
+3 IF ACRT=""
SET ACRPCNT=0
QUIT
+4 ;
+5 IF ACRT=-2
Begin DoDot:1
+6 SET ACRTXT=$$LOST(.ACRTERMS,.ACRIVTF,.ACRIVT)
+7 DO WRT2
End DoDot:1
QUIT
+8 ;
+9 IF ACRT=-1
Begin DoDot:1
+10 SET ACRTXT=$$WRT(.ACRT,.ACRPCNT,.ACRTERMS,.ACRIVTF,ACRIVT,.ACRIVDC,.ACRP)
+11 DO WRT2
End DoDot:1
QUIT
+12 ;Now process Discounts
+13 SET ACRTXT=$$WRT(.ACRT,.ACRPCNT,.ACRTERMS,.ACRIVTF,ACRIVT,.ACRIVDC,.ACRP)
+14 DO WRT2
+15 QUIT
+16 ;
WRT2 ;LOCAL ENTRY
+1 SET ACRTXT1=$PIECE(ACRTXT,U)
SET ACRTXT2=$PIECE(ACRTXT,U,2)
SET ACRTXT3=$PIECE(ACRTXT,U,3)
+2 WRITE !!?10
+3 WRITE @ACRON
+4 WRITE "***** NOTE *****"
+5 WRITE @ACROF
+6 WRITE !!
+7 IF $DATA(ACRTXT4)
WRITE ?3,ACRTXT4
+8 WRITE !!?10,ACRTXT1
+9 WRITE @ACRON
+10 WRITE ACRTXT2
+11 WRITE @ACROF
+12 WRITE ACRTXT3
+13 QUIT
WRT3 ;LOCAL ENTRY
+1 WRITE !?10,"Amount of payment due...: "
+2 WRITE @ACRON
+3 WRITE $JUSTIFY($FNUMBER(ACRIVT,"P,",2),14)
+4 WRITE @ACROF
+5 IF $GET(ACRP)>0
Begin DoDot:1
+6 WRITE !?10,"The interest to be paid.:"
+7 WRITE @ACRON
+8 WRITE $JUSTIFY($FNUMBER(ACRP,"P,",2),15)
+9 WRITE @ACROF
End DoDot:1
+10 IF $GET(ACRIVDC)>0
Begin DoDot:1
+11 WRITE !?10,"The discount to be taken: "
+12 WRITE @ACRON
+13 WRITE $JUSTIFY($FNUMBER(ACRIVDC,"P,",2),14)
+14 WRITE @ACROF
End DoDot:1
+15 WRITE !?10,"Payment to be made......: "
+16 WRITE @ACRON
+17 WRITE $JUSTIFY($FNUMBER(ACRIVTF,"P,",2),14)
+18 WRITE @ACROF
+19 QUIT
+20 ;
WRT(ACRT,ACRRATE,ACRTERMS,ACRIVTF,ACRIVT,ACRIVDC,ACRP) ;LOCAL ENTRY
+1 ;EXTRINSIC FUNCTION TO WRITE PAYMENT TERMS
+2 ; Variables changed when returned:
+3 ; ACRTERMS
+4 ; ACRIVDC = Discount Amount
+5 ; ACRIVTF = Invoice amount
+6 ; ACRT = Type Discount/Interest
+7 ; ACRP = Interest $ amount
+8 ;
+9 NEW ACRTXT,ACRTXT1,ACRTXT2,ACRTXT3,ACRAMT,A
+10 SET A="A "
+11 SET ACRDAYS=$PIECE(ACRTERMS,U)
+12 SET ACRAMT=$PIECE(ACRTERMS,U,2)
+13 SET ACRRATE=$PIECE(ACRTERMS,U,3)
+14 ;
DISPC ; LOCAL ENTRY ;Discount taken w/percentage
+1 IF ACRT>0
Begin DoDot:1
+2 SET ACRTXT1=ACRRATE_"% discount for payment within "
+3 SET ACRTXT2=+ACRDAYS
+4 SET ACRTXT3=" days will be applied."
+5 ;S ACRTXT4="A reversal obligation for the Discount will be sent to CORE"
+6 SET ACRTXT=A_ACRTXT1_U_ACRTXT2_U_ACRTXT3
+7 ; Formatting
SET ACRAMT=$$DOL^ACRFUTL(.ACRAMT)
+8 ; Invoice amount
SET $PIECE(ACRTERMS,U,12)=ACRIVTF
+9 SET ACRIVTF=ACRIVT-ACRAMT
+10 SET ACRIVDC=ACRAMT
+11 ; Payment amount
SET $PIECE(ACRTERMS,U,5)=ACRIVTF
+12 QUIT
End DoDot:1
QUIT ACRTXT
DISAMT ;LOCAL ENTRY ;Discount taken w/$dollar amt
+1 IF ACRT=0
Begin DoDot:1
+2 SET ACRTXT1=" discount for early payment will be applied."
+3 SET ACRTXT2=$FNUMBER(ACRAMT,"P",2)
+4 ;S ACRTXT4="A reversal obligation for the Discount will be sent to CORE"
+5 SET ACRTXT=A_U_ACRTXT2_U_ACRTXT1
+6 ; Invoice amount
SET $PIECE(ACRTERMS,U,12)=ACRIVTF
+7 SET ACRIVTF=ACRIVT-ACRAMT
+8 SET ACRAMT=$$DOL^ACRFUTL(.ACRAMT)
+9 SET ACRIVDC=ACRAMT
+10 ; Payment amount
SET $PIECE(ACRTERMS,U,5)=ACRIVTF
+11 QUIT
End DoDot:1
QUIT ACRTXT
INT ;LOCAL ENTRY ; Interest penalty
+1 IF ACRT=-1
Begin DoDot:1
+2 SET ACRTXT1="penalty for a late payment of "
+3 SET ACRTXT3=" days will be applied."
+4 SET ACRTXT=A_ACRTXT1_U_ACRDAYS_U_ACRTXT3
+5 SET ACRAMT=$$DOL^ACRFUTL(.ACRAMT)
+6 ; Invoice amount
SET $PIECE(ACRTERMS,U,12)=ACRIVTF
+7 SET ACRIVTF=ACRIVT+ACRAMT
+8 SET (ACRP,$PIECE(ACRTERMS,U,2))=ACRAMT
+9 ; payment amount
SET $PIECE(ACRTERMS,U,5)=ACRIVT
+10 QUIT
End DoDot:1
QUIT ACRTXT
+11 ;
DISLOST ;LOST DISCOUNT
+1 IF ACRT=-2
Begin DoDot:1
+2 SET ACRTXT="Discount Lost will be recorded "
End DoDot:1
QUIT ACRTXT
+3 ;Housekeeping
SET ACRTXT="Error"
+4 QUIT ACRTXT
+5 ;
LOST(ACRTERMS,ACRIVTF,ACRIVT) ;LOCAL ENTRY ;Discount lost
+1 NEW ACRTXT,ACRTXT1,ACRTXT2,ACRTXT3,ACRAMT
+2 SET ACRAMT=$PIECE(ACRTERMS,U,2)
+3 SET ACRRATE=$PIECE(ACRTERMS,U,3)
+4 IF ACRAMT]""
SET ACRTXT1="The discount LOST........: "
+5 IF ACRRATE]""
Begin DoDot:1
+6 SET ACRTXT1="The discount LOST ("
+7 SET ACRTXT1=ACRTXT1_$EXTRACT("00",1,2-$LENGTH(ACRRATE))_ACRRATE_" %): "
+8 SET ACRAMT=(ACRIVT*ACRRATE*.01)
+9 SET ACRAMT=$$DOL^ACRFUTL(.ACRAMT)
+10 ; Discount Lost amount
SET $PIECE(ACRTERMS,U,2)=ACRAMT
End DoDot:1
+11 ; payment amount
SET $PIECE(ACRTERMS,U,5)=ACRIVT
+12 ; Invoice amount
SET $PIECE(ACRTERMS,U,12)=ACRIVTF
+13 SET ACRTXT2=$JUSTIFY($FNUMBER(ACRAMT,"P,",2),14)
+14 SET ACRTXT=ACRTXT1_U_ACRTXT2
+15 QUIT ACRTXT
PAYD(ACRIVPAY,ACRIVT,ACRTERMS,ACRT) ;EP;TO DISPLAY PAYMENT SUMMARY
+1 ; Called from ACRFIV4, ACRFIV42, LOCAL/DISCOUNT
+2 ;
+3 ; INPUT ; ACRIVPAY= LOCAL ARRAY OF AMOUNT TO PAY FOR CAN,OCC
+4 ; ACRIVT = TOTAL AMOUNT TO PAY
+5 ; ACRTERMS = ONLY SET IF INTEREST PENALTY OR DISCOUNT
+6 ; P1=DAYS
+7 ; P2=AMOUNT OF PENALTY OR DISCOUNT TAKEN
+8 ; P3=INTEREST RATE
+9 ; P4=INVOICE NUMBER, NOT SET HERE
+10 ; P5=ACRIVT (AMOUNT TO PAY)
+11 ; P14=ACRT
+12 ; ACRT >0= Discount taken w/percentage
+13 ; ACRT =0= Discount taken w/dollar amount
+14 ; ACRT =-1= Interest penalty
+15 ; ACRT =-2= Discount lost
+16 ;
+17 NEW ACRCANDA,ACROBJDA,ACRTXT,ACRTXT1,ACRTXT2,ACRTXT3,ACRDCNT,ACRTDIS
+18 SET ACRDCNT=$$OBJCNT(.ACRIVPAY)
+19 DO INITD
+20 DO TERMS(.ACRTERMS)
+21 DO WRT3
+22 QUIT
INITD ;LOCAL ENTRY TO INITIALIZE LOCAL VARIABLES
+1 SET (ACRCANDA,ACRIVT)=0
+2 FOR
SET ACRCANDA=$ORDER(ACRIVPAY(ACRCANDA))
IF 'ACRCANDA
QUIT
Begin DoDot:1
+3 SET ACROBJDA=0
+4 FOR
SET ACROBJDA=$ORDER(ACRIVPAY(ACRCANDA,ACROBJDA))
IF 'ACROBJDA
QUIT
Begin DoDot:2
+5 SET (ACRIVTF,ACRIVT)=ACRIVT+ACRIVPAY(ACRCANDA,ACROBJDA)
End DoDot:2
End DoDot:1
+6 QUIT
OBJCNT(ACRIVPAY) ;EP; EXTRINSIC FUNCTION TO RETURN NUMBER OF OCC'S
+1 NEW ACRX,ACRY,ACRJ
+2 SET (ACRX,ACRJ)=0
+3 FOR
SET ACRX=$ORDER(ACRIVPAY(ACRX))
IF 'ACRX
QUIT
Begin DoDot:1
+4 SET ACRY=0
+5 FOR
SET ACRY=$ORDER(ACRIVPAY(ACRX,ACRY))
IF 'ACRY
QUIT
SET ACRJ=ACRJ+1
End DoDot:1
+6 QUIT ACRJ
