| 1 | PRCSREC2 ;WISC/KMB/DL-UPDATE 420 BALANCES FOR ISSUE BOOK,CONVERSION ;1/28/98 1400
|
|---|
| 2 | ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ISSUES(STATION,FY,CP,QUARTER,AMOUNT) ;
|
|---|
| 5 | N A
|
|---|
| 6 | S A=+STATION_"^"_(+CP)_"^"_FY_"^"_QUARTER_"^"_AMOUNT
|
|---|
| 7 | D EBAL^PRCSEZ(A,"O")
|
|---|
| 8 | QUIT
|
|---|
| 9 | COST(STATION,CP) ;
|
|---|
| 10 | ;return CP cost centers
|
|---|
| 11 | N STRING,Y,CC S STRING="",Y=0
|
|---|
| 12 | I '$D(^PRC(420,STATION,1,+CP,2)) Q STRING
|
|---|
| 13 | S CC=0 F S CC=$O(^PRC(420,STATION,1,+CP,2,CC)) Q:+CC=0 Q:Y>70 S Y=Y+1,$P(STRING,"^",Y)=CC
|
|---|
| 14 | ;
|
|---|
| 15 | QUIT STRING
|
|---|
| 16 | ;
|
|---|
| 17 | CONV(STRING,AMOUNT,COMMENT) ;
|
|---|
| 18 | ;after V5 installation, reconcile CP with adjustment trans.
|
|---|
| 19 | N A,CPNAME,IT,PRC,T,X,X1,Z
|
|---|
| 20 | Q:'$D(STRING)
|
|---|
| 21 | S PRC("SITE")=$P(STRING,"-"),PRC("FY")=$P(STRING,"-",2),PRC("QTR")=$P(STRING,"-",3),PRC("CP")=$P(STRING,"-",4)
|
|---|
| 22 | S T(2)="A" D:'$D(DT) DT^DICRW
|
|---|
| 23 | S PRC("BBFY")=+$$YEAR^PRC0C(PRC("FY"))
|
|---|
| 24 | S X=PRC("SITE")_"-"_PRC("FY")_"-"_PRC("CP"),Z=STRING
|
|---|
| 25 | D EN1^PRCSUT3 Q:'$D(X)
|
|---|
| 26 | S X1=X D EN2^PRCSUT3 Q:'$D(X1)
|
|---|
| 27 | L +^PRCS(410,DA):15 Q:'$T
|
|---|
| 28 | S $P(^PRCS(410,DA,5),"^")=AMOUNT,$P(^(5),"^",2)=DT,$P(^(4),"^",2)=DT
|
|---|
| 29 | F IT=1,4 S $P(^PRCS(410,DA,IT),"^",4)=DT,$P(^(1),"^",IT)=DT
|
|---|
| 30 | F IT=1,3,8 S $P(^PRCS(410,DA,4),"^",IT)=AMOUNT
|
|---|
| 31 | S CPNAME=$P(^PRC(420,PRC("SITE"),1,+PRC("CP"),0),"^"),CPNAME=$E(CPNAME,1,30)
|
|---|
| 32 | S $P(^PRCS(410,DA,3),"^")=CPNAME
|
|---|
| 33 | S $P(^PRCS(410,DA,0),"^",2)="A",$P(^PRCS(410,DA,0),"^",4)=2,$P(^PRCS(410,DA,1),"^",3)="ST"
|
|---|
| 34 | S DA(1)=DA,DIC("P")=$P(^DD(410,60,0),"^",2),DIC="^PRCS(410,DA(1),""CO"","
|
|---|
| 35 | S DLAYGO=410,DIC(0)="LX",X=COMMENT D ^DIC
|
|---|
| 36 | L -^PRCS(410,DA)
|
|---|
| 37 | ;update 420 balance here
|
|---|
| 38 | S A=PRC("SITE")_"^"_+PRC("CP")_"^"_PRC("FY")_"^"_PRC("QTR")_"^"_AMOUNT
|
|---|
| 39 | D EBAL^PRCSEZ(A,"O"),EBAL^PRCSEZ(A,"C")
|
|---|
| 40 | K DIC,DLAYGO,DA QUIT
|
|---|
| 41 | CREATE(STRING) ;create CP for user, return -1 if none created
|
|---|
| 42 | Q:'$D(STRING)
|
|---|
| 43 | N STATION,FUND,AO,OCP,OBJC,BFY,JOB,PROG,A,B,X,Y
|
|---|
| 44 | S X=$P(STRING,"-",2) K %DT D ^%DT
|
|---|
| 45 | 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)
|
|---|
| 46 | S (OBJC,JOB)=""
|
|---|
| 47 | S:FUND="0151A7" PROG=9999 S:FUND="0151A1" PROG=9999 S:FUND="0151A7" OBJC=21 S:FUND="0151A1" OBJC=26
|
|---|
| 48 | S:OCP=971 PROG="MOD"
|
|---|
| 49 | S A=STATION_"~"_BFY_"~"_FUND_"~"_AO_"~"_PROG_"~"_OCP_"~"_OBJC_"~"_JOB
|
|---|
| 50 | S B=$$FIRST^PRC0B1("^PRCD(420.141,""B"","""_A_""",",0)
|
|---|
| 51 | I 'B S B=-1 QUIT B
|
|---|
| 52 | S B=+$P(^PRCD(420.141,B,0),"^",2),B=$P($G(^PRC(420,STATION,1,B,0)),"^")
|
|---|
| 53 | QUIT B
|
|---|
