ACRFEA21 ;IHS/OIRM/DSD/THL,AEF - EDIT FINANCIAL DATA; [ 5/09/2007 8:03 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**5,20,22**;NOV 05, 2001
;;CONTINUATION OF ACRFEA2 -- HEAVILY REWRITTEN MRS:ACR*2.1*20.14
APPROVE ;EP;TO INITIATE APPROVAL PROCESS
S ACRAPCHK=""
N X,Y,ACRCCQ,ACRVND
S (X,Y,ACRCCQ)=0
S ACRVND=$P($G(^ACRDOC(ACRDOCDA,"PO")),U,5)
I $$REQTP^ACRFSSU(ACRDOCDA)["CREDIT CARD" S ACRCCQ=1
;
F S X=$O(^ACRSS("J",ACRDOCDA,X)) Q:'X S Y=Y+$P($G(^ACRSS(X,"DT")),U,4)
I Y D
.I $G(ACRREF)'=600 D CHECK^ACRFWARN
.Q:$D(ACRQUIT)
.;I ACRCCQ,Y>2500 D CHECKCC^ACRFWARN(Y) ;ACR*2.1*5.17 ;ACR*2.1*22.06 IM23064
.I ACRCCQ,Y>3000 D CHECKCC^ACRFWARN(Y) ;ACR*2.1*22.06 IM23064
.Q:$D(ACROUT) ;ACR*2.1*5.17
.I ACRCCQ!($P(ACRDOC0,U,12)),'ACRVND D NOVEN
.;Q:$D(ACRQUIT) ;ACR*2.1*5.17 ;ACR*2.1*22.11k
.;I ACRCCQ,'$P(ACRDOC0,U,25) D NOCCH ;ACR*2.1*22.11k
.;Q:$D(ACRQUIT) ;ACR*2.1*22.11k
.I ACRCCQ,'$P(^ACRDOC(ACRDOCDA,0),U,25) D NOCCH ;ACR*2.1*22.11k
Q:$D(ACRQUIT) ;ACR*2.1*22.11k
I +ACRVND,ACRCCQ!("^103^349^326^210^148^"[(U_ACRREF_U)) D
.D CHKVNDR^ACRFVLK
.;I $D(ACRVERR) S ACROUT="" ;ACR*2.1*22.11j IM23064
.I $D(ACRVERR) D Q ;ACR*2.1*22.11j IM23064
..W *7 ;ACR*2.1*22.11j IM23064
..W !!,ACRVERR ;ACR*2.1*22.11j IM23064
..D PAUSE^ACRFWARN ;ACR*2.1*22.11j IM23064
..S ACROUT="" ;ACR*2.1*22.11j IM23064
.D HOME^ACRFMENU
Q:$D(ACROUT) ;ACR*2.1*5.17
K ACRAPCHK
Q:$D(ACROUT)
;
I $P(ACRDOC0,U,12)="" D ;DRAFT PAYMENT DEFAULT
.S DA=ACRDOCDA
.S DIE="^ACRDOC("
.S DR=".12////0"
.D DIE^ACRFDIC
K ACRSSRQD
S ACRREFDA=$P(ACRDOC0,U,13)
S ACRREF=$P(^AUTTDOCR(ACRREFDA,0),U)
S ACRCISDA=$P(^ACRDOC(ACRDOCDA,0),U,16)
I ACRREF=148,$$ACSREQ^ACRFTO(ACRDOCDA)=1 D
.S ACRSSRQD="AGREEMENT TO CONTINUE IN SERVICE not signed."
I "^116^204^103^148^349^326^130^210^"[(U_ACRREF_U) D
.N:ACRREF=148 X
.S ACRSSDA=0
.F S ACRSSDA=$O(^ACRSS("C",ACRDOCDA,ACRSSDA)) Q:'ACRSSDA!$D(ACRSSRQD) D
..I $D(^ACRSS(ACRSSDA,0)) D SSCHK^ACRFSSA
..I ACRREF=148 S X=$G(X)+$P($G(^ACRSS(ACRSSDA,"DT")),U,4)
I ACRREFX=130,$P($G(^ACROBL(ACRDOCDA,"JST")),U)="" S ACRSSRQD="Purpose of Travel missing"
I ACRREFX=103!(ACRREFX=349)!(ACRREFX=326),'ACRCCQ D Q:$D(ACRI)
.K ACRI
.D 103^ACRFCHK
.I $D(ACRI) D Q
..W !!,*7,*7,"PO cannot be sent for approval until required BASIC DATA is completed."
..D PAUSE^ACRFWARN
I ACRREF=103!(ACRREF=349)!(ACRREF=326)!(ACRREF=210),'ACRCCQ,'$P(ACRDOC0,U,4) D
.I 'ACRCISDA S ACRSSRQD="Contract/Small Purchase Data missing." Q
.I ACRCISDA,'$D(^ACGS(ACRCISDA,0))!'$D(^ACGS(ACRCISDA,"DT"))!'$D(^ACGS(ACRCISDA,"DT1"))!'$D(^ACGS(ACRCISDA,"DT2"))!'$D(^ACGS(ACRCISDA,"DT3")) S ACRSSRQD=$S($D(ACRSSRQD):ACRSSRQD_" and ",1:"")_"Contract/Small Purchase Data missing." Q
.K ^TMP("ACG",$J)
.S ACGRDA=ACRCISDA
.D EN2^ACGSRQ
.I $D(^TMP("ACG",$J)),^TMP("ACG",$J,"T")>0 S ACRSSRQD=$S($D(ACRSSRQD):ACRSSRQD_" and ",1:"")_"Contract/Small Purchase Data missing."
.K ^TMP("ACG",$J)
I ACRREF=130!(ACRREF=600),'$P(ACRDOC0,U,15),'$D(^ACRTV("D",ACRDOCDA)) D
.S ACRSSRQD="NO TRAVEL DAYS RECORDED FOR THIS TRAVEL ORDER."
I $D(ACRSSRQD) D Q
.W !!,*7,*7,"DOCUMENT CANNOT BE SENT FOR APPROVAL."
.W !,ACRSSRQD
.K ACRSSRQD
.D PAUSE^ACRFWARN
I $P(^ACRDOC(ACRDOCDA,0),U,19) D I $D(ACRQUIT) K ACRQUIT Q
.D CALLIM^ACRFBPA
.Q:'$D(ACRQUIT)
.K ACRQUIT
.W *7,*7
.W !,"The DOLLAR AMOUNT of this call exceeds the amount authorized by the BPA."
.W !,"You are required to get verbal authorization to exceed the call limit."
.S DIR(0)="YO"
.S DIR("A")="Did you receive verbal authorization to exceed the call limit"
.S DIR("B")="NO"
.S DIR("?",1)="Enter 'Y' if you are authorized to exceed the call limit."
.S DIR("?")="Enter 'N' if you do not have proper authorization to exceed the call limit."
.D DIR^ACRFDIC
.I $G(Y)'=1 S ACRQUIT="" Q
.I $G(Y)=1 D
..D NOW^%DTC
..S DA=ACRDOCDA
..S DIE="^ACRDOC("
..S DR="21////"_%_";22////"_DUZ
..D DIE^ACRFDIC
APVS W !
I ACRREF=130,$P($G(^ACRDOC(ACRDOCDA,"TO")),U,25) D OTA
Q:$D(ACRQUIT)
D ^ACRFAPVS
N ACRDOCDA,ACRDOC,ACRID
D ACRREV^ACRFPRCS
K ACROUT,ACRQUIT
Q
NOVEN ;GIVE NO VENDOR W/CC MESSAGE
D WARNING^ACRFWARN
W !!,"A request for credit card purchase or draft payment cannot be sent for approval"
W !,"until a VENDOR has been selected from the Standard Vendor table."
W !!,"Select '2' - 'Requested Vendor' from the edit screen for this document"
W !,"and select a VENDOR/CONTRACTOR from the Standard Vendor table."
W !!,"If the requested vendor is not on the Standard Vendor table, contact"
W !,"your purchasing agent for assistance in getting the vendor added to the"
W !,"Standard Vendor table."
D PAUSE^ACRFWARN
S ACRQUIT="" ;ACR*2.1*22.11k
Q
NOCCH ;GIVE HOLDER MESSAGE
W !!,"A request for credit card purchase or draft payment cannot be sent for approval"
W !!,"without the credit card holder's name on file."
W !,"Please enter the name of the credit card holder before proceeding."
D PAUSE^ACRFWARN
S ACRQUIT="" ;ACR*2.1*22.11k
Q
OTA ;ACKNOWLEDGE TRAVEL ADVANCE
Q:$P($G(^ACROTA(ACRDOCDA,1)),U,3)]""
W !!,"I acknowledge request for travel advance."
I DUZ='$P($G(^ACRDOC(ACRDOCDA,"TO")),U,9) D
.W !!,"When submitting a Travel Order for approval which includes"
.W !,"a request for Travel Advance, the request requires the"
.W !,"signature of the Traveler to acknowledge the request for"
.W !,"Travel Advance."
.W !!,"Though you are not the traveler, you can send this TO for"
.W !,"approval but you must sign to acknowledge the request for"
.W !,"Travel Advance."
D ^ACRFESIG
I $D(ACRQUIT) D Q
.S ACRREFDA=$O(^AUTTDOCR("B",130,0))
.I ACRREFDA D KILL^ACRFAPVS
.W !!,"Travel order cannot be sent for approval without"
.W !,"acknowledging request for travel advance."
.D PAUSE^ACRFWARN
.S ACRQUIT=""
I '$D(^ACROTA(ACRDOCDA,0)) S:'$G(ACRADV) ACRADV=0 D OTA^ACRFSSA1
D NOW^%DTC
S DA=ACRDOCDA
S DIE="^ACROTA("
S DR="2////"_DUZ_";3////"_%
D DIE^ACRFDIC
Q
ACRFEA21 ;IHS/OIRM/DSD/THL,AEF - EDIT FINANCIAL DATA; [ 5/09/2007 8:03 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**5,20,22**;NOV 05, 2001
+2 ;;CONTINUATION OF ACRFEA2 -- HEAVILY REWRITTEN MRS:ACR*2.1*20.14
APPROVE ;EP;TO INITIATE APPROVAL PROCESS
+1 SET ACRAPCHK=""
+2 NEW X,Y,ACRCCQ,ACRVND
+3 SET (X,Y,ACRCCQ)=0
+4 SET ACRVND=$PIECE($GET(^ACRDOC(ACRDOCDA,"PO")),U,5)
+5 IF $$REQTP^ACRFSSU(ACRDOCDA)["CREDIT CARD"
SET ACRCCQ=1
+6 ;
+7 FOR
SET X=$ORDER(^ACRSS("J",ACRDOCDA,X))
IF 'X
QUIT
SET Y=Y+$PIECE($GET(^ACRSS(X,"DT")),U,4)
+8 IF Y
Begin DoDot:1
+9 IF $GET(ACRREF)'=600
DO CHECK^ACRFWARN
+10 IF $DATA(ACRQUIT)
QUIT
+11 ;I ACRCCQ,Y>2500 D CHECKCC^ACRFWARN(Y) ;ACR*2.1*5.17 ;ACR*2.1*22.06 IM23064
+12 ;ACR*2.1*22.06 IM23064
IF ACRCCQ
IF Y>3000
DO CHECKCC^ACRFWARN(Y)
+13 ;ACR*2.1*5.17
IF $DATA(ACROUT)
QUIT
+14 IF ACRCCQ!($PIECE(ACRDOC0,U,12))
IF 'ACRVND
DO NOVEN
+15 ;Q:$D(ACRQUIT) ;ACR*2.1*5.17 ;ACR*2.1*22.11k
+16 ;I ACRCCQ,'$P(ACRDOC0,U,25) D NOCCH ;ACR*2.1*22.11k
+17 ;Q:$D(ACRQUIT) ;ACR*2.1*22.11k
+18 ;ACR*2.1*22.11k
IF ACRCCQ
IF '$PIECE(^ACRDOC(ACRDOCDA,0),U,25)
DO NOCCH
End DoDot:1
+19 ;ACR*2.1*22.11k
IF $DATA(ACRQUIT)
QUIT
+20 IF +ACRVND
IF ACRCCQ!("^103^349^326^210^148^"[(U_ACRREF_U))
Begin DoDot:1
+21 DO CHKVNDR^ACRFVLK
+22 ;I $D(ACRVERR) S ACROUT="" ;ACR*2.1*22.11j IM23064
+23 ;ACR*2.1*22.11j IM23064
IF $DATA(ACRVERR)
Begin DoDot:2
+24 ;ACR*2.1*22.11j IM23064
WRITE *7
+25 ;ACR*2.1*22.11j IM23064
WRITE !!,ACRVERR
+26 ;ACR*2.1*22.11j IM23064
DO PAUSE^ACRFWARN
+27 ;ACR*2.1*22.11j IM23064
SET ACROUT=""
End DoDot:2
QUIT
+28 DO HOME^ACRFMENU
End DoDot:1
+29 ;ACR*2.1*5.17
IF $DATA(ACROUT)
QUIT
+30 KILL ACRAPCHK
+31 IF $DATA(ACROUT)
QUIT
+32 ;
+33 ;DRAFT PAYMENT DEFAULT
IF $PIECE(ACRDOC0,U,12)=""
Begin DoDot:1
+34 SET DA=ACRDOCDA
+35 SET DIE="^ACRDOC("
+36 SET DR=".12////0"
+37 DO DIE^ACRFDIC
End DoDot:1
+38 KILL ACRSSRQD
+39 SET ACRREFDA=$PIECE(ACRDOC0,U,13)
+40 SET ACRREF=$PIECE(^AUTTDOCR(ACRREFDA,0),U)
+41 SET ACRCISDA=$PIECE(^ACRDOC(ACRDOCDA,0),U,16)
+42 IF ACRREF=148
IF $$ACSREQ^ACRFTO(ACRDOCDA)=1
Begin DoDot:1
+43 SET ACRSSRQD="AGREEMENT TO CONTINUE IN SERVICE not signed."
End DoDot:1
+44 IF "^116^204^103^148^349^326^130^210^"[(U_ACRREF_U)
Begin DoDot:1
+45 IF ACRREF=148
NEW X
+46 SET ACRSSDA=0
+47 FOR
SET ACRSSDA=$ORDER(^ACRSS("C",ACRDOCDA,ACRSSDA))
IF 'ACRSSDA!$DATA(ACRSSRQD)
QUIT
Begin DoDot:2
+48 IF $DATA(^ACRSS(ACRSSDA,0))
DO SSCHK^ACRFSSA
+49 IF ACRREF=148
SET X=$GET(X)+$PIECE($GET(^ACRSS(ACRSSDA,"DT")),U,4)
End DoDot:2
End DoDot:1
+50 IF ACRREFX=130
IF $PIECE($GET(^ACROBL(ACRDOCDA,"JST")),U)=""
SET ACRSSRQD="Purpose of Travel missing"
+51 IF ACRREFX=103!(ACRREFX=349)!(ACRREFX=326)
IF 'ACRCCQ
Begin DoDot:1
+52 KILL ACRI
+53 DO 103^ACRFCHK
+54 IF $DATA(ACRI)
Begin DoDot:2
+55 WRITE !!,*7,*7,"PO cannot be sent for approval until required BASIC DATA is completed."
+56 DO PAUSE^ACRFWARN
End DoDot:2
QUIT
End DoDot:1
IF $DATA(ACRI)
QUIT
+57 IF ACRREF=103!(ACRREF=349)!(ACRREF=326)!(ACRREF=210)
IF 'ACRCCQ
IF '$PIECE(ACRDOC0,U,4)
Begin DoDot:1
+58 IF 'ACRCISDA
SET ACRSSRQD="Contract/Small Purchase Data missing."
QUIT
+59 IF ACRCISDA
IF '$DATA(^ACGS(ACRCISDA,0))!'$DATA(^ACGS(ACRCISDA,"DT"))!'$DATA(^ACGS(ACRCISDA,"DT1"))!'$DATA(^ACGS(ACRCISDA,"DT2"))!'$DATA(^ACGS(ACRCISDA,"DT3"))
SET ACRSSRQD=$SELECT($DATA(ACRSSRQD):ACRSSRQD_" and ",1:"")_"Contract/Small Purchase Data missing."
QUIT
+60 KILL ^TMP("ACG",$JOB)
+61 SET ACGRDA=ACRCISDA
+62 DO EN2^ACGSRQ
+63 IF $DATA(^TMP("ACG",$JOB))
IF ^TMP("ACG",$JOB,"T")>0
SET ACRSSRQD=$SELECT($DATA(ACRSSRQD):ACRSSRQD_" and ",1:"")_"Contract/Small Purchase Data missing."
+64 KILL ^TMP("ACG",$JOB)
End DoDot:1
+65 IF ACRREF=130!(ACRREF=600)
IF '$PIECE(ACRDOC0,U,15)
IF '$DATA(^ACRTV("D",ACRDOCDA))
Begin DoDot:1
+66 SET ACRSSRQD="NO TRAVEL DAYS RECORDED FOR THIS TRAVEL ORDER."
End DoDot:1
+67 IF $DATA(ACRSSRQD)
Begin DoDot:1
+68 WRITE !!,*7,*7,"DOCUMENT CANNOT BE SENT FOR APPROVAL."
+69 WRITE !,ACRSSRQD
+70 KILL ACRSSRQD
+71 DO PAUSE^ACRFWARN
End DoDot:1
QUIT
+72 IF $PIECE(^ACRDOC(ACRDOCDA,0),U,19)
Begin DoDot:1
+73 DO CALLIM^ACRFBPA
+74 IF '$DATA(ACRQUIT)
QUIT
+75 KILL ACRQUIT
+76 WRITE *7,*7
+77 WRITE !,"The DOLLAR AMOUNT of this call exceeds the amount authorized by the BPA."
+78 WRITE !,"You are required to get verbal authorization to exceed the call limit."
+79 SET DIR(0)="YO"
+80 SET DIR("A")="Did you receive verbal authorization to exceed the call limit"
+81 SET DIR("B")="NO"
+82 SET DIR("?",1)="Enter 'Y' if you are authorized to exceed the call limit."
+83 SET DIR("?")="Enter 'N' if you do not have proper authorization to exceed the call limit."
+84 DO DIR^ACRFDIC
+85 IF $GET(Y)'=1
SET ACRQUIT=""
QUIT
+86 IF $GET(Y)=1
Begin DoDot:2
+87 DO NOW^%DTC
+88 SET DA=ACRDOCDA
+89 SET DIE="^ACRDOC("
+90 SET DR="21////"_%_";22////"_DUZ
+91 DO DIE^ACRFDIC
End DoDot:2
End DoDot:1
IF $DATA(ACRQUIT)
KILL ACRQUIT
QUIT
APVS WRITE !
+1 IF ACRREF=130
IF $PIECE($GET(^ACRDOC(ACRDOCDA,"TO")),U,25)
DO OTA
+2 IF $DATA(ACRQUIT)
QUIT
+3 DO ^ACRFAPVS
+4 NEW ACRDOCDA,ACRDOC,ACRID
+5 DO ACRREV^ACRFPRCS
+6 KILL ACROUT,ACRQUIT
+7 QUIT
NOVEN ;GIVE NO VENDOR W/CC MESSAGE
+1 DO WARNING^ACRFWARN
+2 WRITE !!,"A request for credit card purchase or draft payment cannot be sent for approval"
+3 WRITE !,"until a VENDOR has been selected from the Standard Vendor table."
+4 WRITE !!,"Select '2' - 'Requested Vendor' from the edit screen for this document"
+5 WRITE !,"and select a VENDOR/CONTRACTOR from the Standard Vendor table."
+6 WRITE !!,"If the requested vendor is not on the Standard Vendor table, contact"
+7 WRITE !,"your purchasing agent for assistance in getting the vendor added to the"
+8 WRITE !,"Standard Vendor table."
+9 DO PAUSE^ACRFWARN
+10 ;ACR*2.1*22.11k
SET ACRQUIT=""
+11 QUIT
NOCCH ;GIVE HOLDER MESSAGE
+1 WRITE !!,"A request for credit card purchase or draft payment cannot be sent for approval"
+2 WRITE !!,"without the credit card holder's name on file."
+3 WRITE !,"Please enter the name of the credit card holder before proceeding."
+4 DO PAUSE^ACRFWARN
+5 ;ACR*2.1*22.11k
SET ACRQUIT=""
+6 QUIT
OTA ;ACKNOWLEDGE TRAVEL ADVANCE
+1 IF $PIECE($GET(^ACROTA(ACRDOCDA,1)),U,3)]""
QUIT
+2 WRITE !!,"I acknowledge request for travel advance."
+3 IF DUZ='$PIECE($GET(^ACRDOC(ACRDOCDA,"TO")),U,9)
Begin DoDot:1
+4 WRITE !!,"When submitting a Travel Order for approval which includes"
+5 WRITE !,"a request for Travel Advance, the request requires the"
+6 WRITE !,"signature of the Traveler to acknowledge the request for"
+7 WRITE !,"Travel Advance."
+8 WRITE !!,"Though you are not the traveler, you can send this TO for"
+9 WRITE !,"approval but you must sign to acknowledge the request for"
+10 WRITE !,"Travel Advance."
End DoDot:1
+11 DO ^ACRFESIG
+12 IF $DATA(ACRQUIT)
Begin DoDot:1
+13 SET ACRREFDA=$ORDER(^AUTTDOCR("B",130,0))
+14 IF ACRREFDA
DO KILL^ACRFAPVS
+15 WRITE !!,"Travel order cannot be sent for approval without"
+16 WRITE !,"acknowledging request for travel advance."
+17 DO PAUSE^ACRFWARN
+18 SET ACRQUIT=""
End DoDot:1
QUIT
+19 IF '$DATA(^ACROTA(ACRDOCDA,0))
IF '$GET(ACRADV)
SET ACRADV=0
DO OTA^ACRFSSA1
+20 DO NOW^%DTC
+21 SET DA=ACRDOCDA
+22 SET DIE="^ACROTA("
+23 SET DR="2////"_DUZ_";3////"_%
+24 DO DIE^ACRFDIC
+25 QUIT
