source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFOOR3.m@ 1006

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

initial load of WorldVistAEHR

File size: 4.2 KB
Line 
1PRCFOOR3 ;WISC@ALTOONA/CTB-OUTSTANDING OBLIGATION RECONCILIATION ;12/15/94 3:59 PM
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;READ MESSAGE INTO FILE 420.97
5 ;PROCESS EXISTING CONTROL POINTS USING 420.99 AS SOURCE
6 ;BUILDING LIST OF EXCEPTIONS ON THE FLY ^TMP("NOT IN AUSTIN",SITE,CP)
7 ;BUILD LIST OF CP FROM AUSTIN NOT FOUND IN 420.99 ^TMP("NOT IN IFCAP,SITE,CP)
8 ;PRINT EXCEPTION LISTS
9 ;
10 ;READ MESSAGE
11X Q:'$D(PRCDA)
12 S OUT=0,(FCP,SITE)=""
13 D NOW^%DTC S RDATE=%,XDA=PRCDA
14 S NODE=$G(^PRCF(423.6,XDA,1,10000,0)) I NODE="" D ERRMSG(4) QUIT
15 ; 1,2 is this the right type of transaction
16 S CHECK=$P(NODE,"^",3) I CHECK'["IFC" D ERRMSG(1) QUIT
17 S CHECK=$P(NODE,"^",5) I CHECK'["OOR" D ERRMSG(2) QUIT
18 ; 3 is site correct
19 S SITE=$P(NODE,"^",4) I SITE="" D ERRMSG(3) QUIT
20CLEAN ;CLEAN ALL RECORDS FROM 420.96 FOR STATION
21 D CLEAN^PRCFOOR4(SITE)
22 ;MOVE MESSAGE INTO 420.96
23 S LINE=10000 F S LINE=$O(^PRCF(423.6,XDA,1,LINE)) Q:'LINE D FILE(XDA,.LINE)
24 ;GET OUT OF RANGE FY
25 D FY
26IFCAP ;LOOP THROUGH PO FILE FOR OPEN IFCAP RECORDS
27 FOR FSO=25,26,30,31,35,36,42,43,100 S PODA=0 F S PODA=$O(^PRC(442,"AI",FSO,PODA)) Q:'PODA I $$CHECK(PODA,FSO) D ADD1(PODA)
28 ;SEND BULLETIN TO MAIL GROUP
29 D BULL^PRCFOOR4(PRCDA)
30 ;REMOVE MESSAGE
31 ;D REMOVE^PRCFOOR4(PRCDA)
32 QUIT
33ADD1(PODA) ;ADD RECORD TO 420.96 WITH STATUS OF 1
34 N DLAYGO,IFBAL
35 S IFBAL=$$GETBAL(PODA)
36 Q:+IFBAL=0
37 S (DIC,DLAYGO)=420.96,DIC(0)="MNL",X=$P($G(^PRC(442,PODA,0)),"^") Q:X=""
38 D ^DIC Q:Y<0
39 S DIE=DIC,DA=+Y,DR="3////"_PODA_";4////"_IFBAL_";5////1"
40 D ^DIE
41 QUIT
42CHECK(PODA,FSO) ;QUIT WHEN CLOSED, NOT YET COMPLETE, OR NO MATCH ON SITE
43 ;FSO=FISCAL STATUS ORDER
44 NEW XFSO,OPEN,MOP,ID
45 I +$G(^PRC(442,PODA,0))'=SITE QUIT 0
46 I $P($G(^PRC(442,PODA,1)),"^",15)<SELFY QUIT 0
47 S XFSO=$P($G(^PRC(442,PODA,7)),"^",4)
48 I XFSO'=FSO QUIT 0
49 ;CHECK MOP QUIT WHEN MOP=9 OR MOP=24 (ISSUES OR AR)
50 S MOP=$P($G(^PRC(442,PODA,0)),"^",2)
51 I (MOP="")!(MOP=9)!(MOP=24) QUIT 0
52 ;I MOP=A1358 QUIT WHEN BALANCE IS ZERO
53 I MOP=21,$P($$BAL^PRCH58(PODA),"^",2)=0 QUIT 0
54 ;CHECK TO SEE IF DOCUMENT IS ALREADY IN 420.96
55 S ID=$P($G(^PRC(442,PODA,0)),"^") I ID="" QUIT 0
56 I $D(^PRCU(420.96,"B",ID)) QUIT 0
57 QUIT 1
58ERRMSG(X) ;
59 S X=$P($T(MSG+X),";",3,99) D BULL1^PRCFOOR4(PRCDA,X) QUIT
60MSG ;
61 ;;Invalid Message Destination
62 ;;Invalid Message Type/Segment
63 ;;Station Number is Missing from Message
64 ;;Message Contains No Data Lines
65 ;;
66FILE(XDA,LINE) ; check each transmission line sent and file in 420.6
67 NEW SITE,NODE,FMSBAL,OUT,FCP,VIFCAPCP,SITE,VSNAPCP,SNAPDA,SNAPSHOT,VARIANCE
68 S NODE=$G(^PRCF(423.6,XDA,1,LINE,0))
69 Q:NODE=""!($P(NODE,"^")'="OOR")
70 S SITE=$P(NODE,"^",10)
71 S FMSBAL=+$P(NODE,"^",5)
72 S FMSFCP=$P(NODE,"^",12)
73 S FMSLINE=$P(NODE,"^",4)
74 S FMSPAT=$E($P(NODE,"^",3),4,99)
75 ;CHECK NEXT LINE - IF IT IS SAME PO, ACCUMULATE FMS BAL
76 F D I $D(OUT) K OUT Q
77 . N NEXTNODE,NSITE,NPAT
78 . S NEXTNODE=$G(^PRCF(423.6,XDA,1,LINE+1,0))
79 . I NEXTNODE=""!($P(NEXTNODE,"^")["{") S OUT="" Q
80 . S NPAT=$E($P(NEXTNODE,"^",3),4,99)
81 . I NPAT=FMSPAT S FMSBAL=FMSBAL+$P(NEXTNODE,"^",5),LINE=LINE+1 K OUT QUIT
82 . S OUT=1 QUIT
83 ;S IFCP=KARENS CALL
84 S ID=+SITE_"-"_FMSPAT
85 S IFPODA=$$GET(ID)
86 S IFBAL=$$GETBAL(+IFPODA)
87 D ADD(ID,FMSFCP,FMSBAL,IFPODA,IFBAL,FMSLINE)
88 QUIT
89GET(X) ;GET IFCAP PO NUMBER
90 N DIC,Y
91 S DIC=442,DIC(0)="MN" D ^DIC
92 Q $S(Y>0:Y,1:"")
93GETBAL(X) ;
94 NEW NODE,OBLIG,RECVD
95 I X="" QUIT ""
96 S NODE=$G(^PRC(442,X,0))
97 I NODE="" QUIT ""
98 ;GET ORIGINAL OBLIGATION AMOUNT
99 S OBLIG=$P(NODE,"^",16)
100 ;GET VALUE OF ALL RECEIVING REPORTS
101 S RECVD=$P(NODE,"^",17)
102 Q (OBLIG-RECVD)
103ADD(ID,FMSFCP,FMSBAL,IFPODA,IFBAL,FMSLINE) ;
104 ;NEW FSO,DIC,DIE,X,Y,DA,DR,DLAYGO,UDOBAL
105 ;FSO=FISCAL STATUS ORDER
106 S FSO=$S(IFPODA="":"",1:$P($G(^PRC(442,IFPODA,7)),"^",4))
107 ;SET FSO=4 IF NO PO, 2 IF COMPLETE, 3 IF OPEN, 0 IF VALID
108 S IFSTATUS=$S('IFPODA:4,FSO=40:2,FSO=41:2,(FMSBAL'=IFBAL):3,1:0)
109 IF IFSTATUS=0 QUIT
110 N DLAYGO S (DIC,DLAYGO)=420.96,DIC(0)="LN",X=ID D ^DIC
111 S DA=+Y
112 S DIE=DIC,DR="1////"_+FMSBAL_";2////"_FMSFCP_";2.5////"_FMSLINE_";3////"_+IFPODA_";4////"_IFBAL_";5////"_IFSTATUS
113 D ^DIE
114 QUIT
115VALIDCP(SITE,CP) ;VALIDATE FUND CONTROL POINT NUMBER
116 I $D(^PRC(420,+SITE,1,+CP,0)) Q 1
117 Q 0
118FY N CFY,X
119 D NOW^%DTC
120 S CFY=$E(X,1,3),CFY=$S(+$E(X,4,5)<10:CFY-1,1:CFY)
121 S SELFY=(CFY-1)_1000
Note: See TracBrowser for help on using the repository browser.