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

ACRFPAPV.m

Go to the documentation of this file. 
  1. ACRFPAPV ;IHS/OIRM/DSD/THL,AEF - PRINT APPROVALS ON REQUESTS;  [ 10/27/2006   4:15 PM ]
  1.  ;;2.1;ADMIN RESOURCE MGT SYSTEM;**14,19,21**;NOV 05, 2001
  1.  ;;ROUTINE TO PRINT APPROVALS AND TO DISPLAY STATUS OF A REQUEST
  1. EN ;EP;
  1.  Q:$D(ACROUT)
  1.  I "^116^204^103^349^326^210^"[(U_ACRREFX_U),'$D(^ACRSS("J",ACRDOCDA)) D CONSOL^ACRFPAP1 Q
  1.  N ACRX,ACRY,ACRJ,D0
  1.  S:$D(ACRDOCDA) D0=ACRDOCDA
  1.  D EN1
  1.  I $E(IOST,1,2)="C-",'$D(ACRREF)!$D(ACRCOMP)!$D(ACRPRT)!$D(ACRPO)!$D(ACRREV)!$D(ACRCSI) D PAUSE^ACRFWARN
  1. EXIT K ACRZ,Y,ACRCT,ACRSTATS
  1.  Q
  1. EN1 N ACRPHEAD
  1.  S (ACRPHEAD,ACRX)=0
  1.  I $P(^ACRDOC(ACRDOCDA,0),U,19) N ACRREFX S ACRREFX=116
  1.  S ACRREFDA=$O(^AUTTDOCR("B",$S(ACRREF'=210:ACRREFX,1:ACRREF),0))
  1.  I ACRREF=210,$D(ACRREQST)!(ACRREFX=116) D
  1.  .S ACRREFDA=$O(^AUTTDOCR("B",116,0))
  1.  .S ACRREFX=116
  1.  I '$D(ACRORIGF) D
  1.  .F  S ACRX=$O(^ACRAPVS("AB",D0,ACRX)) Q:'ACRX  I $P(^ACRAPVS(ACRX,0),U,6)=ACRREFDA!($P($G(ACRDOC0),U,4)=35) S ACRPHEAD=ACRPHEAD+1
  1.  .D PHEAD^ACRFSS12:'$D(ACRORIGF)
  1.  I '$D(ACRPPO),ACRREFX'=148,'$D(ACRCSI),$E($G(IOST),1,2)="C-",'$D(ACRREV) W @IOF
  1.  W !
  1.  D:'$D(ACRPSC) B1
  1.  W:ACRREF'=148&'$D(ACRPSC) "------------------------------------------------------------------------------"
  1.  W:ACRREF=148 "----------------------  SECTION D - CLEARANCE ACTION  ------------------------"
  1.  D:'$D(ACRPSC) B1
  1.  S ACRREFDA=$O(^AUTTDOCR("B",$S(ACRREF'=210:ACRREFX,1:ACRREF),0))
  1.  I ACRREF=210,$D(ACRREQST)!(ACRREFX=116) D
  1.  .S ACRREFDA=$O(^AUTTDOCR("B",116,0))
  1.  .S ACRREFX=116
  1.  I "^103^349^326^210^"[(U_ACRREFX_U),'$D(ACRREV),'$D(ACRPRT),$D(^ACROBL(ACRDOCDA,"APV")),$P(^("APV"),U,6) D
  1.  .W !,$S($P(^ACROBL(ACRDOCDA,"APV"),U,6)=1:"FINAL",1:"PARTIAL")," RECEIVING REPORT COMPLETED" Q
  1.  S (ACRX,ACRJ)=0
  1.  F  S ACRX=$O(^ACRAPVS("AB",D0,ACRX)) Q:'ACRX  I $P(^ACRAPVS(ACRX,0),U,6)=ACRREFDA!($P($G(ACRDOC0),U,4)=35) D
  1.  .S ACRAP0=$G(^ACRAPVS(ACRX,0))
  1.  .S ACRAPDT=$G(^ACRAPVS(ACRX,"DT"))
  1.  .Q:$P(ACRAPDT,U,8)>DT
  1.  .I ACRAP0=""&(ACRAPDT="") D  Q
  1.  ..S DA=ACRX
  1.  ..S DIK="^ACRAPVS("
  1.  ..D DIK^ACRFDIC
  1.  .D EN11
  1.  I ACRJ=0 W ! D  Q
  1.  .N ACRSTAT                            ;ACR*2.1*21.05 IM22502
  1.  .S ACRSTAT=$E(ACROBLAP)               ;ACR*2.1*21.05 IM22502
  1.  .I ACRREFX'=103,ACRREFX'=349,ACRREFX'=326,ACRREFX'=600,ACRREFX'=210 D
  1.  ..W "THIS DOCUMENT HAS "
  1.  ..;Begin old code ACR*2.1*21.05 IM22502
  1.  ..;W $S($E(ACROBLAP)'="D":"NOT BEEN SUBMITTED FOR APPROVAL.",1:"BEEN DISAPPROVED.")
  1.  ..;Begin new code ACR*2.1*21
  1.  ..I ACRSTAT="D" W "BEEN DISAPPROVED." Q
  1.  ..I ACRSTAT="C" W "BEEN CANCELLED." Q
  1.  ..W "NOT BEEN SUBMITTED FOR APPROVAL."
  1.  ..;End new code
  1.  .I ACRREFX=103!(ACRREFX=349)!(ACRREFX=326)!(ACRREFX=210) D
  1.  ..;I $E(ACROBLAP)="D" W $S(ACRDOC0["CANCELLED":"CANCELLED",1:"DISAPPROVED") Q  ;ACR*2.1*21.05 IM22502
  1.  ..I $E(ACROBLAP)="D"!($E(ACROBLAP)="C") W $S(ACRDOC0["CANCELLED":"CANCELLED",1:"DISAPPROVED") Q  ;ACR*2.1*21.05 IM22502
  1.  ..I $P(ACRDOC0,U,4)=35,$P(ACROBLAP,U,8)="A" W "CREDIT CARD PURCHASE APPROVED AND COMPLETED" Q
  1.  ..W "BEING PROCESSED IN PROCURMENT BY: "
  1.  ..N ACRPA
  1.  ..S ACRPA=$P($G(^ACRDOC(D0,"PA")),U)
  1.  ..I 'ACRPA W "PURCHASING AGENT NOT SELECTED."
  1.  ..;E  S ACRPA=$P(^VA(200,ACRPA,0),U),ACRPA=$P($P(ACRPA,",",2)," ")_" "_$P(ACRPA,",")  ;ACR*2.1*19.02 IM16848
  1.  ..E  S ACRPA=$$NAME2^ACRFUTL1(ACRPA),ACRPA=$P($P(ACRPA,",",2)," ")_" "_$P(ACRPA,",")  ;ACR*2.1*19.02 IM16848
  1.  ..W:ACRPA]"" ACRPA
  1.  ..I $D(^ACRDOC(ACRDOCDA,13)) D
  1.  ...N ACR13
  1.  ...S ACR13=$P(^ACRDOC(ACRDOCDA,13),U,4)
  1.  ...W:ACR13]"" ?$X+2,"PO DUE BY: ",$E(ACR13,4,5),"/",$E(ACR13,6,7)
  1.  ..D PDOCSTAT^ACRFEA42
  1.  .;Begin old code ACR*2.1*21.05  IM22502
  1.  .;I ACRREFX=600 D
  1.  .;.I $P(^ACROBL(ACRDOCDA,"APV"),U)="D" D  Q
  1.  .;..W "TRAVEL VOUCHER WAS DISAPPROVED."
  1.  .;.W "TRAVEL VOUCHER BEING PREPARED."
  1.  .;Begin new code ACR*2.1*21.05  IM22502
  1.  .I ACRREFX=600 D
  1.  ..I $P(^ACROBL(ACRDOCDA,"APV"),U)="D"!($P(^ACROBL(ACRDOCDA,"APV"),U)="C") D  Q
  1.  ...W "TRAVEL VOUCHER WAS "
  1.  ...W $S(ACRDOC0["CANCELLED":"CANCELLED",1:"DISAPPROVED")
  1.  ..W "TRAVEL VOUCHER BEING PREPARED."
  1.  .;End new code
  1.  I ACRREFX'=103,ACRREFX'=349,ACRREFX'=326 D
  1.  .W !,"| APPROVAL FOR DOCUMENT: ",ACRDOC
  1.  .W "     ",$$EXPDN^ACRFUTL(ACRDOCDA)           ;ACR*2.1*14.01 IM12272
  1.  .W ?79,"|"
  1.  S ACRX=0
  1.  F  S ACRX=$O(ACRX(ACRX)) Q:'ACRX  D EN12
  1.  D TAIL^ACRFPAP1:$E($G(IOST),1,2)="P-"&'$D(ACRPSC)
  1.  Q
  1. EN11 I $P(ACRDOC0,U,4)=35,$P(ACRAP0,U,3)=1,$P(ACRAP0,U,4)=1 S $P(ACRAP0,U,4)=999
  1.  S ACRX($P(ACRAP0,U,4),$P(ACRAP0,U,3),ACRX)=""
  1.  S ACRDOC=$S($P(ACRDOC0,U,2)]""&($P(ACRDOC0,U,2)'=$P(ACRDOC0,U))&'$D(ACRREQST):$P(ACRDOC0,U,2)_"  ("_$P(ACRDOC0,U)_")",1:$P(ACRDOC0,U))
  1.  S ACRJ=ACRJ+1
  1.  Q
  1. EN12 S ACRY=0
  1.  F  S ACRY=$O(ACRX(ACRX,ACRY)) Q:'ACRY  D
  1.  .S ACRZ=$O(ACRX(ACRX,ACRY,0))
  1.  .S ACRCT=$P(^ACRAPVS(ACRZ,0),U,3)
  1.  .S ACRDT=$G(^ACRAPVS(ACRZ,"DT"))
  1.  .S ACRSTATS=$P(ACRDT,U)
  1.  .S ACRFINAL=$P(ACRDT,U,5)
  1.  .S ACRUS=$S($P(ACRDT,U,6)]"":$P(ACRDT,U,6),1:$P(ACRDT,U,2))
  1.  .S ACRUSO=$P(ACRDT,U,2)
  1.  .S Y=$P(ACRDT,U,4)
  1.  X:Y]"" ^DD("DD")
  1.  S:$D(ACRORIGF) ACRAP=Y
  1.  D EN2
  1.  Q
  1. EN2 I 'ACRCT S ACRCT="NOT STATED"
  1.  I ACRCT=1,ACRSTATS="" D
  1.  .W !
  1.  .D B
  1.  .W $S($D(ACR3542):"9A. ",'$D(ACRPSC):"22. ",1:"    "),"(DOCUMENT PENDING CONTRACT/ORDER OFFICER SIGNATURE)"
  1.  .W ?79
  1.  .D B
  1.  I ACRCT,'$D(^ACRAPVT(ACRCT,0)) S ACRCT="NOT STATED"
  1.  I ACRCT,$D(^ACRAPVT(ACRCT,0)) D
  1.  .D EN^ACRFPAP1
  1.  .S ACRCT=$P(^ACRAPVT(ACRCT,0),U)
  1.  I ACRX=99 S ACRCT="RECERTIFY FUNDS"
  1.  I ACRUS,$D(^VA(200,ACRUS,0)) D
  1.  .;S ACRUS=$E($P(^VA(200,ACRUS,0),U),1,24)  ;ACR*2.1*19.02 IM16848
  1.  .S ACRUS=$E($$NAME3^ACRFUTL1(ACRUS),1,24)  ;ACR*2.1*19.02 IM16848
  1.  .S ACRUS=$P(ACRUS,",",2)_" "_$P(ACRUS,",")
  1.  .I ACRUSO'=ACRUS,$D(^VA(200,ACRUSO,0)) D  I 1
  1.  ..;S ACRUSO=$E($P(^VA(200,ACRUSO,0),U),1,24)  ;ACR*2.1*19.02 IM16848
  1.  ..S ACRUSO=$E($$NAME3^ACRFUTL1(ACRUSO),1,24)  ;ACR*2.1*19.02 IM16848
  1.  ..S ACRUSO=$P(ACRUSO,",",2)_" "_$P(ACRUSO,",")
  1.  E  S ACRUS="NOT STATED"
  1.  S ACRCT=$E($P($P(ACRCT,",",2)," ")_" "_$P(ACRCT,","),1,21)
  1.  I ACRREFX=103!(ACRREFX=349)!(ACRREFX=326),ACRCT["AUTH" S ACRCT="CONTRACT/ORDER OFFICER"
  1.  I (ACRCT["CERTIFY"!(ACRCT["CERTIFICATION OF TRA")!(ACRCT["TRAINING FUNDS AVAIL")),$E(DT,4,5)<10,$E(DT,1,3)+1700<$P(^ACRLOCB($P(ACRDOC0,U,6),"DT"),U) S ACRCT=" SUB. TO AVAIL FUNDS."
  1.  Q:$D(ACRORIGF)
  1.  I "^103^349^326^"'[(U_ACRREFX_U)!("^103^349^326^"[(U_ACRREFX_U)&(ACRFINAL'="Y")) D
  1.  .W !
  1.  .D B
  1.  .W ACRCT
  1.  .I $L(ACRCT)<21 F ACRI=1:1:21-$L(ACRCT) W "."
  1.  .W ": "
  1.  .W ?23,ACRUS
  1.  I ACRREFX=103!(ACRREFX=349)!(ACRREFX=326),ACRREFDA'=$O(^AUTTDOCR("B",116,0)),ACRFINAL="Y" D
  1.  .W !,$S($D(ACR3542):"9A. ",'$D(ACRPSC):"22. ",1:"    "),"UNITED STATES OF AMERICA BY:"
  1.  .I '$D(ACRPSC) D
  1.  ..W ?44,"|",$S($D(ACR3542):"",1:"23. "),"NAME: ",ACRUS
  1.  ..W !?4,$S(ACRSTATS="A":"(ELECTRONIC SIGNATURE) "_$P(Y,"@"),1:"PENDING")
  1.  ..W ?44,"|"
  1.  ..W ?55,"CONTRACT/ORDER OFFICER"
  1.  ..W ?51
  1.  .I $D(ACRPSC) D
  1.  ..W ?$X+2,ACRUS
  1.  ..W !?4,$S(ACRSTATS="A":"(ELECTRONIC SIGNATURE) "_$P(Y,"@"),1:"PENDING")
  1.  ..W ?44,"CONTRACT/ORDER OFFICER"
  1.  ..W ?51
  1.  I ACRREFX=103!(ACRREFX=349)!(ACRREFX=326),ACRFINAL="Y",ACRSTATS="A",$D(^ACROBL(ACRDOCDA,"APV")),$P(^("APV"),U,3)="A",$P(^ACRDOC(ACRDOCDA,0),U,12) D
  1.  .W !?20,"***** ",$S($P(^ACRDOC(ACRDOCDA,0),U,12)=1:"ADVANCE PAYMENT",1:"CASH BUY")," AUTHORIZED *****"
  1.  I "^103^349^326^"'[(U_ACRREFX_U)!("^103^349^326^"[(U_ACRREFX_U)&(ACRFINAL'="Y")) D
  1.  .W ?49,$S($E(ACRSTATS)["A":"APPROVED",$E(ACRSTATS)["D":"DISAPPRVD",1:"PENDING")
  1.  .W ?59,Y
  1.  W ?79 D B
  1.  I ACRUS'=ACRUSO,"^103^349^326^"'[(U_ACRREFX_U)!("^103^349^326^"[(U_ACRREFX_U)&(ACRFINAL'="Y")),ACRSTATS]"" D
  1.  .W !,"|"
  1.  .W ?22,"(ACTING FOR: ",ACRUSO,")"
  1.  .W ?79
  1.  .D B
  1.  Q
  1. B W $S(ACRREFX'=103&(ACRREFX'=349)&(ACRREFX'=326):"|",1:"")
  1.  Q
  1. B1 W $S(ACRREFX'=103&(ACRREFX'=349)&(ACRREFX'=326):"|",1:"-")
  1.  Q