ACRFRR12 ;IHS/OIRM/DSD/THL,AEF - DISPALY AND EDIT RECEIVING REPORT/INVOICE AUDIT - CON'T; [ 07/20/2006 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**20**;NOV 05, 2001
;;CONTINUATION OF ACRFRR11
PVN ;EP;
K ACRQUIT
N X,Y,Z
S X=0
F S X=$O(^ACRRR("AC",ACRDOCDA,ACRRRNO,X)) Q:'X!$D(ACRQUIT)!$D(ACROUT) D
.S Z=$O(^ACRRR("AC",ACRDOCDA,ACRRRNO,X,0))
.Q:'Z
.Q:'$D(^ACRRR(Z,0)) Q:$P(^(0),U,13)]"" S Y=+^(0)
.S Y=$P($G(^ACRSS(Y,0)),U,4)
.I $D(^AUTTOBJC(+Y,0)),$E($P(^(0),U),1,2)="26" S ACRQUIT=""
Q:'$D(ACRQUIT)
K ACRQUIT
S ACRFY=$S($E(DT,4,5)<10:$E(DT,1,3)+1700,1:($E(DT,1,3)+1)+1700)
PVNMON S DIR(0)="N^1:12"
S DIR("A")="Enter Property Voucher Number MONTH"
S DIR("B")=+$E(DT,4,5)
W !
D DIR^ACRFDIC
I '+Y D G PVNMON
.W !!,"You are required to enter the MONTH for this Property Voucher Number."
.W !,"You cannot exit without entering the MONTH which will be used for this"
.W !,"Property Voucher Number."
S ACRMONTH=+Y
S ACRLCDA=$P(^ACRLOCB(ACRLBDA,"DT"),U,11)
;Begin old code ;ACR*2.1*20.05 IM17144
;D PVNCHK^ACRFPVN ;ACR*2.1*20.05 IM17144
;Begin new code ;ACR*2.1*20.05 IM17144
S ACRPVN=$$PVNCHK^ACRFPVN(ACRLCDA,ACRFY,ACRMONTH,.ACRPVN) ;ACR*2.1*20.05 IM17144
;End new code ;ACR*2.1*20.05 IM17144
W !!,"Property Voucher Number ",ACRPVN," (with correct sequence) will be assigned."
K ACRPVN
S DIR(0)="YO"
S DIR("A")="Is this correct"
S DIR("B")="YES"
W !
D DIR^ACRFDIC
I +Y'=1 G PVNMON
D SET^ACRFPVN
S X=ACRPVN
S DA(1)=ACRDOCDA
S DIC="^ACRDOC("_DA(1)_",8,"
S DIC(0)="L"
S:'$D(^ACRDOC(ACRDOCDA,8,0))#2 ^ACRDOC(ACRDOCDA,8,0)="^9002196.801"
D FILE^ACRFDIC
Q
PVNPRINT ;EP;TO PRINT THE PROPERTY VOUCHER REPORT
F D PVNP Q:$D(ACRQUIT)!$D(ACROUT)
K ACRQUIT,ACROUT
Q
PVNP N ACRDC,ACRBEGIN,ACREND,ACRB,ACRE,ACRX,ACRLOC,ACRDOC0,ACRDOCDA,ACRLOCX,ACRXX,ACRRTN,ACRJ,ACRTOT
W @IOF
W !?10,"Enter the beginning and ending dates for this"
W !?10,"Property Voucher Register Report",!!
D DATES^ACRFDATE
I '$G(ACRBEGIN) S ACRQUIT="" Q
S ACRBEGIN=($E(ACRBEGIN,1,3)+1700)_"-"_$E(ACRBEGIN,4,5)
S ACRB=$TR(ACRBEGIN,"-","")
S ACREND=($E(ACREND,1,3)+1700)_"-"_$E(ACREND,4,5)
S ACRE=$TR(ACREND,"-","")
S DIR(0)="YO"
S DIR("A")="Print the Report for ALL Locations"
S DIR("B")="YES"
W !
D DIR^ACRFDIC
Q:$D(ACRQUIT)!$D(ACROUT)
I +Y=1 S ACRLOC="000"
I '$D(ACRLOC) D
.S DIC="^AUTTLCOD("
.S DIC(0)="AEMZQ"
.S DIC("A")="Which LOCATION CODE: "
.D DIC^ACRFDIC
.Q:$D(ACRQUIT)!$D(ACROUT)!($G(Y)<1)
.S ACRLOC=$P(^AUTTLCOD(+Y,0),U)
Q:'$D(ACRLOC)
D ZIS
Q
ZIS ;SELECT DEVICE
S (ZTRTN,ACRRTN)="P^ACRFRR12"
S ZTDESC="Property Voucher Report"
D ^ACRFZIS
Q
P ;EP -- PRINT PROPERTY VOUCHER REPORT
;
N ACRB,ACRDC,ACRDOC0,ACRDOCDA,ACRE,ACRFINAL,ACRJ,ACRLOCX,ACRRRDA,ACRRRDT,ACRTOT,ACRTYPE,ACRX,ACRZ,J,X,Y,Z
K ^TMP("ACRPV",$J)
S ACRLOCX=$S(ACRLOC="000":"ALL",1:ACRLOC)
S ACRX=ACRLOC_"-0000-00-0000"
D LOOP
Q:'$D(^TMP("ACRPV",$J))
D PRINT
K ^TMP("ACRPV",$J)
Q
LOOP ;----- LOOP THROUGH RECEIVING REPORTS AND GATHER DATA
;
F S ACRX=$O(^ACRRR("PVN",ACRX)) Q:ACRX=""!($G(ACRLOCX)'="ALL"&($E(ACRX,1,3)'=ACRLOC)) D
. S ACRZ=$P(ACRX,"-",2)
. I $L(ACRZ)=4 S ACRZ=$E(ACRZ,3,4)
. S X=$P(ACRX,"-",3)_"01"_ACRZ
. D ^%DT
. S X=Y
. S X=$E(Y,1,3)+1700_$E(Y,4,5)
. S ACRB=$TR(ACRBEGIN,"-","")
. S ACRE=$TR(ACREND,"-","")
. Q:(X<ACRB)!(X>ACRE)
. S (J,Y,Z)=0
. S ACRRRDA=0
. F S ACRRRDA=$O(^ACRRR("PVN",ACRX,ACRRRDA)) Q:'ACRRRDA D
. . S X=$G(^ACRRR(ACRRRDA,0))
. . S ACRDOCDA=$P(X,U,2)
. . S ACRRRDT=$G(^ACRRR(ACRRRDA,"DT"))
. . S ACRDOC0=^ACRDOC(ACRDOCDA,0)
. . S J=J+1,ACRJ=$G(ACRJ)+1
. . S Y=Y+($P($G(^ACRSS(+X,"DT")),U,3)*$P(ACRRRDT,U,3))
. . S ACRFINAL=$P(X,U,8)
. . S X=+X
. . S Z=$P($G(^ACRSS(+X,0)),U,4)
. . I $D(^AUTTOBJC(+Z,0)),$E($P(^(0),U),1,2)="26" S ACRTYPE=$P(^(0),U,8)
. . S ACRTYPE=$S($G(ACRTYPE)="S":"SS",1:"DI")
. . S ACRTOT=$G(ACRTOT)+$P($G(^ACRSS(X,"DT")),U,4)
. S ^TMP("ACRPV",$J,"D",ACRX)=$S($P(ACRDOC0,U,2)="":$P(ACRDOC0,U),1:$P(ACRDOC0,U,2))_U_ACRTYPE_U_J_U_Y
. S $P(^TMP("ACRPV",$J,"TOTAL",$E(ACRX,1,3)),U)=$P($G(^TMP("ACRPV",$J,"TOTAL",$E(ACRX,1,3))),U)+J
. S $P(^TMP("ACRPV",$J,"TOTAL",$E(ACRX,1,3)),U,2)=$P($G(^TMP("ACRPV",$J,"TOTAL",$E(ACRX,1,3))),U,2)+Y
. S $P(^TMP("ACRPV",$J,"ZGRANDTOTAL"),U)=$P($G(^TMP("ACRPV",$J,"ZGRANDTOTAL")),U)+J
. S $P(^TMP("ACRPV",$J,"ZGRANDTOTAL"),U,2)=$P($G(^TMP("ACRPV",$J,"ZGRANDTOTAL")),U,2)+Y
Q
PRINT ;----- PRINT THE REPORT
;
N ACRDC,ACRPVN,ACRQUIT,ACRX,DATA
S ACRPVN="" F S ACRPVN=$O(^TMP("ACRPV",$J,"D",ACRPVN)) Q:ACRPVN']"" D Q:$D(ACRQUIT)
. I $G(ACRX)'=$E(ACRPVN,1,3) D Q:$D(ACRQUIT)
. . D PVNTOT
. . Q:$D(ACRQUIT)
. . D PHEAD
. . S ACRX=$E(ACRPVN,1,3)
. S DATA=^TMP("ACRPV",$J,"D",ACRPVN)
. W !,ACRPVN
. W ?16,"|",$P(DATA,U)
. W ?31,"|",$J($P(DATA,U,2),3)
. W ?37,"|",$J($P(DATA,U,3),6)
. W ?45,"|",$J($FN($P(DATA,U,4),"P",2),13)
. I $Y>($G(IOSL)-4) D PAUSE^ACRFWARN Q:$D(ACRQUIT) D PHEAD
Q:$D(ACRQUIT)
D PVNTOT
Q
PHEAD ;PVN REPORT HEADER
W @IOF
S ACRDC=$G(ACRDC)+1
W !,"Property Voucher Register"
W !,"Report Date: "
S Y=DT
X ^DD("DD")
W Y
W !,"Report From: ",ACRBEGIN
W ?43,"Accounting Point: ",$P($G(^AUTTACPT(+$P($G(^ACRPO(1,0)),U,4),0)),U)
W !,"Report To..: ",ACREND,?55,"Page: ",$G(ACRDC)
W $$DASH^ACRFMENU
W !,"VOUCHER",?16,"|PURCHASE ORDER",?31,"|",?37,"|# OF",?45,"|"
W !,"SERIAL NO.",?16,"|NUMBER",?31,"|TYPE",?37,"|ITEMS",?45,"|VALUE"
PH W !,"----------------",?16,"|--------------",?31,"|-----",?37,"|-------",?45,"|------------"
Q
PVNTOT ;----- WRITE TOTAL
Q:$G(ACRX)=""
S DATA=^TMP("ACRPV",$J,"TOTAL",ACRX)
D PH
W !?37,"|",$J($P(DATA,U),6)
W ?45,"|",$J($FN($P(DATA,U,2),"P",2),13)
D PAUSE^ACRFWARN
Q
ACRFRR12 ;IHS/OIRM/DSD/THL,AEF - DISPALY AND EDIT RECEIVING REPORT/INVOICE AUDIT - CON'T; [ 07/20/2006 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**20**;NOV 05, 2001
+2 ;;CONTINUATION OF ACRFRR11
PVN ;EP;
+1 KILL ACRQUIT
+2 NEW X,Y,Z
+3 SET X=0
+4 FOR
SET X=$ORDER(^ACRRR("AC",ACRDOCDA,ACRRRNO,X))
IF 'X!$DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
Begin DoDot:1
+5 SET Z=$ORDER(^ACRRR("AC",ACRDOCDA,ACRRRNO,X,0))
+6 IF 'Z
QUIT
+7 IF '$DATA(^ACRRR(Z,0))
QUIT
IF $PIECE(^(0),U,13)]""
QUIT
SET Y=+^(0)
+8 SET Y=$PIECE($GET(^ACRSS(Y,0)),U,4)
+9 IF $DATA(^AUTTOBJC(+Y,0))
IF $EXTRACT($PIECE(^(0),U),1,2)="26"
SET ACRQUIT=""
End DoDot:1
+10 IF '$DATA(ACRQUIT)
QUIT
+11 KILL ACRQUIT
+12 SET ACRFY=$SELECT($EXTRACT(DT,4,5)<10:$EXTRACT(DT,1,3)+1700,1:($EXTRACT(DT,1,3)+1)+1700)
PVNMON SET DIR(0)="N^1:12"
+1 SET DIR("A")="Enter Property Voucher Number MONTH"
+2 SET DIR("B")=+$EXTRACT(DT,4,5)
+3 WRITE !
+4 DO DIR^ACRFDIC
+5 IF '+Y
Begin DoDot:1
+6 WRITE !!,"You are required to enter the MONTH for this Property Voucher Number."
+7 WRITE !,"You cannot exit without entering the MONTH which will be used for this"
+8 WRITE !,"Property Voucher Number."
End DoDot:1
GOTO PVNMON
+9 SET ACRMONTH=+Y
+10 SET ACRLCDA=$PIECE(^ACRLOCB(ACRLBDA,"DT"),U,11)
+11 ;Begin old code ;ACR*2.1*20.05 IM17144
+12 ;D PVNCHK^ACRFPVN ;ACR*2.1*20.05 IM17144
+13 ;Begin new code ;ACR*2.1*20.05 IM17144
+14 ;ACR*2.1*20.05 IM17144
SET ACRPVN=$$PVNCHK^ACRFPVN(ACRLCDA,ACRFY,ACRMONTH,.ACRPVN)
+15 ;End new code ;ACR*2.1*20.05 IM17144
+16 WRITE !!,"Property Voucher Number ",ACRPVN," (with correct sequence) will be assigned."
+17 KILL ACRPVN
+18 SET DIR(0)="YO"
+19 SET DIR("A")="Is this correct"
+20 SET DIR("B")="YES"
+21 WRITE !
+22 DO DIR^ACRFDIC
+23 IF +Y'=1
GOTO PVNMON
+24 DO SET^ACRFPVN
+25 SET X=ACRPVN
+26 SET DA(1)=ACRDOCDA
+27 SET DIC="^ACRDOC("_DA(1)_",8,"
+28 SET DIC(0)="L"
+29 IF '$DATA(^ACRDOC(ACRDOCDA,8,0))#2
SET ^ACRDOC(ACRDOCDA,8,0)="^9002196.801"
+30 DO FILE^ACRFDIC
+31 QUIT
PVNPRINT ;EP;TO PRINT THE PROPERTY VOUCHER REPORT
+1 FOR
DO PVNP
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+2 KILL ACRQUIT,ACROUT
+3 QUIT
PVNP NEW ACRDC,ACRBEGIN,ACREND,ACRB,ACRE,ACRX,ACRLOC,ACRDOC0,ACRDOCDA,ACRLOCX,ACRXX,ACRRTN,ACRJ,ACRTOT
+1 WRITE @IOF
+2 WRITE !?10,"Enter the beginning and ending dates for this"
+3 WRITE !?10,"Property Voucher Register Report",!!
+4 DO DATES^ACRFDATE
+5 IF '$GET(ACRBEGIN)
SET ACRQUIT=""
QUIT
+6 SET ACRBEGIN=($EXTRACT(ACRBEGIN,1,3)+1700)_"-"_$EXTRACT(ACRBEGIN,4,5)
+7 SET ACRB=$TRANSLATE(ACRBEGIN,"-","")
+8 SET ACREND=($EXTRACT(ACREND,1,3)+1700)_"-"_$EXTRACT(ACREND,4,5)
+9 SET ACRE=$TRANSLATE(ACREND,"-","")
+10 SET DIR(0)="YO"
+11 SET DIR("A")="Print the Report for ALL Locations"
+12 SET DIR("B")="YES"
+13 WRITE !
+14 DO DIR^ACRFDIC
+15 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+16 IF +Y=1
SET ACRLOC="000"
+17 IF '$DATA(ACRLOC)
Begin DoDot:1
+18 SET DIC="^AUTTLCOD("
+19 SET DIC(0)="AEMZQ"
+20 SET DIC("A")="Which LOCATION CODE: "
+21 DO DIC^ACRFDIC
+22 IF $DATA(ACRQUIT)!$DATA(ACROUT)!($GET(Y)<1)
QUIT
+23 SET ACRLOC=$PIECE(^AUTTLCOD(+Y,0),U)
End DoDot:1
+24 IF '$DATA(ACRLOC)
QUIT
+25 DO ZIS
+26 QUIT
ZIS ;SELECT DEVICE
+1 SET (ZTRTN,ACRRTN)="P^ACRFRR12"
+2 SET ZTDESC="Property Voucher Report"
+3 DO ^ACRFZIS
+4 QUIT
P ;EP -- PRINT PROPERTY VOUCHER REPORT
+1 ;
+2 NEW ACRB,ACRDC,ACRDOC0,ACRDOCDA,ACRE,ACRFINAL,ACRJ,ACRLOCX,ACRRRDA,ACRRRDT,ACRTOT,ACRTYPE,ACRX,ACRZ,J,X,Y,Z
+3 KILL ^TMP("ACRPV",$JOB)
+4 SET ACRLOCX=$SELECT(ACRLOC="000":"ALL",1:ACRLOC)
+5 SET ACRX=ACRLOC_"-0000-00-0000"
+6 DO LOOP
+7 IF '$DATA(^TMP("ACRPV",$JOB))
QUIT
+8 DO PRINT
+9 KILL ^TMP("ACRPV",$JOB)
+10 QUIT
LOOP ;----- LOOP THROUGH RECEIVING REPORTS AND GATHER DATA
+1 ;
+2 FOR
SET ACRX=$ORDER(^ACRRR("PVN",ACRX))
IF ACRX=""!($GET(ACRLOCX)'="ALL"&($EXTRACT(ACRX,1,3)'=ACRLOC))
QUIT
Begin DoDot:1
+3 SET ACRZ=$PIECE(ACRX,"-",2)
+4 IF $LENGTH(ACRZ)=4
SET ACRZ=$EXTRACT(ACRZ,3,4)
+5 SET X=$PIECE(ACRX,"-",3)_"01"_ACRZ
+6 DO ^%DT
+7 SET X=Y
+8 SET X=$EXTRACT(Y,1,3)+1700_$EXTRACT(Y,4,5)
+9 SET ACRB=$TRANSLATE(ACRBEGIN,"-","")
+10 SET ACRE=$TRANSLATE(ACREND,"-","")
+11 IF (X<ACRB)!(X>ACRE)
QUIT
+12 SET (J,Y,Z)=0
+13 SET ACRRRDA=0
+14 FOR
SET ACRRRDA=$ORDER(^ACRRR("PVN",ACRX,ACRRRDA))
IF 'ACRRRDA
QUIT
Begin DoDot:2
+15 SET X=$GET(^ACRRR(ACRRRDA,0))
+16 SET ACRDOCDA=$PIECE(X,U,2)
+17 SET ACRRRDT=$GET(^ACRRR(ACRRRDA,"DT"))
+18 SET ACRDOC0=^ACRDOC(ACRDOCDA,0)
+19 SET J=J+1
SET ACRJ=$GET(ACRJ)+1
+20 SET Y=Y+($PIECE($GET(^ACRSS(+X,"DT")),U,3)*$PIECE(ACRRRDT,U,3))
+21 SET ACRFINAL=$PIECE(X,U,8)
+22 SET X=+X
+23 SET Z=$PIECE($GET(^ACRSS(+X,0)),U,4)
+24 IF $DATA(^AUTTOBJC(+Z,0))
IF $EXTRACT($PIECE(^(0),U),1,2)="26"
SET ACRTYPE=$PIECE(^(0),U,8)
+25 SET ACRTYPE=$SELECT($GET(ACRTYPE)="S":"SS",1:"DI")
+26 SET ACRTOT=$GET(ACRTOT)+$PIECE($GET(^ACRSS(X,"DT")),U,4)
End DoDot:2
+27 SET ^TMP("ACRPV",$JOB,"D",ACRX)=$SELECT($PIECE(ACRDOC0,U,2)="":$PIECE(ACRDOC0,U),1:$PIECE(ACRDOC0,U,2))_U_ACRTYPE_U_J_U_Y
+28 SET $PIECE(^TMP("ACRPV",$JOB,"TOTAL",$EXTRACT(ACRX,1,3)),U)=$PIECE($GET(^TMP("ACRPV",$JOB,"TOTAL",$EXTRACT(ACRX,1,3))),U)+J
+29 SET $PIECE(^TMP("ACRPV",$JOB,"TOTAL",$EXTRACT(ACRX,1,3)),U,2)=$PIECE($GET(^TMP("ACRPV",$JOB,"TOTAL",$EXTRACT(ACRX,1,3))),U,2)+Y
+30 SET $PIECE(^TMP("ACRPV",$JOB,"ZGRANDTOTAL"),U)=$PIECE($GET(^TMP("ACRPV",$JOB,"ZGRANDTOTAL")),U)+J
+31 SET $PIECE(^TMP("ACRPV",$JOB,"ZGRANDTOTAL"),U,2)=$PIECE($GET(^TMP("ACRPV",$JOB,"ZGRANDTOTAL")),U,2)+Y
End DoDot:1
+32 QUIT
PRINT ;----- PRINT THE REPORT
+1 ;
+2 NEW ACRDC,ACRPVN,ACRQUIT,ACRX,DATA
+3 SET ACRPVN=""
FOR
SET ACRPVN=$ORDER(^TMP("ACRPV",$JOB,"D",ACRPVN))
IF ACRPVN']""
QUIT
Begin DoDot:1
+4 IF $GET(ACRX)'=$EXTRACT(ACRPVN,1,3)
Begin DoDot:2
+5 DO PVNTOT
+6 IF $DATA(ACRQUIT)
QUIT
+7 DO PHEAD
+8 SET ACRX=$EXTRACT(ACRPVN,1,3)
End DoDot:2
IF $DATA(ACRQUIT)
QUIT
+9 SET DATA=^TMP("ACRPV",$JOB,"D",ACRPVN)
+10 WRITE !,ACRPVN
+11 WRITE ?16,"|",$PIECE(DATA,U)
+12 WRITE ?31,"|",$JUSTIFY($PIECE(DATA,U,2),3)
+13 WRITE ?37,"|",$JUSTIFY($PIECE(DATA,U,3),6)
+14 WRITE ?45,"|",$JUSTIFY($FNUMBER($PIECE(DATA,U,4),"P",2),13)
+15 IF $Y>($GET(IOSL)-4)
DO PAUSE^ACRFWARN
IF $DATA(ACRQUIT)
QUIT
DO PHEAD
End DoDot:1
IF $DATA(ACRQUIT)
QUIT
+16 IF $DATA(ACRQUIT)
QUIT
+17 DO PVNTOT
+18 QUIT
PHEAD ;PVN REPORT HEADER
+1 WRITE @IOF
+2 SET ACRDC=$GET(ACRDC)+1
+3 WRITE !,"Property Voucher Register"
+4 WRITE !,"Report Date: "
+5 SET Y=DT
+6 XECUTE ^DD("DD")
+7 WRITE Y
+8 WRITE !,"Report From: ",ACRBEGIN
+9 WRITE ?43,"Accounting Point: ",$PIECE($GET(^AUTTACPT(+$PIECE($GET(^ACRPO(1,0)),U,4),0)),U)
+10 WRITE !,"Report To..: ",ACREND,?55,"Page: ",$GET(ACRDC)
+11 WRITE $$DASH^ACRFMENU
+12 WRITE !,"VOUCHER",?16,"|PURCHASE ORDER",?31,"|",?37,"|# OF",?45,"|"
+13 WRITE !,"SERIAL NO.",?16,"|NUMBER",?31,"|TYPE",?37,"|ITEMS",?45,"|VALUE"
PH WRITE !,"----------------",?16,"|--------------",?31,"|-----",?37,"|-------",?45,"|------------"
+1 QUIT
PVNTOT ;----- WRITE TOTAL
+1 IF $GET(ACRX)=""
QUIT
+2 SET DATA=^TMP("ACRPV",$JOB,"TOTAL",ACRX)
+3 DO PH
+4 WRITE !?37,"|",$JUSTIFY($PIECE(DATA,U),6)
+5 WRITE ?45,"|",$JUSTIFY($FNUMBER($PIECE(DATA,U,2),"P",2),13)
+6 DO PAUSE^ACRFWARN
+7 QUIT
