ACRFCSI ;IHS/OIRM/DSD/THL,AEF - UTILITY TO DISPLAY NEXT PERSON TO SIGN DOCUMENT; [ 09/23/2005 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**19**;NOV 05, 2001
;;UTILITY TO DISPLAY NEXT PERSON TO SIGN DOCUMENT
EN D EN1
EXIT K ACRIN
Q
EN1 ;EP;TO DISPLAY NEXT PERSON TO SIGN DOCUMENT
N ACRX,ACRAPDA,ACRINDV,ACRDOCDA
S ACRDOCDA=+ACR(ACRI)
S ACRREFDA=$P(^ACRDOC(ACRDOCDA,0),U,13)
S ACRREF=$P(^AUTTDOCR(ACRREFDA,0),U)
D EN2
W !?8,ACRINDV
I $D(ACR(ACRI+ACR10)) D
.S ACRDOCDA=+ACR(ACRI+ACR10)
.S ACRREFDA=$P(^ACRDOC(ACRDOCDA,0),U,13)
.S ACRREF=$P(^AUTTDOCR(ACRREFDA,0),U)
.D EN2
.W ?48,ACRINDV
Q
EN2 ;DETERMINE NEXT PERSON TO SIGN DOCUMENT
S ACRX=0
S ACRINDV=""
I '$D(^ACRAPVS("AORDR",ACRDOCDA)) D Q
.S ACRINDV=$S($E($G(^ACROBL(ACRDOCDA,"APV")))'="D":"NOT SUBMITTED FOR APPROVAL",1:"HAS BEEN DISAPPROVED")
I ACRINDV="","^103^349^326^210^600^"[(U_ACRREF_U),$P($G(^ACROBL(ACRDOCDA,"APV")),U,8)]"" S ACRAPV=^("APV") D Q
.S ACRINDV=$S(ACRREF=103:"PURCHASE ORDER",ACRREF=349:"CONTRACT",ACRREF=326:"TRIBAL CONTRACT",ACRREF=210:"FEDSTRIP",ACRREF=600:"TRAVEL VOUCHER")_$S($P(ACRAPV,U,8)="A":" APPROVED",1:"DISAPPROVED")
I "^103^349^326^210^"[(U_ACRREF_U),+$G(^ACRDOC(ACRDOCDA,"PA")) D Q
.N X
.;S X=$P(^VA(200,+^ACRDOC(ACRDOCDA,"PA"),0),U) ;ACR*2.1*19.02 IM16848
.S X=$$NAME2^ACRFUTL1(+^ACRDOC(ACRDOCDA,"PA")) ;ACR*2.1*19.02 IM16848
.S ACRINDV="PO ASSIGNED TO "_$E($P(X,",",2))_" "_$P(X,",")
I ACRINDV="" D
.F S ACRX=$O(^ACRAPVS("AORDR",ACRDOCDA,ACRX)) Q:'ACRX!(ACRINDV]"") D
..S ACRAPDA=0
..F S ACRAPDA=$O(^ACRAPVS("AORDR",ACRDOCDA,ACRX,ACRAPDA)) Q:'ACRAPDA!(ACRINDV]"") D
...I $D(^ACRAPVS(ACRAPDA,"DT")),$P(^("DT"),U)="",$P(^("DT"),U,2),$D(^VA(200,$P(^ACRAPVS(ACRAPDA,"DT"),U,2),0)) D
....N X
....S X=$P(^ACRAPVS(ACRAPDA,"DT"),U,2),ACRIN=$P(^("DT"),U,3)
....;S X=$P(^VA(200,X,0),U) ;ACR*2.1*19.02 IM16848
....S X=$$NAME2^ACRFUTL1(X) ;ACR*2.1*19.02 IM16848
....S ACRINDV=$E($P(X,",",2))_" "_$P(X,",")
....S:ACRIN]"" ACRINDV=ACRINDV_" "_$E(ACRIN,4,5)_"/"_$E(ACRIN,6,7)_"@"_$E($P(ACRIN,".",2),1,4)
...I ACRINDV="","^103^349^326^210^600^"[(U_ACRREF_U) S ACRINDV=$S(ACRREF=103:"PURCHASE ORDER",ACRREF=349:"CONTRACT",ACRREF=326:"TRIBAL CONTRACT",ACRREF=210:"FEDSTRIP",ACRREF=600:"TRAVEL VOUCHER")_" PENDING"
Q
ACRFCSI ;IHS/OIRM/DSD/THL,AEF - UTILITY TO DISPLAY NEXT PERSON TO SIGN DOCUMENT; [ 09/23/2005 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**19**;NOV 05, 2001
+2 ;;UTILITY TO DISPLAY NEXT PERSON TO SIGN DOCUMENT
EN DO EN1
EXIT KILL ACRIN
+1 QUIT
EN1 ;EP;TO DISPLAY NEXT PERSON TO SIGN DOCUMENT
+1 NEW ACRX,ACRAPDA,ACRINDV,ACRDOCDA
+2 SET ACRDOCDA=+ACR(ACRI)
+3 SET ACRREFDA=$PIECE(^ACRDOC(ACRDOCDA,0),U,13)
+4 SET ACRREF=$PIECE(^AUTTDOCR(ACRREFDA,0),U)
+5 DO EN2
+6 WRITE !?8,ACRINDV
+7 IF $DATA(ACR(ACRI+ACR10))
Begin DoDot:1
+8 SET ACRDOCDA=+ACR(ACRI+ACR10)
+9 SET ACRREFDA=$PIECE(^ACRDOC(ACRDOCDA,0),U,13)
+10 SET ACRREF=$PIECE(^AUTTDOCR(ACRREFDA,0),U)
+11 DO EN2
+12 WRITE ?48,ACRINDV
End DoDot:1
+13 QUIT
EN2 ;DETERMINE NEXT PERSON TO SIGN DOCUMENT
+1 SET ACRX=0
+2 SET ACRINDV=""
+3 IF '$DATA(^ACRAPVS("AORDR",ACRDOCDA))
Begin DoDot:1
+4 SET ACRINDV=$SELECT($EXTRACT($GET(^ACROBL(ACRDOCDA,"APV")))'="D":"NOT SUBMITTED FOR APPROVAL",1:"HAS BEEN DISAPPROVED")
End DoDot:1
QUIT
+5 IF ACRINDV=""
IF "^103^349^326^210^600^"[(U_ACRREF_U)
IF $PIECE($GET(^ACROBL(ACRDOCDA,"APV")),U,8)]""
SET ACRAPV=^("APV")
Begin DoDot:1
+6 SET ACRINDV=$SELECT(ACRREF=103:"PURCHASE ORDER",ACRREF=349:"CONTRACT",ACRREF=326:"TRIBAL CONTRACT",ACRREF=210:"FEDSTRIP",ACRREF=600:"TRAVEL VOUCHER")_$SELECT($PIECE(ACRAPV,U,8)="A":" APPROVED",1:"DISAPPROVED")
End DoDot:1
QUIT
+7 IF "^103^349^326^210^"[(U_ACRREF_U)
IF +$GET(^ACRDOC(ACRDOCDA,"PA"))
Begin DoDot:1
+8 NEW X
+9 ;S X=$P(^VA(200,+^ACRDOC(ACRDOCDA,"PA"),0),U) ;ACR*2.1*19.02 IM16848
+10 ;ACR*2.1*19.02 IM16848
SET X=$$NAME2^ACRFUTL1(+^ACRDOC(ACRDOCDA,"PA"))
+11 SET ACRINDV="PO ASSIGNED TO "_$EXTRACT($PIECE(X,",",2))_" "_$PIECE(X,",")
End DoDot:1
QUIT
+12 IF ACRINDV=""
Begin DoDot:1
+13 FOR
SET ACRX=$ORDER(^ACRAPVS("AORDR",ACRDOCDA,ACRX))
IF 'ACRX!(ACRINDV]"")
QUIT
Begin DoDot:2
+14 SET ACRAPDA=0
+15 FOR
SET ACRAPDA=$ORDER(^ACRAPVS("AORDR",ACRDOCDA,ACRX,ACRAPDA))
IF 'ACRAPDA!(ACRINDV]"")
QUIT
Begin DoDot:3
+16 IF $DATA(^ACRAPVS(ACRAPDA,"DT"))
IF $PIECE(^("DT"),U)=""
IF $PIECE(^("DT"),U,2)
IF $DATA(^VA(200,$PIECE(^ACRAPVS(ACRAPDA,"DT"),U,2),0))
Begin DoDot:4
+17 NEW X
+18 SET X=$PIECE(^ACRAPVS(ACRAPDA,"DT"),U,2)
SET ACRIN=$PIECE(^("DT"),U,3)
+19 ;S X=$P(^VA(200,X,0),U) ;ACR*2.1*19.02 IM16848
+20 ;ACR*2.1*19.02 IM16848
SET X=$$NAME2^ACRFUTL1(X)
+21 SET ACRINDV=$EXTRACT($PIECE(X,",",2))_" "_$PIECE(X,",")
+22 IF ACRIN]""
SET ACRINDV=ACRINDV_" "_$EXTRACT(ACRIN,4,5)_"/"_$EXTRACT(ACRIN,6,7)_"@"_$EXTRACT($PIECE(ACRIN,".",2),1,4)
End DoDot:4
+23 IF ACRINDV=""
IF "^103^349^326^210^600^"[(U_ACRREF_U)
SET ACRINDV=$SELECT(ACRREF=103:"PURCHASE ORDER",ACRREF=349:"CONTRACT",ACRREF=326:"TRIBAL CONTRACT",ACRREF=210:"FEDSTRIP",ACRREF=600:"TRAVEL VOUCHER")_" PENDING"
End DoDot:3
End DoDot:2
End DoDot:1
+24 QUIT