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

ACRFPAP1.m

Go to the documentation of this file. 
  1. ACRFPAP1 ;IHS/OIRM/DSD/THL,AEF - PRINT APPROVALS ON REQUESTS;  [ 11/01/2001   9:44 AM ]
  1.  ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
  1.  ;;ACRFPAPV CON'T
  1. EN ;EP;
  1.  I ACRCT=40 D
  1.  .W !,"| Telephone calls were made in the interest of the Government.  Traveler"
  1.  .W ?79,"|"
  1.  .W !,"| certifies that use of Government phone system was not practical."
  1.  .W ?79,"|"
  1.  .W !,"| I certify that this Voucher is true and correct to the best of my knowledge"
  1.  .W ?79,"|"
  1.  .W !,"| belief, and that payment or credit has not been received by me."
  1.  .W ?79,"|"
  1.  .W !,"| Per diem claimed is based on the average cost of lodging incurred during"
  1.  .W ?79,"|"
  1.  .W !,"| the period covered by this voucher."
  1.  .W ?79,"|"
  1.  .I $P($G(^ACRDOC(ACRDOCDA,"TOSA")),U,3)="Y" D
  1.  ..W !,"| I certify that the Rental vehicle was used for official business only."
  1.  ..W ?79,"|"
  1.  I ACRCT=45 D
  1.  .W !,"| Travel completed as authorized & directed by supervisor recommending travel. |"
  1.  I ACRCT=37 D
  1.  .W !,"| This voucher is approved.  Long distance calls are certified as necessary    |"
  1.  .W !,"| in the interest of the Government."
  1.  .W ?79,"|"
  1.  Q
  1. CONSOL ;EP;TO DETERMINE IF ITEM FROM REQUISITION CONSOLIDATED ON ANOTHER PO
  1.  N X,Y,Z,ACRX,I
  1.  S X=0
  1.  F  S X=$O(^ACRSS("C",ACRDOCDA,X)) Q:'X  I $D(^ACRSS(X,"PO")),+^("PO")'=ACRDOCDA S (Y,I)=+^("PO") D
  1.  .S Y=$S($P(^ACRDOC(Y,0),U,2)]"":$P(^(0),U,2),1:$P(^(0),U)),Z=$P($G(^AUTTPRG(+$P(^ACRDOC(I,"PO"),U,7)),0),U)
  1.  .S:Z="" Z="NOT STATED"
  1.  .S ACRX(Y,Z)=$G(ACRX(Y,Z))_+^ACRSS(X,0)_","
  1.  .S $P(ACRX(Y,Z),U,2)=I
  1.  .S $P(ACRX(Y,Z),U,3)=$P(^ACRDOC(I,0),U,6)
  1.  Q:'$D(ACRX)
  1.  S ACRDOCXX=ACRDOCDA
  1.  S X=""
  1.  F  S X=$O(ACRX(X)) Q:X=""  D
  1.  .S Y=""
  1.  .F  S Y=$O(ACRX(X,Y)) Q:Y=""  D
  1.  ..S Z=$P(ACRX(X,Y),U)
  1.  ..S Z=$E(Z,1,$L(Z)-1)
  1.  ..W !!,"ITEM",$S($L(Z,",")>1:"(S): ",1:": "),Z," FROM THIS REQUEST"
  1.  ..W !,$S($L(Z,",")>1:"HAVE",1:"HAS")," BEEN CONSOLIDATED TO THE FOLLOWING PURCHASE ORDER:"
  1.  ..W !,"--------------------------------------------------------------------------------"
  1.  ..W !,"DEPT ID: ",$P(ACRX(X,Y),U,3)
  1.  ..W ?15,"DOC: (",$P(ACRX(X,Y),U,2),")"
  1.  ..W ?30,X
  1.  ..W ?50,Y
  1.  ..N ACRDOCDA,ACRREFDA,ACRREF,ACRREFX
  1.  ..S ACRDOCDA=$P(ACRX(X,Y),U,2)
  1.  ..S ACRREFDA=$P(^ACRDOC(ACRDOCDA,0),U,13)
  1.  ..S (ACRREF,ACRREFX)=$P(^AUTTDOCR(ACRREFDA,0),U)
  1.  ..N X,Y,Z
  1.  ..D EN^ACRFPAPV
  1.  S ACRDOCDA=ACRDOCXX
  1.  K ACRDOCXX
  1.  Q
  1. TAIL ;EP;TO PRINT FORM TRAILER
  1.  I ACRREFX'=600,ACRREFX'=148 D
  1.  .W !
  1.  .D B1
  1.  .W "------------------------------------------------------------------------------"
  1.  .D B1
  1.  I ACRREFX=103,'$P($G(^ACRDOC(ACRDOCDA,3)),U,13),$E(IOST,1,2)="P-" D
  1.  .W !,"IHS 532 (6/94) Computerized Mod of Optional Form 347 (10/83) (OMB NO. 0990-0115)"
  1.  .W !,"--------------------------------------------------------------------------------"
  1.  I ACRREFX=103,$P($G(^ACRDOC(ACRDOCDA,3)),U,13),$E(IOST,1,2)="P-" D
  1.  .W !,"--------------------------------------------------------------------------------"
  1.  I ACRREFX=116,$E(IOST,1,2)="P-" D
  1.  .W !,"IHS 534 (10/94) Computerized Mod of Purchase/Service/Stock Requisition HHS 393)"
  1.  Q
  1. B1 W $S(ACRREFX'=103:"|",1:"-")
  1.  Q