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

PRCSAPP1.m

Go to the documentation of this file.
  1. PRCSAPP1 ;WISC/KMB-CHECK 2237 BEFORE APPROVAL ;12/17/93
  1. ;;5.1;IFCAP;**148,174**;Oct 20, 2000;Build 23
  1. ;Per VHA Directive 2004-038, this routine should not be modified.
  1. CHEC ;
  1. I +$P(^PRCS(410,DA,0),"-")'=PRC("SITE") S SPENDCP=1 G EVAL
  1. I +$P(^PRCS(410,DA,0),"-",4)'=PRC("CP") S SPENDCP=2 G EVAL
  1. S D0=DA,DIC="^PRCS(410," L +^PRCS(410,DA):5 W @IOF D ^PRCST5 H 1
  1. L -^PRCS(410,DA)
  1. I $D(^PRCS(410,DA,7)),$P(^(7),U,6)'="" S SPENDCP=3 D EVAL Q
  1. S:'$D(^PRCS(410,DA,11)) ^(11)="" I '$P(^(11),U,3) S SPENDCP=4 D EVAL Q
  1. ; PRC*5.1*148
  1. I $P(^PRCS(410,DA,0),"^",11)="" D ERS410^PRC0G(DA)
  1. S PRCSN=^PRCS(410,DA,0),PRCHQ=$P(PRCSN,"^",4),PRC("FY")=$P(PRCSN,"-",2),PRC("QTR")=$P(PRCSN,"-",3)
  1. T1 ; this is the 'jump' entry point for the CP official
  1. ; to approve a request just after s/he creates it
  1. I '$D(ALL) N JUMP,ALL S JUMP=1,ALL=0
  1. N ESTSHP,CST S ESTSHP=$P($G(^PRCS(410,DA,9)),"^",4),CST=$P($G(^PRCS(410,DA,4)),"^",8)
  1. S PRC("RBDT")=$P(^PRCS(410,DA,0),"^",11),PRCST1=$$DATE^PRC0C(PRC("RBDT"),"I")
  1. S PRCST1=$S($D(^PRC(420,PRC("SITE"),1,+PRC("CP"),4,$E($P(PRCST1,"^"),3,4),0)):$P(^(0),U,$P(PRCST1,"^",2)+1),1:0),PRCST=$S($D(^PRCS(410,DA,4)):$P(^(4),U,8),1:0)
  1. S PRCST=ESTSHP+CST I PRCST<0,$P(^PRCS(410,DA,0),"^",4)'=1 S SPENDCP=9 D EVAL Q
  1. ;Check for different costs
  1. N PRCCOMCT,PRCBOCCT
  1. S PRCCOMCT=$S($D(^PRCS(410,DA,4)):$P(^(4),"^"),1:0)
  1. S PRCBOCCT=$S($D(^PRCS(410,DA,3)):$P(^(3),"^",7),1:0)
  1. I $P(^PRCS(410,DA,0),"^",2)="O",$P(^(0),"^",4)=1,$J(PRCCOMCT,0,2)'=$J(PRCBOCCT,0,2) S SPENDCP=10 D EVAL Q
  1. ;
  1. W !,"Current Control Point balance: $",$J(PRCST1,0,2),!,"Estimated cost of this request: $",$J(PRCST,0,2) H 1
  1. T2 ;
  1. ;N ALLTOT,MINUS S ALLTOT=0 F Z=2:1:PRC("QTR")+1 S ALLTOT=ALLTOT+$P($G(^PRC(420,PRC("SITE"),1,+PRC("CP"),4,PRC("FY"),0)),"^",Z)
  1. ;S MINUS="" I ALLTOT<0 S ALLTOT=-ALLTOT,MINUS="-"
  1. ;W !,"Total uncommitted balance from current and prior quarters: ",MINUS,"$",$J(ALLTOT,0,2),!
  1. Q:$D(REPORT2)
  1. ;S STRING=PRC("SITE")_"^"_PRC("CP")_"^"_PRC("FY")_"^"_PRC("QTR")
  1. ;S TEST=$$YEAR^PRC0C(PRC("FY"))'<$$DATE^PRC0C("N","E")
  1. ;I TEST S TEST=$$OVCOM^PRCS0A(STRING,PRCST,2) I TEST'=0 S SPENDCP=5 D EVAL Q
  1. I $$OVCOM^PRCS0A(PRC("SITE")_"^"_PRC("CP")_"^"_$P($$DATE^PRC0C(PRC("RBDT"),"I"),"^",1,2),PRCST,2)'=0 S SPENDCP=5 D EVAL Q
  1. I $P(PRCSN,"^",4)="" S SPENDCP=6 D EVAL Q
  1. I $P(PRCSN,"^",4)>1,'$D(^PRCS(410,DA,"IT",0)) S SPENDCP=7 D EVAL Q
  1. I +$P(^PRCS(410,DA,3),"^",3)=0 S SPENDCP=8 D EVAL Q
  1. I '$$CHECK^PRCEN(DA) S SPENDCP=11 D EVAL Q
  1. ;*****PRC*5.1*174 start*****
  1. N PRCHJFT,PRCFAIL
  1. S PRCHJFT=$P(^PRCS(410,DA,0),"^",4) ;Form Type
  1. ;if 2237 transaction (Form Type IEN 2,3, or 4) DO block
  1. I $G(PRCHJFT)>1&($G(PRCHJFT)<5) D
  1. . ;if 2237 required fields are missing DO block
  1. . N PRCWARN
  1. . I '$$REQCHECK^PRCHJUTL(DA,.PRCWARN) D
  1. . . S PRCFAIL=1
  1. . . N PRCIDX S PRCIDX=0
  1. . . W !!,"WARNING - Transaction "_$$GET1^DIQ(410,DA,.01)_" is missing required data!",*7
  1. . . F S PRCIDX=$O(PRCWARN(PRCIDX)) Q:'PRCIDX D
  1. . . . W !?2,">>> "_$G(PRCWARN(PRCIDX))
  1. ;if 2237 missing data, output msg to user and quit (don't allow approval)
  1. I $G(PRCFAIL) S SPENDCP=12 D EVAL Q
  1. ;*****PRC*5.1*174 end*****
  1. S OK=1 QUIT
  1. EVAL ;
  1. I SPENDCP'=0 W !,$P($T(MESSAGE+SPENDCP),";;",2) H 2 Q:$D(JUMP) R !!,"Press return to continue: ",X:DTIME I X["^" D
  1. .I ALL=0 S STOP1=-1 Q
  1. .S %=1 W !,"Continue looping through your control points" D YN^DICN I %=2 S STOP1=-1 Q
  1. .I %=0 W !,"Enter yes or no. Continue" S %=1 D YN^DICN S:%<2 STOP1=-1
  1. Q
  1. MESSAGE ;
  1. ;;This transaction was not entered for your site
  1. ;;This transaction was not entered for your control point
  1. ;;This transaction has already been approved!
  1. ;;This transaction is not ready for approval
  1. ;;You do not have the funds to approve this request
  1. ;;This request does not have a form type
  1. ;;Requests without items cannot be approved
  1. ;;This transaction does not have a cost center
  1. ;;This request has a negative dollar amount
  1. ;;Committed Cost does not equal BOC $ Amount - Please re-edit.
  1. ;;Missing required data, request needs to be edited.
  1. ;;Missing required data, 2237 request needs to be edited prior to approval.