source: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFOOR2.m@ 1416

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