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

ACRFEA43.m

Go to the documentation of this file. 
  1. ACRFEA43 ;IHS/OIRM/DSD/THL,AEF - EDIT FINANCIAL DATA - CONT;  [ 11/01/2001   9:44 AM ]
  1.  ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
  1.  ;;ACRFEA4 CON'T
  1. EN ;EP;
  1.  I ACRREF=148 D REMARKS Q
  1.  D CALLERS
  1.  I '$D(ACROUT),$E($P($G(ACRDOC0),U,2),9,10)'="BP",'$P($G(ACRDOC0),U,19) D
  1.  .D FEDSTRIP
  1.  .D DRAFT:ACRREF=103!($P(ACRDOC0,U,4)'=35)
  1.  D RECEIVER:'$D(ACROUT)
  1.  I '$D(ACROUT),$P(ACRDOC0,U,19),$P($G(^ACRDOC(ACRDOCDA,"PO")),U,5)=$P($G(^ACRSYS(1,"DT1")),U,12) D PVENDOR:'$D(ACROUT)
  1.  Q
  1. FEDSTRIP ;EP;EDIT FEDSRIP DATA
  1.  I ACRREF=116!(ACRREF=103)!(ACRREF=210),$P(ACRDOC0,U,4)'=35,'$P(ACRDOC0,U,12) D FS
  1.  I $P(^ACRDOC(ACRDOCDA,0),U,4)=35 D
  1.  .I '$D(ACRNEWOB) D CC I 1
  1.  .E  D CC1
  1.  K ACRQUIT
  1.  Q
  1. FS S DIR(0)="YO"
  1.  S DIR("A")="Is this a FEDSTRIP or GSA SUPPLY CENTER order"
  1.  S DIR("B")="NO"
  1.  I $D(^ACRDOC(ACRDOCDA,3)),$P(^(3),U,11)]""!($P(^(3),U,12)]"") S DIR("B")="YES"
  1.  W !
  1.  D DIR^ACRFDIC
  1.  N ACRREF,ACRREFDA
  1. FEDSET ;EP;
  1.  I Y=0,$D(^ACRDOC(ACRDOCDA,3)) N ACR3 S ACR3=^(3) D  Q
  1.  .N X
  1.  .K ACRQUIT
  1.  .F X=11:1:17 I $P(ACR3,U,X)]"" S ACRQUIT="" Q
  1.  .Q:'$D(ACRQUIT)
  1.  .K ACRQUIT
  1.  .S DA=ACRDOCDA
  1.  .S DIE="^ACRDOC("
  1.  .S DR="14///@;15///@;16///@;17///@;18///@;.13///"_$S($E($G(^ACROBL(ACRDOCDA,"APV")))="A":103,1:116)
  1.  .D DIE^ACRFDIC
  1.  .S $P(^ACRDOC(ACRDOCDA,3),U,17)=""
  1.  I Y=1 D
  1.  .K ACRQUIT
  1.  .N X,ACR3
  1.  .S ACR3=$G(^ACRDOC(ACRDOCDA,3))
  1.  .F X=11:1:15 I $P(ACR3,U,X)="" S ACRQUIT="" Q
  1.  .I $D(ACRQUIT)#2 D FEDSET^ACRFEA4 K ACRQUIT
  1.  .Q:$D(DDSFILE)
  1.  .S DA=ACRDOCDA
  1.  .S DIE="^ACRDOC("
  1.  .S DR="[ACR FEDSTRIP ORDER]"
  1.  .D DDS^ACRFDIC
  1.  .Q:'$D(ACRSCREN)
  1.  .K ACRSCREN
  1.  .W !
  1.  .D DIE^ACRFDIC
  1.  Q
  1. CC ;EP;TO INDICATE IF CREDIT CARD PURCHASE
  1.  S DIR(0)="YO"
  1.  S DIR("A")="Is this a Credit Card purchase"
  1.  S DIR("B")="NO"
  1.  I $P(^ACRDOC(ACRDOCDA,0),U,4)=35 D
  1.  .S DIR("A")="Keep this as a CREDIT CARD purchase",DIR("B")="YES"
  1.  W !
  1.  D DIR^ACRFDIC
  1.  I +Y'=1 D  Q
  1.  .S DA=ACRDOCDA
  1.  .S DIE="^ACRDOC("
  1.  .S DR=$S($P(^ACRDOC(ACRDOCDA,0),U,4)=35&($P(^(0),U,7)'=35):".04////"_$P(^(0),U,7),1:".04T")_";.25///@"
  1.  .W !
  1.  .D DIE^ACRFDIC
  1.  .I $E(^ACROBL(ACRDOCDA,"APV"))="A",$P(^ACRDOC(ACRDOCDA,0),U,13)=33 D
  1.  ..S DA=ACRDOCDA
  1.  ..S DIE="^ACRDOC("
  1.  ..S DR=".13///103"
  1.  ..D DIE^ACRFDIC
  1.  ..S DA=ACRDOCDA
  1.  ..S DIE="^ACROBL("
  1.  ..S DR=".1///103;905///A;906///Y"
  1.  ..D DIE^ACRFDIC
  1. CC1 ;EP;
  1.  S DA=ACRDOCDA
  1.  S DIE="^ACRDOC("
  1.  S DR=".04////35;.25T;113110DATE PURCHASED......"
  1.  I $P($G(^ACRDOC(ACRDOCDA,"REQ2")),U,8)="" S DR=DR_";113370////"_DUZ
  1.  I $P($G(^ACRDOC(ACRDOCDA,0)),U,14)="" S DR=DR_";.14////CREDIT CARD PUR"
  1.  W !
  1.  D DIE^ACRFDIC
  1.  I $P(^ACRDOC(ACRDOCDA,0),U,25)="" D  G CC1
  1.  .W !!,"You must enter the name of the CREDIT CARD HOLDER for this purchase."
  1.  Q
  1. RECEIVER ;EP;EDIT RECEIVING OFFICIAL FOR REQ FOR SERVICE AND CALL IF CALL
  1.  Q:$P($G(^ACRDOC(+$G(ACRDOCDA),0)),U,4)=35
  1.  S DA=ACRDOCDA
  1.  S DIE="^ACRDOC("
  1.  S DR="113200T"_$S($P(^ACRDOC(ACRDOCDA,0),U,19):";24T",1:"")
  1.  W !
  1.  D DIE^ACRFDIC
  1. CIS ;ENTER SMALL PURCHASE DATA
  1.  I ACRREF=103!(ACRREF=349)!(ACRREF=326),$D(ACRPO),'$P(^ACRDOC(ACRDOCDA,0),U,16),$D(^("PO")),$P(^("PO"),U,5),$D(^AUTTVNDR($P(^("PO"),U,5),0)) D ADD^ACRFCIS
  1.  Q
  1. CALLERS ;EP;TO EDIT BPA CALLERS
  1.  I $D(ACRPO) S ACRDOC0=^ACRDOC(ACRDOCDA,0) D
  1.  .I $P(ACRDOC0,U,18)>0!$P(ACRDOC0,U,15) D
  1.  ..I $P(ACRDOC0,U,15) Q:'$D(^ACRDOC($P(ACRDOC0,U,15),0))  Q:$P(^(0),U,18)'>0  S DA=$P(ACRDOC0,U,15)
  1.  ..E  S DA=ACRDOCDA
  1.  ..S DIE="^ACRDOC("
  1.  ..S DR="[ACR BPA CALL LIMIT]"
  1.  ..D DDS^ACRFDIC
  1.  ..Q:'$D(ACRSCREN)
  1.  ..K ACRSCREN
  1.  ..W !
  1.  ..D DIE^ACRFDIC
  1.  Q
  1. REMARKS ;EP;TO EDIT SPECIAL REMARKS FOR A TRAINING REQUEST
  1.  W !
  1.  S DA=ACRDOCDA
  1.  S DIE="^ACRDOC("
  1.  S DR="[ACR TRAINING OTHER DATA]"
  1.  D DDS^ACRFDIC
  1.  Q:'$D(ACRSCREN)
  1.  K ACRSCREN
  1.  D DIE^ACRFDIC
  1.  Q
  1. DRAFT ;EP;TO DETERMINE IF DRAFT PAYMENT IS ALLOWED
  1.  S DA=ACRDOCDA
  1.  S DIE="^ACRDOC("
  1.  S DR=".12Is DRAFT PAYMENT authorized"
  1.  W !
  1.  D DIE^ACRFDIC
  1.  Q
  1. PVENDOR ;EP;TO ENTER PRIME VENDOR CONTRACT NUMBER FOR THE DOCUMENT
  1.  Q:$P($G(^ACRDOC(ACRDOCDA,"PO")),U,5)'=$P($G(^ACRSYS(1,"DT1")),U,12)
  1.  I $P($G(^ACRDOC(ACRDOCDA,"REQ2")),U,13)]"" D  Q
  1.  .N ACR1
  1.  .S DA=ACRDOCDA
  1.  .S DIE="^ACRDOC("
  1.  .S DR="113420T"
  1.  .D DIE^ACRFDIC
  1.  .S ACR1=$P($G(^ACRDOC(ACRDOCDA,"REQ2")),U,13)
  1.  .Q:ACR1=""
  1.  .D DOC^ACRFPVEN
  1.  D POS^ACRFPVEN
  1.  Q
  1. PRINT ;EP;TO PRINT ACCOUNT AUDIT
  1.  F  D P1 Q:$D(ACRQUIT)!$D(ACROUT)
  1.  K ACRQUIT
  1.  Q
  1. P1 ;
  1.  W @IOF
  1.  W !?10,"Select Account for AUDIT REPORT"
  1.  S DIR(0)="SO^1:Appropriation;2:Allowance;3:Sub-Allowance;4:Department Account"
  1.  S DIR("A")="Which type of account"
  1.  W !
  1.  D DIR^ACRFDIC
  1.  I 'Y S ACRQUIT="" Q
  1.  I Y=1 S ACRGLB="^ACRAPP"
  1.  I Y=2 S ACRGLB="^ACRALW"
  1.  I Y=3 S ACRGLB="^ACRALC"
  1.  I Y=4 S ACRGLB="^ACRLOCB"
  1.  S DIC=ACRGLB_"("
  1.  S DIC(0)="AEMQZ"
  1.  S DIC("A")="Which "_$S(Y=1:"APPROPRIATION",Y=2:"ALLOWANCE",Y=3:"SUB-ALLOWANCE",1:"DEPARTMENT ACCOUNT")_": "
  1.  S DIC("S")="I $P(^(0),U,8)=""O"",$D(@ACRGLB@(""ORIG"",+Y))"
  1.  W !
  1.  D DIC^ACRFDIC
  1.  Q:+Y<1
  1.  S ACRZDA=+Y
  1. ZIS S ZTDESC="ACCOUNT AUDIT REPORT"
  1.  S (ZTRTN,ACRRTN)="P2^ACRFEA43"
  1.  D ^ACRFZIS
  1.  Q
  1. P2 ;EP;TO PRINT ACCOUNT AUDIT REPORT
  1.  N ACRTOT,ACRAMT,ACRCMT
  1.  D PHEAD
  1.  S ACRX=@ACRGLB@(ACRZDA,0),ACRDT=$G(@ACRGLB@(ACRZDA,"DT")),ACRCMT=$G(@ACRGLB@(ACRZDA,"PURP"))
  1.  W !,ACRZDA,?7,$P(ACRX,U,8),?9,$E($S(ACRGLB'["ACRLOCB":$P(ACRX,U,12),1:$P($G(^AUTTPRG(+$P(ACRX,U,5),0)),U)),1,25),?35,$P(ACRDT,U,3),?37,$E($P(ACRCMT,U),1,30),?68,$J($FN(+ACRX+$S(ACRGLB["ACRLOCB":$P(ACRX,U,11),1:0),"P",2),12)
  1.  S ACRTOT=+ACRX+$S(ACRGLB["ACRLOCB":$P(ACRX,U,11),1:0)
  1.  S ACRDA=0
  1.  F  S ACRDA=$O(@ACRGLB@("ORIG",ACRZDA,ACRDA)) Q:'ACRDA!$D(ACRQUIT)  D
  1.  .S ACRX=@ACRGLB@(ACRDA,0),ACRDT=$G(@ACRGLB@(ACRDA,"DT")),ACRCMT=$G(@ACRGLB@(ACRDA,"PURP"))
  1.  .W !,ACRDA,?7,$P(ACRX,U,8),?9,$E($S(ACRGLB'["ACRLOCB":$P(ACRX,U,12),1:$P($G(^AUTTPRG(+$P(ACRX,U,5),0)),U)),1,25),?35,$P(ACRDT,U,3),?37,$E($P(ACRCMT,U),1,30),?68,$J($FN(+ACRX+$S(ACRGLB["ACRLOCB":$P(ACRX,U,11),1:0),"P",2),12)
  1.  .S ACRAMT=$S($P(ACRX,U,8)'="D":1,1:-1)
  1.  .S ACRTOT=ACRTOT+(+ACRX*ACRAMT)+$S(ACRGLB["ACRLOCB":$P(ACRX,U,11),1:0)
  1.  .I IOSL-4<$Y D PAUSE^ACRFWARN Q:$D(ACRQUIT)  D PHEAD
  1.  D PTAIL
  1.  K ACRQUIT
  1.  D PAUSE^ACRFWARN
  1.  Q
  1. PHEAD ;
  1.  W @IOF
  1.  W !,"Audit of ",$S(ACRGLB["ACRAPP":"APPROPRIATION",ACRGLB["ACRALW":"ALLOWANCE",ACRGLB["ACRALC":"SUB-ALLOWANCE",1:"DEPARTMENT ACCOUNT")," Increases and Decreases."
  1.  W !!,"REPORT DATE: "
  1.  S Y=DT
  1.  X ^DD("DD")
  1.  W Y,?35,"R"
  1.  W !?35,"E",!,"ID NO.",?9,"ACCOUNT IDENTIFER",?35,"C",?37,"PURPOSE",?68,"AMOUNT"
  1.  W !,"------",?7,"-",?9,"-------------------------",?35,"-",?37,"------------------------------",?68,"------------"
  1.  Q
  1. PTAIL ;
  1.  W !,"------",?7,"-",?9,"-------------------------",?35,"-",?37,"------------------------------",?68,"------------"
  1.  W !?30,"TOTAL: ",?68,$J($FN(ACRTOT,"P",2),12)
  1.  Q