88 lines
3.6 KiB
Mathematica
88 lines
3.6 KiB
Mathematica
PRCFOOR2 ;WISC@ALTOONA/CTB-UPDATE FCP BALANCES ;9/29/94 8:41 AM
|
|
V ;;5.1;IFCAP;;Oct 20, 2000
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
;PROGRAM TO UPDATE BALANCES FROM AUSTIN
|
|
;READ MESSAGE INTO FILE 420.97
|
|
;PROCESS EXISTING CONTROL POINTS USING 420.99 AS SOURCE
|
|
;BUILDING LIST OF EXCEPTIONS ON THE FLY ^TMP("NOT IN AUSTIN",SITE,CP)
|
|
;BUILD LIST OF CP FROM AUSTIN NOT FOUND IN 420.99 ^TMP("NOT IN IFCAP,SITE,CP)
|
|
;PRINT EXCEPTION LISTS
|
|
;
|
|
;READ MESSAGE HEADER
|
|
Q:'$D(PRCDA)
|
|
S OUT=0,(FCP,SITE)=""
|
|
D NOW^%DTC S RDATE=%,XDA=PRCDA
|
|
S NODE=$G(^PRCF(423.6,XDA,1,10000,0)) I NODE="" D ERRMSG(4) QUIT
|
|
; 1,2 is this the right type of transaction
|
|
S CHECK=$P(NODE,"^",3) I CHECK'["IFC" D ERRMSG(1) QUIT
|
|
S CHECK=$P(NODE,"^",5) I CHECK'["CCP" D ERRMSG(2) QUIT
|
|
; 3 is site correct
|
|
S SITE=$P(NODE,"^",4) I SITE="" D ERRMSG(3) QUIT
|
|
I '$D(^PRC(420,SITE)) D ERRMSG(3) QUIT
|
|
;MOVE MESSAGE INTO 420.97
|
|
S LINE=10000 F S LINE=$O(^PRCF(423.6,XDA,1,LINE)) Q:'LINE I $D(^(LINE,0)),$E(^(0))'="{" D FILE(XDA,LINE)
|
|
;VALIDATE DATA, PROCESS UPDATE ADJUSTMENTS
|
|
S DA=0 F S DA=$O(^PRCU(420.97,DA)) Q:'DA D UPDATE(DA)
|
|
S NEXT="" F S NEXT=$O(^PRCU(420.99,"AB",NEXT)) Q:NEXT="" I '$D(^PRCU(420.97,"B",NEXT)) D ADDERR(3,$P(NEXT,"-"),$P(NEXT,"-",2))
|
|
D FCPBULL^PRCFOOR4(PRCDA)
|
|
QUIT
|
|
REPORT ;GENERATE REPORTS OF CCP MESSAGES
|
|
S DIC="^PRCU(420.99,",L=0,(BY,FLDS)="[PRCF FMS ADJUSTMENTS]" D EN1^DIP
|
|
S DIC="^PRCU(420.98,",L=0,(BY,FLDS)="[PRCF FMS ADJUSTMENTS]" D EN1^DIP
|
|
QUIT
|
|
ERRMSG(X) S X=$P($T(MSG+X),";",3,99) D MSG^PRCFQ W ! QUIT
|
|
MSG ;
|
|
;;Invalid Message Destination
|
|
;;Invalid Message Type/Segment
|
|
;;Station Number is Missing from Message
|
|
;;Message Contains No Data Lines
|
|
;;Unable to extract Fund Control Point from Data line
|
|
FILE(XDA,LINE) ; check each transmission line sent and file in 420.97
|
|
NEW BBFY,FUND,AO,ACC,NODE,BALANCE,OUT,FCP,VIFCAPCP,VSNAPCP,SNAPDA,SNAPSHOT,VARIANCE
|
|
S NODE=$G(^PRCF(423.6,XDA,1,LINE,0))
|
|
I $E(NODE)="{" S DONE="" QUIT
|
|
S BALANCE=$P(NODE,"^",12)
|
|
; 4 was data sent in the transmission
|
|
I '$D(^PRCF(423.6,XDA,1,LINE,0)) D ERRMSG(4) Q
|
|
S SITE=$P(NODE,"^",6),FCP=$P(NODE,"^",11)
|
|
IF SITE=""!(FCP="") QUIT ;
|
|
S BBFY=$P(NODE,"^",2),FUND=$P(NODE,"^",4),AO=$P(NODE,"^",5),ACC=$P(NODE,"^",8)
|
|
S STRIP=SITE_","_BBFY_","_FUND_","_AO_","_ACC
|
|
D ADD(SITE,FCP,BALANCE,STRIP)
|
|
QUIT
|
|
ADD(SITE,FCP,BAL,STRIP) ;
|
|
NEW DIC,DIE,X,Y,DA,DR,DLAYGO
|
|
S (DIC,DLAYGO)=420.97,DIC(0)="LNX",X=SITE_"-"_+FCP D ^DIC
|
|
S DA=+Y,DIE=DIC
|
|
S DR="1///"_SITE_";2///"_STRIP_";3////"_BAL S:FCP]"" DR=DR_";2.5///"_FCP
|
|
D ^DIE
|
|
QUIT
|
|
UPDATE(DA) ;
|
|
NEW RECORD,SITE,FCP,BAL
|
|
S RECORD=^PRCU(420.97,DA,0)
|
|
S SITE=$P(RECORD,"^",2),FCP=$P(RECORD,"^",5),BAL=$P(RECORD,"^",4)
|
|
S VIFCAPCP=$$VALIDCP(SITE,FCP)
|
|
S VSNAPCP=0 I $D(^PRCU(420.99,"AB",SITE_"-"_+FCP)) S VSNAPCP=1
|
|
S SNAPDA=$O(^PRCU(420.99,"AB",SITE_"-"_+FCP,0))
|
|
I 'VIFCAPCP D ADDERR(1,SITE,FCP) QUIT ;FMS CP NOT IN IFCAP
|
|
I 'VSNAPCP D ADDERR(2,SITE,FCP) QUIT ;FMS CP NOT IN SNAPSHOT FILE
|
|
S SNAPSHOT=$P(^PRCU(420.99,SNAPDA,0),"^",3),ID=$P(^(0),"^"),DONE=$P(^(0),"^",10)
|
|
I DONE D ADDERR(4,SITE,FCP) QUIT ;ALREADY ADJUSTED
|
|
S VARIANCE=SNAPSHOT-BAL
|
|
D CONV^PRCSREC2(ID,VARIANCE,"FMS FCP CONVERSION ADJUSTMENT")
|
|
S $P(^PRCU(420.99,SNAPDA,0),"^",8,10)=BAL_"^"_VARIANCE_"^1"
|
|
QUIT
|
|
ADDERR(A,B,C) NEW DIC,DIE,X,Y,DA,DR,DLAYGO
|
|
S (DIC,DLAYGO)=420.98,DIC(0)="LN",X="+" D ^DIC
|
|
S DIE=DIC,DR="1////"_B_";2////"_A_";3////"_C,DA=+Y D ^DIE
|
|
QUIT
|
|
VALIDCP(SITE,CP) ;VALIDATE FUND CONTROL POINT NUMBER
|
|
I $D(^PRC(420,+SITE,1,+CP,0)) Q 1
|
|
Q 0
|
|
NEXT ;
|
|
I $E(X)'="+" Q
|
|
N A
|
|
S A="S X=$P("_DIC_"0),U,3)" X A S A="S X=X+1 L +"_DIC_"0)" F X A Q:'$D(@(DIC_X_")")) L @("-"_DIC_"0)")
|
|
I X=+X S DINUM=X QUIT
|
|
S X="" QUIT
|