Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACRFWARN

ACRFWARN.m

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