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