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

ACRFPRC1.m

Go to the documentation of this file. 
  1. ACRFPRC1 ;IHS/OIRM/DSD/THL,AEF - PROCESS PENDING DOCUMENTS;  [ 08/17/2006   9:44 AM ]
  1.  ;;2.1;ADMIN RESOURCE MGT SYSTEM;**19,20**;NOV 05, 2001
  1.  ;;CONTINUATION OF ACRFPRCS
  1. EN ;EP;TO APPROVE DOCUMENTS
  1.  D APPROVE
  1. EXIT K ACRAPDAF,ACRAPDAS,ACRINDV,ACRORD,ACRP11,^TMP("ACRDATA",$J,ACRDUZ,ACRJJ),ACRJJ,ACRNAM,ACRDUZ1,ACRX,ACRGLB,ACRPC,ACRTXDA,ACRNUM
  1.  Q
  1. APPROVE ;EP;PROCESS EACH APPROVAL OF A DOCUMENT
  1.  I '$D(ACRESIG) S (ACRQUIT,ACROUT)="" Q
  1.  N ACRDUZ
  1.  S ACRDUZ=$P(^ACRAPVS(ACRAPDA,"DT"),U,2)
  1.  S ACRAPVT=$P(^ACRAPVS(ACRAPDA,0),U,3)
  1.  S ACRDOC=$P(ACRDOC0,U)
  1.  S:$P(ACRDOC0,U,2)]""&($P(ACRDOC0,U,2)'=ACRDOC) ACRDOC=ACRDOC_" ("_$P(ACRDOC0,U,2)_")"
  1.  S Y=$$SIGSCR(ACRAPVT,.ACRAPVS,$P($G(^ACRDOC(ACRDOCDA,"TO")),U,9),$P($G(^ACRDOC(ACRDOCDA,"TRNG")),U,2),DUZ)
  1.  I +Y D  Q
  1.  . S ACRAPVS=$P(Y,U,2)
  1.  . D W^ACRFPRC9
  1.  . K ACRAPVS
  1.  D AUX^ACRFPRC5
  1.  Q:$D(ACRQUIT)
  1.  I '$D(ACRPSUM) D CAPPEND^ACRFCERT,BAPPEND^ACRFBOIL
  1.  I ACRAPVT=1,'$P(ACRDOC0,U,24) D
  1.  .S DIR(0)="YO"
  1.  .S DIR("A")="Review Small Purchase Check List Now"
  1.  .S DIR("B")="YES"
  1.  .W !
  1.  .I '$D(^ACRSPCL("B",ACRDOCDA)) D  Q
  1.  ..W !!,"No SMALL PURCHASE CHECK LIST on file for this Document."
  1.  ..D PAUSE^ACRFWARN
  1.  ..K ACRQUIT
  1.  .D DIR^ACRFDIC
  1.  .Q:+Y'=1
  1.  .D PCLIST^ACRFPO3
  1.  D ASUM^ACRFEA42
  1.  I DUZ'=ACRDUZ D
  1.  .;S ACRNAM=$P(^VA(200,DUZ,0),U)  ;ACR*2.1*19.02 IM16848
  1.  .S ACRNAM=$$NAME2^ACRFUTL1(DUZ)  ;ACR*2.1*19.02 IM16848
  1.  .S ACRNAM=$P($P(ACRNAM,",",2)," ")_" "_$P(ACRNAM,",")
  1.  .S ACRDOC=$P(ACRDOC0,U)
  1.  .S:$P(^ACRDOC(ACRDOCDA,0),U,2)]""&($P(^(0),U,2)'=ACRDOC) ACRDOC=ACRDOC_" ("_$P(^(0),U,2)_")"
  1.  .W !!?10,@ACRON,$J(ACRNAM,30),@ACROF
  1.  .W !?12,"You are SIGNING Document No."
  1.  .W !?10,@ACRON,$J(ACRDOC,30),@ACROF
  1.  .;S ACRDUZX=$P(^VA(200,ACRDUZ,0),U)  ;ACR*2.1*19.02 IM16848
  1.  .S ACRDUZX=$$NAME2^ACRFUTL1(ACRDUZ)  ;ACR*2.1*19.02 IM16848
  1.  .S ACRDUZX=$P($P(ACRDUZX,",",2)," ")_" "_$P(ACRDUZX,",")
  1.  .S ACRAPVTX=$P(^ACRAPVT(ACRAPVT,0),U)
  1.  .I "^2^23^24^"[(U_ACRAPVT_U),$E(DT,4,5)<10,DT\10000+1700<$P(^ACRLOCB($P(ACRDOC0,U,6),"DT"),U) S ACRAPVTX="SUB. TO AVAIL. OF FUNDS"
  1.  .W !?6,"for ",@ACRON,$J(ACRDUZX,30),@ACROF
  1.  .W !?7,"as ",@ACRON,$J(ACRAPVTX,30),@ACROF
  1.  I $D(ACRAPDA)#2,ACRAPDA,$P($G(^ACRAPVS(ACRAPDA,0)),U,4)=99 W !!,@ACRON,"APPROVAL FOR RECERTIFICATION OF FUNDS",@ACROF
  1.  D EXCEED^ACRFWARN
  1. OPS I ACRAPVT'=41 D  I 1
  1.  .S DIR(0)="S^A:APPROVE;D:DISAPPROVE;R:RETURN FOR CHANGE/CLARIFICATION;H:HOLD;P:PRINT/DISPLAY DOCUMENT"
  1.  .S DIR("A")="APPROVAL"
  1.  E  D
  1.  .S DIR(0)="S^A:ACKNOWLEDGE RECEIPT OF REQUESTED SUPPLIES/SERVICES;H:HOLD"
  1.  .S DIR("A")="Which one"
  1.  I ACRREF=600,ACRAPVT'=43&(ACRAPVT'=15) S DIR(0)="S^A:APPROVE;R:RETURN FOR CHANGE/CLARIFICATION;H:HOLD;P:PRINT/DISPLAY DOCUMENT"
  1.  W !
  1.  D DIR^ACRFDIC
  1.  Q:$D(ACRQUIT)!$D(ACROUT)
  1.  Q:Y="H"
  1.  S ACRAPDAS=Y
  1.  I ACRAPDAS="P" D  G OPS
  1.  .N ACRREQST
  1.  .S (ACRREQST,ACRPRT)=""
  1.  .K ACRREV,ACRPSUM
  1.  .D REQ^ACRFQ
  1.  .S ACRREV=""
  1.  I "AD"[ACRAPDAS D CONFIRM^ACRFPRC4 I $D(ACRQUIT) K ACRQUIT Q
  1.  I ACRAPDAS="A",$$REQTP^ACRFSSU(ACRDOCDA)["CREDIT CARD" D     ;ACR*2.1*20.14
  1.  .N ACRVND                                    ;ACR*2.1*20.14
  1.  .S ACRVND=$P(^ACRDOC(ACRDOCDA,"PO"),U,5)     ;ACR*2.1*20.14          
  1.  .D CHKVNDR^ACRFVLK                           ;ACR*2.1*20.14
  1.  I $D(ACRQUIT) K ACRQUIT Q                    ;ACR*2.1*20.14
  1. RETURN ;EP;
  1.  I ACRAPDAS="R" D
  1.  .W !!,"Explain below the reason you are returning the document"
  1.  .W !,"and the requested change and/or clarification needed."
  1.  Q:'$D(ACRAPDA)#2
  1.  S ACRCNG=$G(^ACRAPVS(ACRAPDA,"CNG"))
  1.  S ACRRSN=$G(^ACRAPVS(ACRAPDA,"RSN"))
  1.  S ^ACRAPVS(ACRAPDA,"CNG")=""
  1.  S ^ACRAPVS(ACRAPDA,"RSN")=""
  1.  S DA=ACRAPDA
  1.  S DIE="^ACRAPVS("
  1.  S DR="[ACR REQUEST APPROVAL]"
  1.  W !
  1.  D DIE^ACRFDIC
  1.  I ACRAPDAS="R" D  I 1
  1.  .I $P($G(^ACRAPVS(ACRAPDA,0)),U,3)=9,$P($G(^ACROBL(ACRDOCDA,"APV")),U,8)="A" D  Q
  1.  ..S DA=ACRDOCDA
  1.  ..S DIE="^ACRTVAL("
  1.  ..S DR=".03///@;.04///@"
  1.  ..D DIE^ACRFDIC
  1.  .S DA=ACRDOCDA
  1.  .S DIE="^ACRDOC("
  1.  .S DR="5T;6////0;6.5////"_ACRAPDA
  1.  .W !
  1.  .D DIE^ACRFDIC
  1.  .K ^TMP("ACRDATA",$J,ACRDUZ,ACRJJ),^TMP("ACRALT",$J,ACRDUZ,ACRJJ)
  1.  .S DA=ACRAPDA
  1.  .S DIE="^ACRAPVS("
  1.  .S DR="6////"_DUZ
  1.  .D DIE^ACRFDIC
  1.  .I ^ACRAPVS(ACRAPDA,"CNG")]""!(^ACRAPVS(ACRAPDA,"RSN")]"") D CHANGE^ACRFPRC9
  1.  I ACRAPDAS="A",+$G(^ACRDOC(ACRDOCDA,"DT"))=1 D
  1.  .S DA=ACRDOCDA
  1.  .S DIE="^ACRDOC("
  1.  .S DR="5///0;6///@;6.5///@"
  1.  .W !
  1.  .D DIE^ACRFDIC
  1.  I (ACRAPDAS]""&(ACRAPDAS'="A"))!(ACRCNG'=$G(^ACRAPVS(ACRAPDA,"CNG")))!(ACRRSN'=$G(^ACRAPVS(ACRAPDA,"RSN"))) D ^ACRFXMY
  1.  Q:ACRAPDAS="R"
  1.  I ACRAPDAS="" K ACRQUIT Q
  1.  I DUZ'=ACRDUZ D  K ACRREQ,ACRREQ1
  1.  .S ACRREQ=$O(^ACRAPL("AC",ACRDUZ,+ACRAPVT,0))
  1.  .Q:'ACRREQ
  1.  .S ACRREQ1=$G(^ACRAPL(ACRREQ,"DT1"))
  1.  .S ACRREQ=$G(^ACRAPL(ACRREQ,"DT"))
  1.  .Q:'$L(ACRREQ)
  1.  .N J
  1.  .F J=1:1:4 I $P(ACRREQ,U,J)=DUZ,$P(ACRREQ1,U,J)=1 K ACRREQ,ACRREQ1 Q
  1.  .Q:$D(ACRREQ)
  1.  .D NOW^%DTC
  1.  .S Y=%
  1.  .X ^DD("DD")
  1.  .S XMB(1)="On "_Y_" "_$G(ACRNAM)_" signed"
  1.  .S XMB(2)="Document No.:  "_ACRDOC_"  ("_ACRID_")"
  1.  .S XMB(3)="on your behalf as "_$P(^ACRAPVT(ACRAPVT,0),U)
  1.  .S XMY(ACRDUZ)=""
  1.  .S XMDUZ=.5
  1.  .S XMTEXT="XMB("
  1.  .S XMSUB="REQUEST APPROVAL ALTERNATE"
  1.  .S XMB="ACR APPROVAL ALTERNATE"
  1.  .D ^XMD
  1.  .K ACRAPV,ACRCNG,ACRRSN,XMB,XMDUZ,XMSUB,XMY,XMTEXT
  1.  D APX^ACRFPRC3
  1.  I $G(ACRUSERZ),$G(ACRAPDAZ) D ZZ^ACRFPRC3 K ACRUSERZ,ACRAPDAZ
  1.  D:$D(ACRSIGN) AP1^ACRFPRC3
  1.  I "^2^23^24^"[(U_ACRAPVT_U),ACRAPDAS="A",$E(DT,4,5)<10,DT\10000+1700<$P(^ACRLOCB($P(ACRDOC0,U,6),"DT"),U) D RECERT^ACRFPRC4
  1.  K ^TMP("ACRDATA",$J,ACRDUZ,ACRJJ),^TMP("ACRALT",$J,ACRDUZ,ACRJJ)
  1.  I $P($G(ACRDOC0),U)]"" K ^TMP("ACRDATA",$J,ACRDUZ,$P(ACRDOC0,U)),^TMP("ACRALT",$J,ACRDUZ,$P(ACRDOC0,U))
  1.  Q
  1. SIGSCR(ACRAPVT,ACRAPVS,ACRTRAV,ACRATT,DUZ)       ;EP
  1.  ;----- EXTRINSIC FUNCTION - SCREEN FOR RESTRICTED APPROVAL SIGNATURES
  1.  ;
  1.  ;      ACRAPVT = APPROVAL TYPE
  1.  ;      ACRAPVS = APPROVAL SIGNATURE ARRAY
  1.  ;      ACRTRAV = TRAVELER, i.e., $P(^ACRDOC(D0,"TO"),U,9)
  1.  ;      ACRATT  = ATTENDEE
  1.  ;
  1.  ;      Returns Y:
  1.  ;        1st piece = 0 if no restriction, 1 if restriction
  1.  ;        2nd piece = restricted signature names
  1.  ;
  1.  S Y=0
  1.  I ACRAPVT=5,$G(ACRAPVS(2))[(U_DUZ_U) S Y=1_U_"APPROVING and FUNDS CERTIFYING"
  1.  I ACRAPVT=2,$G(ACRAPVS(5))[(U_DUZ_U) S Y=1_U_"APPROVING and FUNDS CERTIFYING"
  1.  I ACRAPVT=21,$G(ACRAPVS(36))[(U_DUZ_U)!(DUZ=ACRTRAV) S Y=1_U_"AUTHORIZING TRAVEL and as the TRAVELER"
  1.  I ACRAPVT=37,$G(ACRAPVS(40))[(U_DUZ_U) S Y=1_U_"APPROVING THE TRAVEL VOUCHER and as the TRAVELER"
  1.  I ACRAPVT=38,$G(ACRAPVS(40))[(U_DUZ_U) S Y=1_U_"CERTIFYING THE TRAVEL PAYMENT and as the TRAVELER"
  1.  I ACRAPVT=39,$G(ACRAPVS(40))[(U_DUZ_U) S Y=1_U_"AUDITING THE TRAVEL VOUCHER and as the TRAVELER"
  1.  I ACRAPVT=43,$G(ACRAPVS(36))[(U_DUZ_U)!(DUZ=ACRTRAV) S Y=1_U_"TRAVEL ORDER AUDITOR and as the TRAVELER"
  1.  I ACRAPVT=45,$G(ACRAPVS(40))[(U_DUZ_U) S Y=1_U_"RECOMMENDING THE TRAVEL VOUCHER and as the TRAVELER"
  1.  I ACRAPVT=1,$G(ACRAPVS(2))[(U_DUZ_U) S Y=1_U_"AUTHORIZING and FUNDS CERTIFYING"
  1.  I ACRAPVT=1,$G(ACRAPVS(5))[(U_DUZ_U) S Y=1_U_"AUTHORIZING and APPROVING"
  1.  I ACRAPVT=7,$G(ACRAPVS(1))[(U_DUZ_U) S Y=1_U_"RECEIVING and AUTHORIZING"
  1.  I ACRAPVT=8,$G(ACRAPVS(36))[(U_DUZ_U)!(DUZ=ACRTRAV) S Y=1_U_"RECOMMENDING TRAVEL and as the TRAVELER"
  1.  I ACRAPVT=9,DUZ=ACRATT S Y=1_U_"INITIATING SUPERVISOR and as the ATTENDEE"
  1.  Q Y