- 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
