Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACRFRR12

ACRFRR12.m

Go to the documentation of this file. 
  1. 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
  1.  ;;CONTINUATION OF ACRFRR11
  1. PVN ;EP;
  1.  K ACRQUIT
  1.  N X,Y,Z
  1.  S X=0
  1.  F  S X=$O(^ACRRR("AC",ACRDOCDA,ACRRRNO,X)) Q:'X!$D(ACRQUIT)!$D(ACROUT)  D
  1.  .S Z=$O(^ACRRR("AC",ACRDOCDA,ACRRRNO,X,0))
  1.  .Q:'Z
  1.  .Q:'$D(^ACRRR(Z,0))  Q:$P(^(0),U,13)]""  S Y=+^(0)
  1.  .S Y=$P($G(^ACRSS(Y,0)),U,4)
  1.  .I $D(^AUTTOBJC(+Y,0)),$E($P(^(0),U),1,2)="26" S ACRQUIT=""
  1.  Q:'$D(ACRQUIT)
  1.  K ACRQUIT
  1.  S ACRFY=$S($E(DT,4,5)<10:$E(DT,1,3)+1700,1:($E(DT,1,3)+1)+1700)
  1. PVNMON S DIR(0)="N^1:12"
  1.  S DIR("A")="Enter Property Voucher Number MONTH"
  1.  S DIR("B")=+$E(DT,4,5)
  1.  W !
  1.  D DIR^ACRFDIC
  1.  I '+Y D  G PVNMON
  1.  .W !!,"You are required to enter the MONTH for this Property Voucher Number."
  1.  .W !,"You cannot exit without entering the MONTH which will be used for this"
  1.  .W !,"Property Voucher Number."
  1.  S ACRMONTH=+Y
  1.  S ACRLCDA=$P(^ACRLOCB(ACRLBDA,"DT"),U,11)
  1.  ;Begin old code                       ;ACR*2.1*20.05  IM17144
  1.  ;D PVNCHK^ACRFPVN                     ;ACR*2.1*20.05  IM17144
  1.  ;Begin new code                       ;ACR*2.1*20.05  IM17144
  1.  S ACRPVN=$$PVNCHK^ACRFPVN(ACRLCDA,ACRFY,ACRMONTH,.ACRPVN)  ;ACR*2.1*20.05  IM17144
  1.  ;End new code                         ;ACR*2.1*20.05  IM17144
  1.  W !!,"Property Voucher Number ",ACRPVN," (with correct sequence) will be assigned."
  1.  K ACRPVN
  1.  S DIR(0)="YO"
  1.  S DIR("A")="Is this correct"
  1.  S DIR("B")="YES"
  1.  W !
  1.  D DIR^ACRFDIC
  1.  I +Y'=1 G PVNMON
  1.  D SET^ACRFPVN
  1.  S X=ACRPVN
  1.  S DA(1)=ACRDOCDA
  1.  S DIC="^ACRDOC("_DA(1)_",8,"
  1.  S DIC(0)="L"
  1.  S:'$D(^ACRDOC(ACRDOCDA,8,0))#2 ^ACRDOC(ACRDOCDA,8,0)="^9002196.801"
  1.  D FILE^ACRFDIC
  1.  Q
  1. PVNPRINT ;EP;TO PRINT THE PROPERTY VOUCHER REPORT
  1.  F  D PVNP Q:$D(ACRQUIT)!$D(ACROUT)
  1.  K ACRQUIT,ACROUT
  1.  Q
  1. PVNP N ACRDC,ACRBEGIN,ACREND,ACRB,ACRE,ACRX,ACRLOC,ACRDOC0,ACRDOCDA,ACRLOCX,ACRXX,ACRRTN,ACRJ,ACRTOT
  1.  W @IOF
  1.  W !?10,"Enter the beginning and ending dates for this"
  1.  W !?10,"Property Voucher Register Report",!!
  1.  D DATES^ACRFDATE
  1.  I '$G(ACRBEGIN) S ACRQUIT="" Q
  1.  S ACRBEGIN=($E(ACRBEGIN,1,3)+1700)_"-"_$E(ACRBEGIN,4,5)
  1.  S ACRB=$TR(ACRBEGIN,"-","")
  1.  S ACREND=($E(ACREND,1,3)+1700)_"-"_$E(ACREND,4,5)
  1.  S ACRE=$TR(ACREND,"-","")
  1.  S DIR(0)="YO"
  1.  S DIR("A")="Print the Report for ALL Locations"
  1.  S DIR("B")="YES"
  1.  W !
  1.  D DIR^ACRFDIC
  1.  Q:$D(ACRQUIT)!$D(ACROUT)
  1.  I +Y=1 S ACRLOC="000"
  1.  I '$D(ACRLOC) D
  1.  .S DIC="^AUTTLCOD("
  1.  .S DIC(0)="AEMZQ"
  1.  .S DIC("A")="Which LOCATION CODE: "
  1.  .D DIC^ACRFDIC
  1.  .Q:$D(ACRQUIT)!$D(ACROUT)!($G(Y)<1)
  1.  .S ACRLOC=$P(^AUTTLCOD(+Y,0),U)
  1.  Q:'$D(ACRLOC)
  1.  D ZIS
  1.  Q
  1. ZIS ;SELECT DEVICE
  1.  S (ZTRTN,ACRRTN)="P^ACRFRR12"
  1.  S ZTDESC="Property Voucher Report"
  1.  D ^ACRFZIS
  1.  Q
  1. P ;EP -- PRINT PROPERTY VOUCHER REPORT
  1.  ;
  1.  N ACRB,ACRDC,ACRDOC0,ACRDOCDA,ACRE,ACRFINAL,ACRJ,ACRLOCX,ACRRRDA,ACRRRDT,ACRTOT,ACRTYPE,ACRX,ACRZ,J,X,Y,Z
  1.  K ^TMP("ACRPV",$J)
  1.  S ACRLOCX=$S(ACRLOC="000":"ALL",1:ACRLOC)
  1.  S ACRX=ACRLOC_"-0000-00-0000"
  1.  D LOOP
  1.  Q:'$D(^TMP("ACRPV",$J))
  1.  D PRINT
  1.  K ^TMP("ACRPV",$J)
  1.  Q
  1. LOOP ;----- LOOP THROUGH RECEIVING REPORTS AND GATHER DATA
  1.  ;
  1.  F  S ACRX=$O(^ACRRR("PVN",ACRX)) Q:ACRX=""!($G(ACRLOCX)'="ALL"&($E(ACRX,1,3)'=ACRLOC))  D
  1.  . S ACRZ=$P(ACRX,"-",2)
  1.  . I $L(ACRZ)=4 S ACRZ=$E(ACRZ,3,4)
  1.  . S X=$P(ACRX,"-",3)_"01"_ACRZ
  1.  . D ^%DT
  1.  . S X=Y
  1.  . S X=$E(Y,1,3)+1700_$E(Y,4,5)
  1.  . S ACRB=$TR(ACRBEGIN,"-","")
  1.  . S ACRE=$TR(ACREND,"-","")
  1.  . Q:(X<ACRB)!(X>ACRE)
  1.  . S (J,Y,Z)=0
  1.  . S ACRRRDA=0
  1.  . F  S ACRRRDA=$O(^ACRRR("PVN",ACRX,ACRRRDA)) Q:'ACRRRDA  D
  1.  . . S X=$G(^ACRRR(ACRRRDA,0))
  1.  . . S ACRDOCDA=$P(X,U,2)
  1.  . . S ACRRRDT=$G(^ACRRR(ACRRRDA,"DT"))
  1.  . . S ACRDOC0=^ACRDOC(ACRDOCDA,0)
  1.  . . S J=J+1,ACRJ=$G(ACRJ)+1
  1.  . . S Y=Y+($P($G(^ACRSS(+X,"DT")),U,3)*$P(ACRRRDT,U,3))
  1.  . . S ACRFINAL=$P(X,U,8)
  1.  . . S X=+X
  1.  . . S Z=$P($G(^ACRSS(+X,0)),U,4)
  1.  . . I $D(^AUTTOBJC(+Z,0)),$E($P(^(0),U),1,2)="26" S ACRTYPE=$P(^(0),U,8)
  1.  . . S ACRTYPE=$S($G(ACRTYPE)="S":"SS",1:"DI")
  1.  . . S ACRTOT=$G(ACRTOT)+$P($G(^ACRSS(X,"DT")),U,4)
  1.  . 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
  1.  . S $P(^TMP("ACRPV",$J,"TOTAL",$E(ACRX,1,3)),U)=$P($G(^TMP("ACRPV",$J,"TOTAL",$E(ACRX,1,3))),U)+J
  1.  . 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
  1.  . S $P(^TMP("ACRPV",$J,"ZGRANDTOTAL"),U)=$P($G(^TMP("ACRPV",$J,"ZGRANDTOTAL")),U)+J
  1.  . S $P(^TMP("ACRPV",$J,"ZGRANDTOTAL"),U,2)=$P($G(^TMP("ACRPV",$J,"ZGRANDTOTAL")),U,2)+Y
  1.  Q
  1. PRINT ;----- PRINT THE REPORT
  1.  ;
  1.  N ACRDC,ACRPVN,ACRQUIT,ACRX,DATA
  1.  S ACRPVN="" F  S ACRPVN=$O(^TMP("ACRPV",$J,"D",ACRPVN)) Q:ACRPVN']""  D  Q:$D(ACRQUIT)
  1.  . I $G(ACRX)'=$E(ACRPVN,1,3) D  Q:$D(ACRQUIT)
  1.  . . D PVNTOT
  1.  . . Q:$D(ACRQUIT)
  1.  . . D PHEAD
  1.  . . S ACRX=$E(ACRPVN,1,3)
  1.  . S DATA=^TMP("ACRPV",$J,"D",ACRPVN)
  1.  . W !,ACRPVN
  1.  . W ?16,"|",$P(DATA,U)
  1.  . W ?31,"|",$J($P(DATA,U,2),3)
  1.  . W ?37,"|",$J($P(DATA,U,3),6)
  1.  . W ?45,"|",$J($FN($P(DATA,U,4),"P",2),13)
  1.  . I $Y>($G(IOSL)-4) D PAUSE^ACRFWARN Q:$D(ACRQUIT)  D PHEAD
  1.  Q:$D(ACRQUIT)
  1.  D PVNTOT
  1.  Q
  1. PHEAD ;PVN REPORT HEADER
  1.  W @IOF
  1.  S ACRDC=$G(ACRDC)+1
  1.  W !,"Property Voucher Register"
  1.  W !,"Report Date: "
  1.  S Y=DT
  1.  X ^DD("DD")
  1.  W Y
  1.  W !,"Report From: ",ACRBEGIN
  1.  W ?43,"Accounting Point: ",$P($G(^AUTTACPT(+$P($G(^ACRPO(1,0)),U,4),0)),U)
  1.  W !,"Report To..: ",ACREND,?55,"Page: ",$G(ACRDC)
  1.  W $$DASH^ACRFMENU
  1.  W !,"VOUCHER",?16,"|PURCHASE ORDER",?31,"|",?37,"|# OF",?45,"|"
  1.  W !,"SERIAL NO.",?16,"|NUMBER",?31,"|TYPE",?37,"|ITEMS",?45,"|VALUE"
  1. PH W !,"----------------",?16,"|--------------",?31,"|-----",?37,"|-------",?45,"|------------"
  1.  Q
  1. PVNTOT ;----- WRITE TOTAL
  1.  Q:$G(ACRX)=""
  1.  S DATA=^TMP("ACRPV",$J,"TOTAL",ACRX)
  1.  D PH
  1.  W !?37,"|",$J($P(DATA,U),6)
  1.  W ?45,"|",$J($FN($P(DATA,U,2),"P",2),13)
  1.  D PAUSE^ACRFWARN
  1.  Q