ACRFNXT ;IHS/OIRM/DSD/THL,AEF - UP DATE DOCUTMENT APPROVAL SEQUENCES; [ 09/23/2005 11:10 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**3,19**;NOV 05, 2001
;;ROUTINE TO UP DATE DOCUTMENT APPROVAL SEQUENCES
EN N ACRDOCDA
K ^ACRAPVS("ANXT")
S ACRDOCDA=0
F S ACRDOCDA=$O(^ACRAPVS("AORDR",ACRDOCDA)) Q:'ACRDOCDA D EN1
Q
EN1 ;EP;TO UPDATE DOCUMENT APPROVAL SEQUENCE FOR SPECIFIED DOCUMENT
N ACRDAX
S ACRORDR=0
F S ACRORDR=$O(^ACRAPVS("AORDR",ACRDOCDA,ACRORDR)) Q:'ACRORDR D
.S DA=$O(^ACRAPVS("AORDR",ACRDOCDA,ACRORDR,0))
.S ACRAPV0=$G(^ACRAPVS(+DA,0))
.S ACRAPVDT=$G(^ACRAPVS(+DA,"DT"))
.K ^ACRAPVS("ANXT",+$P(ACRAPV0,U,3),+$P(ACRAPVDT,U,2),+DA)
Q:$E($G(^ACROBL(ACRDOCDA,"APV")))="D"
S ACRORDR=0
F S ACRORDR=$O(^ACRAPVS("AORDR",ACRDOCDA,ACRORDR)) Q:'ACRORDR!$D(ACRQUIT) D
.S DA=$O(^ACRAPVS("AORDR",ACRDOCDA,ACRORDR,0))
.S ACRAPV0=$G(^ACRAPVS(DA,0))
.S ACRAPVDT=$G(^ACRAPVS(DA,"DT"))
.I $P(ACRAPVDT,U,2),$P(ACRAPV0,U,3),$P(ACRAPVDT,U)="" D
..S ACRDAX=$O(^ACRAPVS("AORDR",ACRDOCDA,ACRORDR-1,0))
..I ACRDAX S ACRDAX=$P($G(^ACRAPVS(ACRDAX,"DT")),U,4)
..Q:'ACRDAX
..S ^ACRAPVS("ANXT",$P(ACRAPV0,U,3),$P(ACRAPVDT,U,2),DA)=ACRDOCDA ;ACR*2.1*3.39
..S ACRQUIT=""
..S $P(^ACRAPVS(DA,"DT"),U,3)=ACRDAX
..D DOMAIN
.K ACRAPV0,ACRAPVDT,ACRQUIT
Q
DOMAIN ;EP;TO SEND NOTIFICATION OF PENDING SIGNATURE TO ANOTHER DOMAIN
Q
N ACRDUZ,ACRX,ACRDOM,ACRDOC,ACRTXT
S ACRDUZ=$P(ACRAPVDT,U,2)
Q:ACRDUZ=DUZ
Q:'$D(^ACRAU(ACRDUZ,2,"B"))#2
S ACRX=0
F S ACRX=$O(^ACRAU(ACRDUZ,2,"B",ACRX)) Q:'ACRX D D1
Q
D1 S ACRDOM=$P(^DIC(4.2,ACRX,0),U)
S ACRDOC=+ACRAPV0
S ACRDOC0=^ACRDOC(ACRDOC,0)
S ACRDOC=$P(ACRDOC0,U)
S ACRDOC2=$P(ACRDOC0,U,2)
S ACRDOC=ACRDOC_$S(ACRDOC2=""!(ACRDOC=ACRDOC2)!(ACRDOC2["PENDING"):"",1:" ("_(ACRDOC2)_")")
S XMSUB="ARMS SIGNATURE PENDING"
;S XMY($P(^VA(200,ACRDUZ,0),U)_"@"_ACRDOM)="",ACRAREA="" ;ACR*2.1*19.02 IM16848
S XMY($$NAME2^ACRFUTL1(ACRDUZ)_"@"_ACRDOM)="",ACRAREA="" ;ACR*2.1*19.02 IM16848
S XMTEXT="ACRTXT("
N X
S X=$S(ACRREF=116:"REQUISITION",ACRREF=103:"PURCHASE ORDER",ACRREF=349:"CONTRACT",ACRREF=326:"TRIBAL CONTRACT",$P(ACRDOC0,U,19):"BPA CALL",ACRREF=210:"FEDSTRIP/SUPPLY CENTER ORDER",ACRREF=130:"TRAVEL ORDER",ACRREF=600:"TRAVEL VOUCHER",1:"")
S ACRTXT(1)=$S(X]"":X,1:"DOCUMENT")_" NO.: "_ACRDOC
S X=$S(ACRREF=130!(ACRREF=600):$P($G(^ACRDOC(+$P(ACRDOC0,U,6),"TO")),U,9),1:"")
;S:X X=$P($G(^VA(200,X,0)),U) ;ACR*2.1*19.02 IM16848
S:X X=$$NAME2^ACRFUTL1(X) ;ACR*2.1*19.02 IM16848
S:X]"" X=$P($P(X,",",2)," ")_" "_$P(X,",")
S:X]"" ACRTXT(1)=ACRTXT(1)_" for "_X_" "
S ACRTXT(2)="is pending your signature as "_$P(^ACRAPVT($P(ACRAPV0,U,3),0),U)
S ACRTXT(3)="Please log onto the "_$S(ACRAREA]"":ACRAREA_" ",1:"")_"Area Office ARMS computer"
S ACRTXT(4)="at your earliest convenience to sign this document."
D ^XMD
Q
ACRFNXT ;IHS/OIRM/DSD/THL,AEF - UP DATE DOCUTMENT APPROVAL SEQUENCES; [ 09/23/2005 11:10 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**3,19**;NOV 05, 2001
+2 ;;ROUTINE TO UP DATE DOCUTMENT APPROVAL SEQUENCES
EN NEW ACRDOCDA
+1 KILL ^ACRAPVS("ANXT")
+2 SET ACRDOCDA=0
+3 FOR
SET ACRDOCDA=$ORDER(^ACRAPVS("AORDR",ACRDOCDA))
IF 'ACRDOCDA
QUIT
DO EN1
+4 QUIT
EN1 ;EP;TO UPDATE DOCUMENT APPROVAL SEQUENCE FOR SPECIFIED DOCUMENT
+1 NEW ACRDAX
+2 SET ACRORDR=0
+3 FOR
SET ACRORDR=$ORDER(^ACRAPVS("AORDR",ACRDOCDA,ACRORDR))
IF 'ACRORDR
QUIT
Begin DoDot:1
+4 SET DA=$ORDER(^ACRAPVS("AORDR",ACRDOCDA,ACRORDR,0))
+5 SET ACRAPV0=$GET(^ACRAPVS(+DA,0))
+6 SET ACRAPVDT=$GET(^ACRAPVS(+DA,"DT"))
+7 KILL ^ACRAPVS("ANXT",+$PIECE(ACRAPV0,U,3),+$PIECE(ACRAPVDT,U,2),+DA)
End DoDot:1
+8 IF $EXTRACT($GET(^ACROBL(ACRDOCDA,"APV")))="D"
QUIT
+9 SET ACRORDR=0
+10 FOR
SET ACRORDR=$ORDER(^ACRAPVS("AORDR",ACRDOCDA,ACRORDR))
IF 'ACRORDR!$DATA(ACRQUIT)
QUIT
Begin DoDot:1
+11 SET DA=$ORDER(^ACRAPVS("AORDR",ACRDOCDA,ACRORDR,0))
+12 SET ACRAPV0=$GET(^ACRAPVS(DA,0))
+13 SET ACRAPVDT=$GET(^ACRAPVS(DA,"DT"))
+14 IF $PIECE(ACRAPVDT,U,2)
IF $PIECE(ACRAPV0,U,3)
IF $PIECE(ACRAPVDT,U)=""
Begin DoDot:2
+15 SET ACRDAX=$ORDER(^ACRAPVS("AORDR",ACRDOCDA,ACRORDR-1,0))
+16 IF ACRDAX
SET ACRDAX=$PIECE($GET(^ACRAPVS(ACRDAX,"DT")),U,4)
+17 IF 'ACRDAX
QUIT
+18 ;ACR*2.1*3.39
SET ^ACRAPVS("ANXT",$PIECE(ACRAPV0,U,3),$PIECE(ACRAPVDT,U,2),DA)=ACRDOCDA
+19 SET ACRQUIT=""
+20 SET $PIECE(^ACRAPVS(DA,"DT"),U,3)=ACRDAX
+21 DO DOMAIN
End DoDot:2
+22 KILL ACRAPV0,ACRAPVDT,ACRQUIT
End DoDot:1
+23 QUIT
DOMAIN ;EP;TO SEND NOTIFICATION OF PENDING SIGNATURE TO ANOTHER DOMAIN
+1 QUIT
+2 NEW ACRDUZ,ACRX,ACRDOM,ACRDOC,ACRTXT
+3 SET ACRDUZ=$PIECE(ACRAPVDT,U,2)
+4 IF ACRDUZ=DUZ
QUIT
+5 IF '$DATA(^ACRAU(ACRDUZ,2,"B"))#2
QUIT
+6 SET ACRX=0
+7 FOR
SET ACRX=$ORDER(^ACRAU(ACRDUZ,2,"B",ACRX))
IF 'ACRX
QUIT
DO D1
+8 QUIT
D1 SET ACRDOM=$PIECE(^DIC(4.2,ACRX,0),U)
+1 SET ACRDOC=+ACRAPV0
+2 SET ACRDOC0=^ACRDOC(ACRDOC,0)
+3 SET ACRDOC=$PIECE(ACRDOC0,U)
+4 SET ACRDOC2=$PIECE(ACRDOC0,U,2)
+5 SET ACRDOC=ACRDOC_$SELECT(ACRDOC2=""!(ACRDOC=ACRDOC2)!(ACRDOC2["PENDING"):"",1:" ("_(ACRDOC2)_")")
+6 SET XMSUB="ARMS SIGNATURE PENDING"
+7 ;S XMY($P(^VA(200,ACRDUZ,0),U)_"@"_ACRDOM)="",ACRAREA="" ;ACR*2.1*19.02 IM16848
+8 ;ACR*2.1*19.02 IM16848
SET XMY($$NAME2^ACRFUTL1(ACRDUZ)_"@"_ACRDOM)=""
SET ACRAREA=""
+9 SET XMTEXT="ACRTXT("
+10 NEW X
+11 SET X=$SELECT(ACRREF=116:"REQUISITION",ACRREF=103:"PURCHASE ORDER",ACRREF=349:"CONTRACT",ACRREF=326:"TRIBAL CONTRACT",$PIECE(ACRDOC0,U,19):"BPA CALL",ACRREF=210:"FEDSTRIP/SUPPLY CENTER ORDER",ACRREF=130:"TRAVEL ORDER",ACRREF=600:"TRAVEL VOUCHER
",1:"")
+12 SET ACRTXT(1)=$SELECT(X]"":X,1:"DOCUMENT")_" NO.: "_ACRDOC
+13 SET X=$SELECT(ACRREF=130!(ACRREF=600):$PIECE($GET(^ACRDOC(+$PIECE(ACRDOC0,U,6),"TO")),U,9),1:"")
+14 ;S:X X=$P($G(^VA(200,X,0)),U) ;ACR*2.1*19.02 IM16848
+15 ;ACR*2.1*19.02 IM16848
IF X
SET X=$$NAME2^ACRFUTL1(X)
+16 IF X]""
SET X=$PIECE($PIECE(X,",",2)," ")_" "_$PIECE(X,",")
+17 IF X]""
SET ACRTXT(1)=ACRTXT(1)_" for "_X_" "
+18 SET ACRTXT(2)="is pending your signature as "_$PIECE(^ACRAPVT($PIECE(ACRAPV0,U,3),0),U)
+19 SET ACRTXT(3)="Please log onto the "_$SELECT(ACRAREA]"":ACRAREA_" ",1:"")_"Area Office ARMS computer"
+20 SET ACRTXT(4)="at your earliest convenience to sign this document."
+21 DO ^XMD
+22 QUIT
