ACRFWARN ;IHS/OIRM/DSD/THL,AEF - WARNING AND MESSAGES; [ 1/31/2007 10:19 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**5,19,22**;NOV 05, 2001
;;ROUTINE USED TO DISPLAY AND PROCESS VARIOUS WARNINGS AND MESSAGES
EXCTOT ;EP;
W @IOF
W *7,*7
D WARNING
W !!,"The total ",ACRFDNY," available has been exceeded."
W !,"The sum of all entries must not exceed the total ",ACRFDNY," available."
D DIK^ACRFDIC
S ACRQUIT=""
D PAUSE
Q
MAX ;EP;
Q:X<ACRTXLIM+1
W !!?10,X," is over your procurement limit (",ACRTXLIM,")"
K X
Q
MESSAGE ;EP;
W !!,"One moment please, message being delivered."
S ACRCNG=$G(^ACRAPVS(ACRAPDA,"CNG"))
S ACRRSN=$G(^ACRAPVS(ACRAPDA,"RSN"))
S ACRAPV=$E(^ACRAPVS(ACRAPDA,"DT"))
S ^ACROBL(ACRDOCDA,"CNG")=ACRCNG
S ^ACROBL(ACRDOCDA,"RSN")=ACRRSN
S XMB(1)="Document no. "_ACRDOC_" ("_$P(^ACRDOC(ACRDOCDA,0),U,14)_") ,was "_$S(ACRAPV="A":"APPROVED",1:"DISAPPROVD")_" by "
;S XMB(2)=$P(^VA(200,$P(^ACRAPVS(ACRAPDA,"DT"),U,2),0),U) ;ACR*2.1*19.02 IM16848
S XMB(2)=$$NAME2^ACRFUTL1($P(^ACRAPVS(ACRAPDA,"DT"),U,2)) ;ACR*2.1*19.02 IM16848
S XMB(2)=$P($P(XMB(2),",",2)," ")_" "_$P(XMB(2),",")
S XMB(3)=$P(^ACRAPVT($P(^ACRAPVS(ACRAPDA,0),U,3),0),U)
S XMB(3)=$P($P(XMB(3),",",2)," ")_" "_$P(XMB(3),",")
S XMB(2)=XMB(2)_" as the "_XMB(3)
S XMB(3)=" "
S XMB(4)="Information which needs to be changed:"
I ACRCNG]"" D
.N ACRI
.F ACRI=1:1:5 S:$P(ACRCNG,U,ACRI)]"" XMB(ACRI+4)=$P(ACRCNG,U,ACRI)
S XMB(10)=" "
S XMB(11)="Reason for change: "
I ACRRSN]"" D
.N ACRI
.F ACRI=1:1:5 S:$P(ACRRSN,U,ACRI)]"" XMB(ACRI+11)=$P(ACRRSN,U,ACRI)
S XMDUZ=.5
S XMTEXT="XMB("
S XMSUB="REQUEST COMMENT/DISAPPROVAL NOTIFICATION"
S XMB="ACR REQUEST STATUS"
D ^XMD
K ACRAPV,ACRCNG,ACRRSN,XMB,XMDUZ,XMSUB,XMY,XMTEXT
Q
CHECK ;EP;
N X,Y
K ACRQUIT,ACROUT
Q:'$G(ACRDOCDA)!'$D(ACRFDNAM) ;ACR*2.1*5.06
S:'$G(ACRLBDA) ACRLBDA=$P(^ACRDOC(ACRDOCDA,0),U,6)
Q:'ACRLBDA
Q:$P(^ACRLOCB(ACRLBDA,0),U,21)=1 S X=$P(^(0),U,21)
Q:'$P($G(^ACRSYS(1,"DT1")),U,3) S Y=$P(^("DT1"),U,3)
I Y=2,X'=2 Q
Q:$P(^ACRLOCB(ACRLBDA,"BA"),U,2)<(ACRFDNAM+.01)
W *7,*7
D WARNING
W !!?10,"THE ",@ACRON,$FN(ACRFDNAM,"P,",2),@ACROF," ALLOCATED TO THIS BUDGET HAS BEEN EXCEEDED."
W !?10,"REVIEW THIS ACCOUNT WITH THE FINANCIAL MANAGEMENT OFFICER"
I $D(ACRAPCHK)#2 D PAUSE^ACRFWARN S ACROUT="" Q
S DIR(0)="YO"
S DIR("A",1)="Edit/Delete "_$S(ACRREF=130!(ACRREF=600):"Travel Days",ACRREF=148:"Training Expenses",1:"Items")
S DIR("A")="to DECREASE the cost"
S DIR("B")="NO"
W !
D DIR^ACRFDIC
I Y'=1 S (ACRQUIT,ACROUT)="" Q
K ACRQUIT,ACROUT
Q
CHECK1 ;EP;
Q:'$P(^ACRSYS(1,"DT"),U,99)
W !!?10,*7,"YOU HAVE EXCEEDED YOUR PROCUREMENT LIMIT (",ACRTXLIM,".00)"
W !?10,"THE LAST ITEM YOU ENTERED WILL BE DELETED. MAKE THE NECESSARY"
W !?10,"ADJUSTMETS TO KEEP THIS REQUEST WITHIN YOUR PROCUREMENT LIMIT."
D PAUSE
S DA=ACRSSDA
S DIK="^ACRSS("
D DIK^ACRFDIC
Q
CHECKCC(ACRSSTOT) ;EP; ;ACR*2.1*5.17
N X,Y
K ACRQUIT,ACROUT
W *7,*7
D WARNING
W !!?10,"THE TOTAL OF ",@ACRON,$FN(ACRSSTOT,"P,",2),@ACROF
;W " EXCEEDS THE $2500.00 PER PURCHASE" ;ACR*2.1*22.11j IM23064
W " EXCEEDS THE $3000.00 PER PURCHASE" ;ACR*2.1*22.11j IM23064
W !?10,"SPENDING LIMIT ALLOWED FOR A CREDIT CARD PURCHASE"
;I $D(ACRAPCHK)#2 D PAUSE^ACRFWARN S ACROUT="" Q
S DIR(0)="YO"
S DIR("A")="Edit/Delete Items to DECREASE the cost"
S DIR("B")="NO"
W !
D DIR^ACRFDIC
Q
PAUSE ;EP;
Q:$E(IOST,1,2)'="C-"
K DIR
P1 ;EP;
W !
S DIR(0)="EOA"
S DIR("A")="Press RETURN to continue or '^' to exit. "
D DIR^ACRFDIC
S:$G(X)["^" DN=0,ACROUT=""
Q
TOTAL ;EP;TO CALCULATE THE TOTAL DOLLARS OF A PO PLUS MODS
;ACRORIDA IS THE INTERNAL ENTRY NUMBER OF THE ORIGINAL DOCUMENT
Q:'$D(ACRORIDA)
K ACR
S ACRSSTOT=0
S ACR=ACRORIDA
S ACR(ACRORIDA)=0
D SSTOT
S ACR=0
F S ACR=$O(^ACRDOC("MOD",ACRORIDA,ACR)) Q:'ACR D SSTOT
Q
SSTOT ;EP - TOTAL OF ALL OBLIGATED AMOUNTS FOR ALL ITEMS ON THE PO PLUS MODS
N ACRSSDA
S (ACRSSDA,ACRTOT,ACR(ACR))=0
F S ACRSSDA=$O(^ACRSS("J",ACR,ACRSSDA)) Q:'ACRSSDA D
.S ACRTOT=$P($G(^ACRSS(ACRSSDA,"DT")),U,4)
.S ACRSSTOT=$G(ACRSSTOT)+ACRTOT
.S ACR(ACR)=$G(ACR(ACR))+ACRTOT
Q
EXTOT ;EP;WARNING MESSAGE IF TOTAL OBLIGATED EXCEEDS PROCUREMENT AUTHORITY
Q:'$D(ACRSSTOT)
N ACRLIM
I ACRSSTOT>$P(^ACRSYS(1,"DT"),U,24) S ACRLIM=$P(^("DT"),U,24) D
.W *7,*7
.W !!,"The TOTAL DOLLAR VALUE of this action: ",@ACRON,$J($FN(ACRSSTOT,"P",2),12),@ACROF
.W !,"Exceeds the Area Procurement limit of: ",@ACRON,$J($FN(ACRLIM,"P",2),12),@ACROF
.W !!,"Ths summary of dollar amounts for the original action plus mods is listed below."
.W !,"Consult with your Purchasing Office reqarding this action before proceeding."
W !!?10,"PURCHASE ORDER"
W ?30,"REQUISITION NUMBER"
W ?50,"DOLLAR AMOUNT"
W !?10,"--------------"
W ?30,"------------------"
W ?50,"-------------"
S ACR=0
F S ACR=$O(ACR(ACR)) Q:'ACR D
.S ACR0=^ACRDOC(ACR,0),ACRTOT=ACR(ACR)
.W !?10,$P(ACR0,U,2)
.W ?30,$P(ACR0,U)
.W ?50,$J($FN(ACRTOT,"P",2),12)
Q
EXCEED ;EP;TO CALCULATE AND DISPLAY DATA FOR PO AND MODS WHICH EXCEED
;THE AREA PROCUREMENT LIMIT
Q:"^116^204^103^"'[(U_$G(ACRREF)_U)
Q:$P($G(^ACRDOC(ACRDOCDA,3)),U,13)
S ACRORIDA=$S($P(^ACRDOC(ACRDOCDA,0),U,15):$P(^(0),U,15),1:ACRDOCDA)
D TOTAL
Q:$P(^ACRSYS(1,"DT"),U,24)+1>ACRSSTOT
D EXTOT
D PAUSE
Q
WARNING ;EP;TO DISPLAY WARNING MESSAGE
D B1^ACRFMENU
N ACRI
W !!
F ACRI=1:1:6 W ?$X+5,"WARNING"
D B2^ACRFMENU
Q
ACRFWARN ;IHS/OIRM/DSD/THL,AEF - WARNING AND MESSAGES; [ 1/31/2007 10:19 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**5,19,22**;NOV 05, 2001
+2 ;;ROUTINE USED TO DISPLAY AND PROCESS VARIOUS WARNINGS AND MESSAGES
EXCTOT ;EP;
+1 WRITE @IOF
+2 WRITE *7,*7
+3 DO WARNING
+4 WRITE !!,"The total ",ACRFDNY," available has been exceeded."
+5 WRITE !,"The sum of all entries must not exceed the total ",ACRFDNY," available."
+6 DO DIK^ACRFDIC
+7 SET ACRQUIT=""
+8 DO PAUSE
+9 QUIT
MAX ;EP;
+1 IF X<ACRTXLIM+1
QUIT
+2 WRITE !!?10,X," is over your procurement limit (",ACRTXLIM,")"
+3 KILL X
+4 QUIT
MESSAGE ;EP;
+1 WRITE !!,"One moment please, message being delivered."
+2 SET ACRCNG=$GET(^ACRAPVS(ACRAPDA,"CNG"))
+3 SET ACRRSN=$GET(^ACRAPVS(ACRAPDA,"RSN"))
+4 SET ACRAPV=$EXTRACT(^ACRAPVS(ACRAPDA,"DT"))
+5 SET ^ACROBL(ACRDOCDA,"CNG")=ACRCNG
+6 SET ^ACROBL(ACRDOCDA,"RSN")=ACRRSN
+7 SET XMB(1)="Document no. "_ACRDOC_" ("_$PIECE(^ACRDOC(ACRDOCDA,0),U,14)_") ,was "_$SELECT(ACRAPV="A":"APPROVED",1:"DISAPPROVD")_" by "
+8 ;S XMB(2)=$P(^VA(200,$P(^ACRAPVS(ACRAPDA,"DT"),U,2),0),U) ;ACR*2.1*19.02 IM16848
+9 ;ACR*2.1*19.02 IM16848
SET XMB(2)=$$NAME2^ACRFUTL1($PIECE(^ACRAPVS(ACRAPDA,"DT"),U,2))
+10 SET XMB(2)=$PIECE($PIECE(XMB(2),",",2)," ")_" "_$PIECE(XMB(2),",")
+11 SET XMB(3)=$PIECE(^ACRAPVT($PIECE(^ACRAPVS(ACRAPDA,0),U,3),0),U)
+12 SET XMB(3)=$PIECE($PIECE(XMB(3),",",2)," ")_" "_$PIECE(XMB(3),",")
+13 SET XMB(2)=XMB(2)_" as the "_XMB(3)
+14 SET XMB(3)=" "
+15 SET XMB(4)="Information which needs to be changed:"
+16 IF ACRCNG]""
Begin DoDot:1
+17 NEW ACRI
+18 FOR ACRI=1:1:5
IF $PIECE(ACRCNG,U,ACRI)]""
SET XMB(ACRI+4)=$PIECE(ACRCNG,U,ACRI)
End DoDot:1
+19 SET XMB(10)=" "
+20 SET XMB(11)="Reason for change: "
+21 IF ACRRSN]""
Begin DoDot:1
+22 NEW ACRI
+23 FOR ACRI=1:1:5
IF $PIECE(ACRRSN,U,ACRI)]""
SET XMB(ACRI+11)=$PIECE(ACRRSN,U,ACRI)
End DoDot:1
+24 SET XMDUZ=.5
+25 SET XMTEXT="XMB("
+26 SET XMSUB="REQUEST COMMENT/DISAPPROVAL NOTIFICATION"
+27 SET XMB="ACR REQUEST STATUS"
+28 DO ^XMD
+29 KILL ACRAPV,ACRCNG,ACRRSN,XMB,XMDUZ,XMSUB,XMY,XMTEXT
+30 QUIT
CHECK ;EP;
+1 NEW X,Y
+2 KILL ACRQUIT,ACROUT
+3 ;ACR*2.1*5.06
IF '$GET(ACRDOCDA)!'$DATA(ACRFDNAM)
QUIT
+4 IF '$GET(ACRLBDA)
SET ACRLBDA=$PIECE(^ACRDOC(ACRDOCDA,0),U,6)
+5 IF 'ACRLBDA
QUIT
+6 IF $PIECE(^ACRLOCB(ACRLBDA,0),U,21)=1
QUIT
SET X=$PIECE(^(0),U,21)
+7 IF '$PIECE($GET(^ACRSYS(1,"DT1")),U,3)
QUIT
SET Y=$PIECE(^("DT1"),U,3)
+8 IF Y=2
IF X'=2
QUIT
+9 IF $PIECE(^ACRLOCB(ACRLBDA,"BA"),U,2)<(ACRFDNAM+.01)
QUIT
+10 WRITE *7,*7
+11 DO WARNING
+12 WRITE !!?10,"THE ",@ACRON,$FNUMBER(ACRFDNAM,"P,",2),@ACROF," ALLOCATED TO THIS BUDGET HAS BEEN EXCEEDED."
+13 WRITE !?10,"REVIEW THIS ACCOUNT WITH THE FINANCIAL MANAGEMENT OFFICER"
+14 IF $DATA(ACRAPCHK)#2
DO PAUSE^ACRFWARN
SET ACROUT=""
QUIT
+15 SET DIR(0)="YO"
+16 SET DIR("A",1)="Edit/Delete "_$SELECT(ACRREF=130!(ACRREF=600):"Travel Days",ACRREF=148:"Training Expenses",1:"Items")
+17 SET DIR("A")="to DECREASE the cost"
+18 SET DIR("B")="NO"
+19 WRITE !
+20 DO DIR^ACRFDIC
+21 IF Y'=1
SET (ACRQUIT,ACROUT)=""
QUIT
+22 KILL ACRQUIT,ACROUT
+23 QUIT
CHECK1 ;EP;
+1 IF '$PIECE(^ACRSYS(1,"DT"),U,99)
QUIT
+2 WRITE !!?10,*7,"YOU HAVE EXCEEDED YOUR PROCUREMENT LIMIT (",ACRTXLIM,".00)"
+3 WRITE !?10,"THE LAST ITEM YOU ENTERED WILL BE DELETED. MAKE THE NECESSARY"
+4 WRITE !?10,"ADJUSTMETS TO KEEP THIS REQUEST WITHIN YOUR PROCUREMENT LIMIT."
+5 DO PAUSE
+6 SET DA=ACRSSDA
+7 SET DIK="^ACRSS("
+8 DO DIK^ACRFDIC
+9 QUIT
CHECKCC(ACRSSTOT) ;EP; ;ACR*2.1*5.17
+1 NEW X,Y
+2 KILL ACRQUIT,ACROUT
+3 WRITE *7,*7
+4 DO WARNING
+5 WRITE !!?10,"THE TOTAL OF ",@ACRON,$FNUMBER(ACRSSTOT,"P,",2),@ACROF
+6 ;W " EXCEEDS THE $2500.00 PER PURCHASE" ;ACR*2.1*22.11j IM23064
+7 ;ACR*2.1*22.11j IM23064
WRITE " EXCEEDS THE $3000.00 PER PURCHASE"
+8 WRITE !?10,"SPENDING LIMIT ALLOWED FOR A CREDIT CARD PURCHASE"
+9 ;I $D(ACRAPCHK)#2 D PAUSE^ACRFWARN S ACROUT="" Q
+10 SET DIR(0)="YO"
+11 SET DIR("A")="Edit/Delete Items to DECREASE the cost"
+12 SET DIR("B")="NO"
+13 WRITE !
+14 DO DIR^ACRFDIC
+15 QUIT
PAUSE ;EP;
+1 IF $EXTRACT(IOST,1,2)'="C-"
QUIT
+2 KILL DIR
P1 ;EP;
+1 WRITE !
+2 SET DIR(0)="EOA"
+3 SET DIR("A")="Press RETURN to continue or '^' to exit. "
+4 DO DIR^ACRFDIC
+5 IF $GET(X)["^"
SET DN=0
SET ACROUT=""
+6 QUIT
TOTAL ;EP;TO CALCULATE THE TOTAL DOLLARS OF A PO PLUS MODS
+1 ;ACRORIDA IS THE INTERNAL ENTRY NUMBER OF THE ORIGINAL DOCUMENT
+2 IF '$DATA(ACRORIDA)
QUIT
+3 KILL ACR
+4 SET ACRSSTOT=0
+5 SET ACR=ACRORIDA
+6 SET ACR(ACRORIDA)=0
+7 DO SSTOT
+8 SET ACR=0
+9 FOR
SET ACR=$ORDER(^ACRDOC("MOD",ACRORIDA,ACR))
IF 'ACR
QUIT
DO SSTOT
+10 QUIT
SSTOT ;EP - TOTAL OF ALL OBLIGATED AMOUNTS FOR ALL ITEMS ON THE PO PLUS MODS
+1 NEW ACRSSDA
+2 SET (ACRSSDA,ACRTOT,ACR(ACR))=0
+3 FOR
SET ACRSSDA=$ORDER(^ACRSS("J",ACR,ACRSSDA))
IF 'ACRSSDA
QUIT
Begin DoDot:1
+4 SET ACRTOT=$PIECE($GET(^ACRSS(ACRSSDA,"DT")),U,4)
+5 SET ACRSSTOT=$GET(ACRSSTOT)+ACRTOT
+6 SET ACR(ACR)=$GET(ACR(ACR))+ACRTOT
End DoDot:1
+7 QUIT
EXTOT ;EP;WARNING MESSAGE IF TOTAL OBLIGATED EXCEEDS PROCUREMENT AUTHORITY
+1 IF '$DATA(ACRSSTOT)
QUIT
+2 NEW ACRLIM
+3 IF ACRSSTOT>$PIECE(^ACRSYS(1,"DT"),U,24)
SET ACRLIM=$PIECE(^("DT"),U,24)
Begin DoDot:1
+4 WRITE *7,*7
+5 WRITE !!,"The TOTAL DOLLAR VALUE of this action: ",@ACRON,$JUSTIFY($FNUMBER(ACRSSTOT,"P",2),12),@ACROF
+6 WRITE !,"Exceeds the Area Procurement limit of: ",@ACRON,$JUSTIFY($FNUMBER(ACRLIM,"P",2),12),@ACROF
+7 WRITE !!,"Ths summary of dollar amounts for the original action plus mods is listed below."
+8 WRITE !,"Consult with your Purchasing Office reqarding this action before proceeding."
End DoDot:1
+9 WRITE !!?10,"PURCHASE ORDER"
+10 WRITE ?30,"REQUISITION NUMBER"
+11 WRITE ?50,"DOLLAR AMOUNT"
+12 WRITE !?10,"--------------"
+13 WRITE ?30,"------------------"
+14 WRITE ?50,"-------------"
+15 SET ACR=0
+16 FOR
SET ACR=$ORDER(ACR(ACR))
IF 'ACR
QUIT
Begin DoDot:1
+17 SET ACR0=^ACRDOC(ACR,0)
SET ACRTOT=ACR(ACR)
+18 WRITE !?10,$PIECE(ACR0,U,2)
+19 WRITE ?30,$PIECE(ACR0,U)
+20 WRITE ?50,$JUSTIFY($FNUMBER(ACRTOT,"P",2),12)
End DoDot:1
+21 QUIT
EXCEED ;EP;TO CALCULATE AND DISPLAY DATA FOR PO AND MODS WHICH EXCEED
+1 ;THE AREA PROCUREMENT LIMIT
+2 IF "^116^204^103^"'[(U_$GET(ACRREF)_U)
QUIT
+3 IF $PIECE($GET(^ACRDOC(ACRDOCDA,3)),U,13)
QUIT
+4 SET ACRORIDA=$SELECT($PIECE(^ACRDOC(ACRDOCDA,0),U,15):$PIECE(^(0),U,15),1:ACRDOCDA)
+5 DO TOTAL
+6 IF $PIECE(^ACRSYS(1,"DT"),U,24)+1>ACRSSTOT
QUIT
+7 DO EXTOT
+8 DO PAUSE
+9 QUIT
WARNING ;EP;TO DISPLAY WARNING MESSAGE
+1 DO B1^ACRFMENU
+2 NEW ACRI
+3 WRITE !!
+4 FOR ACRI=1:1:6
WRITE ?$X+5,"WARNING"
+5 DO B2^ACRFMENU
+6 QUIT
