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

PRCFOOR2.m

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