ACRFPAY5 ;IHS/OIRM/DSD/THL,AEF - MISC PM REPORTS; [ 09/23/2005 9:40 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**5,19**;NOV 05, 2001
;;
Q
INVRPT ;EP;TO PRINT INVOICE WORKLOAD REPORT
F D INV1 Q:$D(ACRQUIT)!$D(ACROUT)
INVEXIT K ACRQUIT,ACROUT,ACRDUE,ACRDC,ACRBEGIN,ACRDATE,ACREND,ACREXP,ACRFOR,ACRTV
K ^TMP("ACRINVR",$J)
Q
INV1 ;
K ^TMP("ACRINVR",$J)
W @IOF
W !?10,"Select beginning and ending dates for INVOICE WORKLOAD REPORT"
W !
D ^ACRFDATE
I '$G(ACRBEGIN)!'$G(ACREND) S ACRQUIT="" Q
S DIR(0)="SO^1:Report by LOCATION;2:Report by DATA ENTRY Personnel"
S DIR("A")="Which report"
S DIR("B")=1
W !
D DIR^ACRFDIC
I 'Y S ACRQUIT="" Q
N ACRWHICH
S ACRWHICH=Y
S (ACRRTN,ZTRTN)="INV2^ACRFPAY5"
S ZTDESC="INVOICE WORKLOAD REPORT"
D ^ACRFZIS
Q
INV2 ;EP;TO PRINT INVOICE WORKLOAD REPORT
D INVHEAD
S ACRDATE=ACRBEGIN-1
F S ACRDATE=$O(^AFSLAFP("J",ACRDATE)) Q:'ACRDATE!(ACRDATE>ACREND) D
.S ACRFYDA=0
.F S ACRFYDA=$O(^AFSLAFP("J",ACRDATE,ACRFYDA)) Q:'ACRFYDA D
..S ACRBATDA=0
..F S ACRBATDA=$O(^AFSLAFP("J",ACRDATE,ACRFYDA,ACRBATDA)) Q:'ACRBATDA D
...S ACREXP=$P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,2)),U)
...S ACRSEQDA=0
...F S ACRSEQDA=$O(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA)) Q:'ACRSEQDA D
....I ACRWHICH=1 D
.....S ACRLCODE=$P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,1)),U,18)
.....S ACRLCODE=$P($G(^AUTTLCOD(+ACRLCODE,0)),U)
....I ACRWHICH=2 D
.....S ACRLCODE=$P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0)),U,3)
.....;S ACRLCODE=$E($P($G(^VA(200,+ACRLCODE,0)),U),1,20) ;ACR*2.1*19.02 IM16848
.....S ACRLCODE=$E($$NAME2^ACRFUTL1(+ACRLCODE),1,20) ;ACR*2.1*19.02 IM16848
....S:ACRLCODE="" ACRLCODE="NOT STATED"
....S:'$D(^TMP("ACRINVR",$J,ACRLCODE)) ^TMP("ACRINVR",$J,ACRLCODE)=""
....S (ACRFOR,ACRTV)=""
....I $P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0)),U,24) S ACRTV=1
....E S ACRFOR=$S($L($P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,2)),U,2))>3:$P(^(2),U,2),1:$P($G(^(2)),U,14))
....I ACRFOR]"" D I 1
.....S:$L(ACRFOR,",") ACRFOR=$L(ACRFOR,",")
.....S:$L(ACRFOR,";") ACRFOR=$L(ACRFOR,";")
....E S ACRFOR=1
....I 'ACRTV S $P(^TMP("ACRINVR",$J,ACRLCODE),U,$S(ACREXP:1,1:2))=$P(^TMP("ACRINVR",$J,ACRLCODE),U,$S(ACREXP:1,1:2))+ACRFOR
....E S $P(^TMP("ACRINVR",$J,ACRLCODE),U,$S(ACREXP:3,1:4))=$P(^TMP("ACRINVR",$J,ACRLCODE),U,$S(ACREXP:3,1:4))+1
S (ACR1,ACR2,ACR3,ACR4)=0
S ACRLCODE=""
F S ACRLCODE=$O(^TMP("ACRINVR",$J,ACRLCODE)) Q:ACRLCODE=""!$D(ACRQUIT) D
.W:ACRWHICH=1 !?10,ACRLCODE
.W:ACRWHICH=2 !,ACRLCODE
.W ?22,$J($P(^TMP("ACRINVR",$J,ACRLCODE),U),5),?32,$J($P(^(ACRLCODE),U,2),5),?42,$J($P(^TMP("ACRINVR",$J,ACRLCODE),U,3),5),?52,$J($P(^(ACRLCODE),U,4),5)
.N J
.F J=1:1:4 S @("ACR"_J)=@("ACR"_J)+$P(^TMP("ACRINVR",$J,ACRLCODE),U,J)
.I IOSL-4<$Y D PAUSE^ACRFWARN Q:$D(ACRQUIT) D INVHEAD
W !?22,"-------",?32,"-------",?42,"-------",?52,"-------"
W !?13,"TOTALS:",?22,$J(ACR1,5),?32,$J(ACR2,5),?42,$J(ACR3,5),?52,$J(ACR4,5)
D PAUSE^ACRFWARN
Q
INVHEAD ;
W @IOF
W !?10,"INVOICE WORKLOAD REPORT"
W !?10,"REPORT DATE: "
S Y=DT
X ^DD("DD")
W Y
S ACRDC=$G(ACRDC)+1
W ?55,"PAGE: ",ACRDC
W !?10,"REPORT FROM: "
S Y=ACRBEGIN
X ^DD("DD")
W Y
W !?10,"REPORT TO..: "
S Y=ACREND
X ^DD("DD")
W Y
W !!?22,"VENDOR PAYMENTS",?42,"TRAVEL PAYMENTS"
W:ACRWHICH=1 !?10,"LOCATION"
W:ACRWHICH=2 !,"DATA ENTRY PERSONNEL"
W ?22,"PAID",?32,"PENDING",?42,"PAID",?52,"PENDING"
W:ACRWHICH=1 !?10,"--------"
W:ACRWHICH=2 !,"--------------------"
W ?22,"-------",?32,"-------",?42,"-------",?52,"-------"
Q
VALCHK ;EP;TO CHECK VALIDITY OF BATCH RECORDS
N X,Y,Z,K,A
S ACRSEQDA=0
F S ACRSEQDA=$O(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA)) Q:'ACRSEQDA D ;ACR*2.1*5.05
.S X=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0)) ;ACR*2.1*5.05
.S Y=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,1)) ;ACR*2.1*5.05
.S A=$G(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,2)) ;ACR*2.1*5.05
.K ACRQUIT ;ACR*2.1*5.05
.I X=""!(Y="")!(A="") D ;ACR*2.1*5.05
..W !!,"File ",ACRFYDA_","_ACRBATDA_","_ACRSEQDA ;ACR*2.1*5.05
..W " is corrupt, report to Site Manager" ;ACR*2.1*5.05
..S ACRQUIT="" ;ACR*2.1*5.05
.I $P(X,U,10) D ;ACR*2.1*5.05
..S:$L($P($G(^AUTTVNDR($P(X,U,10),11)),U))'=10 Z=$P($G(^AUTTVNDR($P(X,U,10),0)),U) ;ACR*2.1*5.05
..S K=$G(^AUTTVNDR($P(X,U,10),19)) ;ACR*2.1*5.05
.I $P(X,U,24) D ;ACR*2.1*5.05
..;S:$L($P($G(^VA(200,$P(X,U,24),1)),U,9))'=9 Z=$P($G(^VA(200,$P(X,U,24),0)),U) ;ACR*2.1*5.05 ;ACR*2.1*19.02 IM16848
..S:$L($P($G(^VA(200,$P(X,U,24),1)),U,9))'=9 Z=$$NAME2^ACRFUTL1($P(X,U,24)) ;ACR*2.1*19.02 IM16848
..S K=$G(^VA(200,$P(X,U,24),19)) ;ACR*2.1*5.05
.I $G(Z)]"" D
..W:$G(Z)]"" !!,"The EIN for ",Z," is missing or incorrect."
..S ACRQUIT=""
.I $G(ACRBTYP)]"","AB"[ACRBTYP,$P(K,U)=""!($P(K,U,2)="")!($P(K,U,3)="") D
..W !!,"The Bank Routing Information is missing or incorrect."
..S ACRQUIT=""
.I '$P(X,U,10),'$P(X,U,24) D
..W !!,"I can't determine who you are trying to pay."
..S ACRQUIT=""
.I $P(X,U,28)="" W !!,"Street Address is missing " S ACRQUIT=""
.I $P(Y,U)="" W !!,"City is missing " S ACRQUIT=""
.I $P(Y,U,2)="" W !!,"State is missing " S ACRQUIT=""
.I $P(Y,U,3)="" W !!,"Zipcode is missing " S ACRQUIT=""
.I $P(X,U,14)="",$P(A,U,2)="",$P(A,U,14)="" W !!,"ACH-Addendum/Paid For information is missing." S ACRQUIT=""
.Q:'$D(ACRQUIT)
.W !,"Sequence NO.: ",$P(X,U) ;ACR*2.1*5.14
.W !,"Batch NO....: ",$P($G(^AFSLAFP(ACRFYDA,1,ACRBATDA,0)),U) ;ACR*2.1*5.14
.W !,"Fiscal Year.: ",$P($G(^AFSLAFP(ACRFYDA,0)),U) ;ACR*2.1*5.14
.W !!,"This data must be updated before the batch can be exported."
.D PAUSE^ACRFWARN
.K ACROUT
.S ACRQUIT=""
Q
ACRFPAY5 ;IHS/OIRM/DSD/THL,AEF - MISC PM REPORTS; [ 09/23/2005 9:40 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**5,19**;NOV 05, 2001
+2 ;;
+3 QUIT
INVRPT ;EP;TO PRINT INVOICE WORKLOAD REPORT
+1 FOR
DO INV1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
INVEXIT KILL ACRQUIT,ACROUT,ACRDUE,ACRDC,ACRBEGIN,ACRDATE,ACREND,ACREXP,ACRFOR,ACRTV
+1 KILL ^TMP("ACRINVR",$JOB)
+2 QUIT
INV1 ;
+1 KILL ^TMP("ACRINVR",$JOB)
+2 WRITE @IOF
+3 WRITE !?10,"Select beginning and ending dates for INVOICE WORKLOAD REPORT"
+4 WRITE !
+5 DO ^ACRFDATE
+6 IF '$GET(ACRBEGIN)!'$GET(ACREND)
SET ACRQUIT=""
QUIT
+7 SET DIR(0)="SO^1:Report by LOCATION;2:Report by DATA ENTRY Personnel"
+8 SET DIR("A")="Which report"
+9 SET DIR("B")=1
+10 WRITE !
+11 DO DIR^ACRFDIC
+12 IF 'Y
SET ACRQUIT=""
QUIT
+13 NEW ACRWHICH
+14 SET ACRWHICH=Y
+15 SET (ACRRTN,ZTRTN)="INV2^ACRFPAY5"
+16 SET ZTDESC="INVOICE WORKLOAD REPORT"
+17 DO ^ACRFZIS
+18 QUIT
INV2 ;EP;TO PRINT INVOICE WORKLOAD REPORT
+1 DO INVHEAD
+2 SET ACRDATE=ACRBEGIN-1
+3 FOR
SET ACRDATE=$ORDER(^AFSLAFP("J",ACRDATE))
IF 'ACRDATE!(ACRDATE>ACREND)
QUIT
Begin DoDot:1
+4 SET ACRFYDA=0
+5 FOR
SET ACRFYDA=$ORDER(^AFSLAFP("J",ACRDATE,ACRFYDA))
IF 'ACRFYDA
QUIT
Begin DoDot:2
+6 SET ACRBATDA=0
+7 FOR
SET ACRBATDA=$ORDER(^AFSLAFP("J",ACRDATE,ACRFYDA,ACRBATDA))
IF 'ACRBATDA
QUIT
Begin DoDot:3
+8 SET ACREXP=$PIECE($GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,2)),U)
+9 SET ACRSEQDA=0
+10 FOR
SET ACRSEQDA=$ORDER(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA))
IF 'ACRSEQDA
QUIT
Begin DoDot:4
+11 IF ACRWHICH=1
Begin DoDot:5
+12 SET ACRLCODE=$PIECE($GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,1)),U,18)
+13 SET ACRLCODE=$PIECE($GET(^AUTTLCOD(+ACRLCODE,0)),U)
End DoDot:5
+14 IF ACRWHICH=2
Begin DoDot:5
+15 SET ACRLCODE=$PIECE($GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0)),U,3)
+16 ;S ACRLCODE=$E($P($G(^VA(200,+ACRLCODE,0)),U),1,20) ;ACR*2.1*19.02 IM16848
+17 ;ACR*2.1*19.02 IM16848
SET ACRLCODE=$EXTRACT($$NAME2^ACRFUTL1(+ACRLCODE),1,20)
End DoDot:5
+18 IF ACRLCODE=""
SET ACRLCODE="NOT STATED"
+19 IF '$DATA(^TMP("ACRINVR",$JOB,ACRLCODE))
SET ^TMP("ACRINVR",$JOB,ACRLCODE)=""
+20 SET (ACRFOR,ACRTV)=""
+21 IF $PIECE($GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0)),U,24)
SET ACRTV=1
+22 IF '$TEST
SET ACRFOR=$SELECT($LENGTH($PIECE($GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,2)),U,2))>3:$PIECE(^(2),U,2),1:$PIECE($GET(^(2)),U,14))
+23 IF ACRFOR]""
Begin DoDot:5
+24 IF $LENGTH(ACRFOR,",")
SET ACRFOR=$LENGTH(ACRFOR,",")
+25 IF $LENGTH(ACRFOR,";")
SET ACRFOR=$LENGTH(ACRFOR,";")
End DoDot:5
IF 1
+26 IF '$TEST
SET ACRFOR=1
+27 IF 'ACRTV
SET $PIECE(^TMP("ACRINVR",$JOB,ACRLCODE),U,$SELECT(ACREXP:1,1:2))=$PIECE(^TMP("ACRINVR",$JOB,ACRLCODE),U,$SELECT(ACREXP:1,1:2))+ACRFOR
+28 IF '$TEST
SET $PIECE(^TMP("ACRINVR",$JOB,ACRLCODE),U,$SELECT(ACREXP:3,1:4))=$PIECE(^TMP("ACRINVR",$JOB,ACRLCODE),U,$SELECT(ACREXP:3,1:4))+1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+29 SET (ACR1,ACR2,ACR3,ACR4)=0
+30 SET ACRLCODE=""
+31 FOR
SET ACRLCODE=$ORDER(^TMP("ACRINVR",$JOB,ACRLCODE))
IF ACRLCODE=""!$DATA(ACRQUIT)
QUIT
Begin DoDot:1
+32 IF ACRWHICH=1
WRITE !?10,ACRLCODE
+33 IF ACRWHICH=2
WRITE !,ACRLCODE
+34 WRITE ?22,$JUSTIFY($PIECE(^TMP("ACRINVR",$JOB,ACRLCODE),U),5),?32,$JUSTIFY($PIECE(^(ACRLCODE),U,2),5),?42,$JUSTIFY($PIECE(^TMP("ACRINVR",$JOB,ACRLCODE),U,3),5),?52,$JUSTIFY($PIECE(^(ACRLCODE),U,4),5)
+35 NEW J
+36 FOR J=1:1:4
SET @("ACR"_J)=@("ACR"_J)+$PIECE(^TMP("ACRINVR",$JOB,ACRLCODE),U,J)
+37 IF IOSL-4<$Y
DO PAUSE^ACRFWARN
IF $DATA(ACRQUIT)
QUIT
DO INVHEAD
End DoDot:1
+38 WRITE !?22,"-------",?32,"-------",?42,"-------",?52,"-------"
+39 WRITE !?13,"TOTALS:",?22,$JUSTIFY(ACR1,5),?32,$JUSTIFY(ACR2,5),?42,$JUSTIFY(ACR3,5),?52,$JUSTIFY(ACR4,5)
+40 DO PAUSE^ACRFWARN
+41 QUIT
INVHEAD ;
+1 WRITE @IOF
+2 WRITE !?10,"INVOICE WORKLOAD REPORT"
+3 WRITE !?10,"REPORT DATE: "
+4 SET Y=DT
+5 XECUTE ^DD("DD")
+6 WRITE Y
+7 SET ACRDC=$GET(ACRDC)+1
+8 WRITE ?55,"PAGE: ",ACRDC
+9 WRITE !?10,"REPORT FROM: "
+10 SET Y=ACRBEGIN
+11 XECUTE ^DD("DD")
+12 WRITE Y
+13 WRITE !?10,"REPORT TO..: "
+14 SET Y=ACREND
+15 XECUTE ^DD("DD")
+16 WRITE Y
+17 WRITE !!?22,"VENDOR PAYMENTS",?42,"TRAVEL PAYMENTS"
+18 IF ACRWHICH=1
WRITE !?10,"LOCATION"
+19 IF ACRWHICH=2
WRITE !,"DATA ENTRY PERSONNEL"
+20 WRITE ?22,"PAID",?32,"PENDING",?42,"PAID",?52,"PENDING"
+21 IF ACRWHICH=1
WRITE !?10,"--------"
+22 IF ACRWHICH=2
WRITE !,"--------------------"
+23 WRITE ?22,"-------",?32,"-------",?42,"-------",?52,"-------"
+24 QUIT
VALCHK ;EP;TO CHECK VALIDITY OF BATCH RECORDS
+1 NEW X,Y,Z,K,A
+2 SET ACRSEQDA=0
+3 ;ACR*2.1*5.05
FOR
SET ACRSEQDA=$ORDER(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA))
IF 'ACRSEQDA
QUIT
Begin DoDot:1
+4 ;ACR*2.1*5.05
SET X=$GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,0))
+5 ;ACR*2.1*5.05
SET Y=$GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,1))
+6 ;ACR*2.1*5.05
SET A=$GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,1,ACRSEQDA,2))
+7 ;ACR*2.1*5.05
KILL ACRQUIT
+8 ;ACR*2.1*5.05
IF X=""!(Y="")!(A="")
Begin DoDot:2
+9 ;ACR*2.1*5.05
WRITE !!,"File ",ACRFYDA_","_ACRBATDA_","_ACRSEQDA
+10 ;ACR*2.1*5.05
WRITE " is corrupt, report to Site Manager"
+11 ;ACR*2.1*5.05
SET ACRQUIT=""
End DoDot:2
+12 ;ACR*2.1*5.05
IF $PIECE(X,U,10)
Begin DoDot:2
+13 ;ACR*2.1*5.05
IF $LENGTH($PIECE($GET(^AUTTVNDR($PIECE(X,U,10),11)),U))'=10
SET Z=$PIECE($GET(^AUTTVNDR($PIECE(X,U,10),0)),U)
+14 ;ACR*2.1*5.05
SET K=$GET(^AUTTVNDR($PIECE(X,U,10),19))
End DoDot:2
+15 ;ACR*2.1*5.05
IF $PIECE(X,U,24)
Begin DoDot:2
+16 ;S:$L($P($G(^VA(200,$P(X,U,24),1)),U,9))'=9 Z=$P($G(^VA(200,$P(X,U,24),0)),U) ;ACR*2.1*5.05 ;ACR*2.1*19.02 IM16848
+17 ;ACR*2.1*19.02 IM16848
IF $LENGTH($PIECE($GET(^VA(200,$PIECE(X,U,24),1)),U,9))'=9
SET Z=$$NAME2^ACRFUTL1($PIECE(X,U,24))
+18 ;ACR*2.1*5.05
SET K=$GET(^VA(200,$PIECE(X,U,24),19))
End DoDot:2
+19 IF $GET(Z)]""
Begin DoDot:2
+20 IF $GET(Z)]""
WRITE !!,"The EIN for ",Z," is missing or incorrect."
+21 SET ACRQUIT=""
End DoDot:2
+22 IF $GET(ACRBTYP)]""
IF "AB"[ACRBTYP
IF $PIECE(K,U)=""!($PIECE(K,U,2)="")!($PIECE(K,U,3)="")
Begin DoDot:2
+23 WRITE !!,"The Bank Routing Information is missing or incorrect."
+24 SET ACRQUIT=""
End DoDot:2
+25 IF '$PIECE(X,U,10)
IF '$PIECE(X,U,24)
Begin DoDot:2
+26 WRITE !!,"I can't determine who you are trying to pay."
+27 SET ACRQUIT=""
End DoDot:2
+28 IF $PIECE(X,U,28)=""
WRITE !!,"Street Address is missing "
SET ACRQUIT=""
+29 IF $PIECE(Y,U)=""
WRITE !!,"City is missing "
SET ACRQUIT=""
+30 IF $PIECE(Y,U,2)=""
WRITE !!,"State is missing "
SET ACRQUIT=""
+31 IF $PIECE(Y,U,3)=""
WRITE !!,"Zipcode is missing "
SET ACRQUIT=""
+32 IF $PIECE(X,U,14)=""
IF $PIECE(A,U,2)=""
IF $PIECE(A,U,14)=""
WRITE !!,"ACH-Addendum/Paid For information is missing."
SET ACRQUIT=""
+33 IF '$DATA(ACRQUIT)
QUIT
+34 ;ACR*2.1*5.14
WRITE !,"Sequence NO.: ",$PIECE(X,U)
+35 ;ACR*2.1*5.14
WRITE !,"Batch NO....: ",$PIECE($GET(^AFSLAFP(ACRFYDA,1,ACRBATDA,0)),U)
+36 ;ACR*2.1*5.14
WRITE !,"Fiscal Year.: ",$PIECE($GET(^AFSLAFP(ACRFYDA,0)),U)
+37 WRITE !!,"This data must be updated before the batch can be exported."
+38 DO PAUSE^ACRFWARN
+39 KILL ACROUT
+40 SET ACRQUIT=""
End DoDot:1
+41 QUIT