- 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
