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

Last change on this file since 1569 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.6 KB
Line 
1PRCFOOR2 ;WISC@ALTOONA/CTB-UPDATE FCP BALANCES ;9/29/94 8:41 AM
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;PROGRAM TO UPDATE BALANCES FROM AUSTIN
5 ;READ MESSAGE INTO FILE 420.97
6 ;PROCESS EXISTING CONTROL POINTS USING 420.99 AS SOURCE
7 ;BUILDING LIST OF EXCEPTIONS ON THE FLY ^TMP("NOT IN AUSTIN",SITE,CP)
8 ;BUILD LIST OF CP FROM AUSTIN NOT FOUND IN 420.99 ^TMP("NOT IN IFCAP,SITE,CP)
9 ;PRINT EXCEPTION LISTS
10 ;
11 ;READ MESSAGE HEADER
12 Q:'$D(PRCDA)
13 S OUT=0,(FCP,SITE)=""
14 D NOW^%DTC S RDATE=%,XDA=PRCDA
15 S NODE=$G(^PRCF(423.6,XDA,1,10000,0)) I NODE="" D ERRMSG(4) QUIT
16 ; 1,2 is this the right type of transaction
17 S CHECK=$P(NODE,"^",3) I CHECK'["IFC" D ERRMSG(1) QUIT
18 S CHECK=$P(NODE,"^",5) I CHECK'["CCP" D ERRMSG(2) QUIT
19 ; 3 is site correct
20 S SITE=$P(NODE,"^",4) I SITE="" D ERRMSG(3) QUIT
21 I '$D(^PRC(420,SITE)) D ERRMSG(3) QUIT
22 ;MOVE MESSAGE INTO 420.97
23 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)
24 ;VALIDATE DATA, PROCESS UPDATE ADJUSTMENTS
25 S DA=0 F S DA=$O(^PRCU(420.97,DA)) Q:'DA D UPDATE(DA)
26 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))
27 D FCPBULL^PRCFOOR4(PRCDA)
28 QUIT
29REPORT ;GENERATE REPORTS OF CCP MESSAGES
30 S DIC="^PRCU(420.99,",L=0,(BY,FLDS)="[PRCF FMS ADJUSTMENTS]" D EN1^DIP
31 S DIC="^PRCU(420.98,",L=0,(BY,FLDS)="[PRCF FMS ADJUSTMENTS]" D EN1^DIP
32 QUIT
33ERRMSG(X) S X=$P($T(MSG+X),";",3,99) D MSG^PRCFQ W ! QUIT
34MSG ;
35 ;;Invalid Message Destination
36 ;;Invalid Message Type/Segment
37 ;;Station Number is Missing from Message
38 ;;Message Contains No Data Lines
39 ;;Unable to extract Fund Control Point from Data line
40FILE(XDA,LINE) ; check each transmission line sent and file in 420.97
41 NEW BBFY,FUND,AO,ACC,NODE,BALANCE,OUT,FCP,VIFCAPCP,VSNAPCP,SNAPDA,SNAPSHOT,VARIANCE
42 S NODE=$G(^PRCF(423.6,XDA,1,LINE,0))
43 I $E(NODE)="{" S DONE="" QUIT
44 S BALANCE=$P(NODE,"^",12)
45 ; 4 was data sent in the transmission
46 I '$D(^PRCF(423.6,XDA,1,LINE,0)) D ERRMSG(4) Q
47 S SITE=$P(NODE,"^",6),FCP=$P(NODE,"^",11)
48 IF SITE=""!(FCP="") QUIT ;
49 S BBFY=$P(NODE,"^",2),FUND=$P(NODE,"^",4),AO=$P(NODE,"^",5),ACC=$P(NODE,"^",8)
50 S STRIP=SITE_","_BBFY_","_FUND_","_AO_","_ACC
51 D ADD(SITE,FCP,BALANCE,STRIP)
52 QUIT
53ADD(SITE,FCP,BAL,STRIP) ;
54 NEW DIC,DIE,X,Y,DA,DR,DLAYGO
55 S (DIC,DLAYGO)=420.97,DIC(0)="LNX",X=SITE_"-"_+FCP D ^DIC
56 S DA=+Y,DIE=DIC
57 S DR="1///"_SITE_";2///"_STRIP_";3////"_BAL S:FCP]"" DR=DR_";2.5///"_FCP
58 D ^DIE
59 QUIT
60UPDATE(DA) ;
61 NEW RECORD,SITE,FCP,BAL
62 S RECORD=^PRCU(420.97,DA,0)
63 S SITE=$P(RECORD,"^",2),FCP=$P(RECORD,"^",5),BAL=$P(RECORD,"^",4)
64 S VIFCAPCP=$$VALIDCP(SITE,FCP)
65 S VSNAPCP=0 I $D(^PRCU(420.99,"AB",SITE_"-"_+FCP)) S VSNAPCP=1
66 S SNAPDA=$O(^PRCU(420.99,"AB",SITE_"-"_+FCP,0))
67 I 'VIFCAPCP D ADDERR(1,SITE,FCP) QUIT ;FMS CP NOT IN IFCAP
68 I 'VSNAPCP D ADDERR(2,SITE,FCP) QUIT ;FMS CP NOT IN SNAPSHOT FILE
69 S SNAPSHOT=$P(^PRCU(420.99,SNAPDA,0),"^",3),ID=$P(^(0),"^"),DONE=$P(^(0),"^",10)
70 I DONE D ADDERR(4,SITE,FCP) QUIT ;ALREADY ADJUSTED
71 S VARIANCE=SNAPSHOT-BAL
72 D CONV^PRCSREC2(ID,VARIANCE,"FMS FCP CONVERSION ADJUSTMENT")
73 S $P(^PRCU(420.99,SNAPDA,0),"^",8,10)=BAL_"^"_VARIANCE_"^1"
74 QUIT
75ADDERR(A,B,C) NEW DIC,DIE,X,Y,DA,DR,DLAYGO
76 S (DIC,DLAYGO)=420.98,DIC(0)="LN",X="+" D ^DIC
77 S DIE=DIC,DR="1////"_B_";2////"_A_";3////"_C,DA=+Y D ^DIE
78 QUIT
79VALIDCP(SITE,CP) ;VALIDATE FUND CONTROL POINT NUMBER
80 I $D(^PRC(420,+SITE,1,+CP,0)) Q 1
81 Q 0
82NEXT ;
83 I $E(X)'="+" Q
84 N A
85 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)")
86 I X=+X S DINUM=X QUIT
87 S X="" QUIT
Note: See TracBrowser for help on using the repository browser.