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

PRCSREC2.m

Go to the documentation of this file.
  1. PRCSREC2 ;WISC/KMB/DL-UPDATE 420 BALANCES FOR ISSUE BOOK,CONVERSION ;1/28/98 1400
  1. ;;5.1;IFCAP;**55,155,213**;4/21/95;Build 19
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;PRC*5.1*213 Modify FCP Cost Center verification to
  1. ; use ^TMP workfile to handle FCP's with
  1. ; large number of attached cost centers
  1. ;
  1. ISSUES(STATION,FY,CP,QUARTER,AMOUNT) ;
  1. N A
  1. S A=+STATION_"^"_(+CP)_"^"_FY_"^"_QUARTER_"^"_AMOUNT
  1. D EBAL^PRCSEZ(A,"O")
  1. QUIT
  1. COST(STATION,CP) ;
  1. ;return FCP cost centers ;PRC*5.1*213
  1. K ^TMP($J,"PRCCC")
  1. N CC
  1. I '$D(^PRC(420,STATION,1,+CP,2)) Q
  1. S CC=0 F S CC=$O(^PRC(420,STATION,1,+CP,2,CC)) Q:'CC I $D(^PRCD(420.1,CC,0)),'$P(^PRCD(420.1,CC,0),U,2) S ^TMP($J,"PRCCC",CC)=""
  1. QUIT
  1. ;
  1. CONV(STRING,AMOUNT,COMMENT) ;
  1. ;after V5 installation, reconcile CP with adjustment trans.
  1. N A,CPNAME,IT,PRC,T,X,X1,Z
  1. Q:'$D(STRING)
  1. S PRC("SITE")=$P(STRING,"-"),PRC("FY")=$P(STRING,"-",2),PRC("QTR")=$P(STRING,"-",3),PRC("CP")=$P(STRING,"-",4)
  1. S T(2)="A" D:'$D(DT) DT^DICRW
  1. S PRC("BBFY")=+$$YEAR^PRC0C(PRC("FY"))
  1. S X=PRC("SITE")_"-"_PRC("FY")_"-"_PRC("CP"),Z=STRING
  1. D EN1^PRCSUT3 Q:'$D(X)
  1. S X1=X D EN2^PRCSUT3 Q:'$D(X1)
  1. L +^PRCS(410,DA):15 Q:'$T
  1. S $P(^PRCS(410,DA,5),"^")=AMOUNT,$P(^(5),"^",2)=DT,$P(^(4),"^",2)=DT
  1. F IT=1,4 S $P(^PRCS(410,DA,IT),"^",4)=DT,$P(^(1),"^",IT)=DT
  1. F IT=1,3,8 S $P(^PRCS(410,DA,4),"^",IT)=AMOUNT
  1. S CPNAME=$P(^PRC(420,PRC("SITE"),1,+PRC("CP"),0),"^"),CPNAME=$E(CPNAME,1,30)
  1. S $P(^PRCS(410,DA,3),"^")=CPNAME
  1. S $P(^PRCS(410,DA,0),"^",2)="A",$P(^PRCS(410,DA,0),"^",4)=2,$P(^PRCS(410,DA,1),"^",3)="ST"
  1. S DA(1)=DA,DIC("P")=$P(^DD(410,60,0),"^",2),DIC="^PRCS(410,DA(1),""CO"","
  1. S DLAYGO=410,DIC(0)="LX",X=COMMENT D ^DIC
  1. L -^PRCS(410,DA)
  1. ;update 420 balance here
  1. S A=PRC("SITE")_"^"_+PRC("CP")_"^"_PRC("FY")_"^"_PRC("QTR")_"^"_AMOUNT
  1. D EBAL^PRCSEZ(A,"O"),EBAL^PRCSEZ(A,"C")
  1. K DIC,DLAYGO,DA QUIT
  1. CREATE(STRING) ;create CP for user, return -1 if none created
  1. Q:'$D(STRING)
  1. N STATION,FUND,AO,OCP,OBJC,BFY,JOB,PROG,A,B,X,Y
  1. S X=$P(STRING,"-",2) K %DT D ^%DT
  1. S STATION=$P(STRING,"-"),BFY=$E(Y,1,3)+1700,FUND=$P(STRING,"-",3),AO=$P(STRING,"-",4),OCP=$P(STRING,"-",5),PROG=$E(OCP,1,4)
  1. S (OBJC,JOB)=""
  1. S:FUND="0151A7" PROG=9999 S:FUND="0151A1" PROG=9999 S:FUND="0151A7" OBJC=21 S:FUND="0151A1" OBJC=26
  1. S:OCP=971 PROG="MOD"
  1. S A=STATION_"~"_BFY_"~"_FUND_"~"_AO_"~"_PROG_"~"_OCP_"~"_OBJC_"~"_JOB
  1. S B=$$FIRST^PRC0B1("^PRCD(420.141,""B"","""_A_""",",0)
  1. I 'B S B=-1 QUIT B
  1. S B=+$P(^PRCD(420.141,B,0),"^",2),B=$P($G(^PRC(420,STATION,1,B,0)),"^")
  1. QUIT B