122 lines
4.2 KiB
Mathematica
122 lines
4.2 KiB
Mathematica
PRCFOOR3 ;WISC@ALTOONA/CTB-OUTSTANDING OBLIGATION RECONCILIATION ;12/15/94 3:59 PM
|
|
V ;;5.1;IFCAP;;Oct 20, 2000
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
;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
|
|
X 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'["OOR" D ERRMSG(2) QUIT
|
|
; 3 is site correct
|
|
S SITE=$P(NODE,"^",4) I SITE="" D ERRMSG(3) QUIT
|
|
CLEAN ;CLEAN ALL RECORDS FROM 420.96 FOR STATION
|
|
D CLEAN^PRCFOOR4(SITE)
|
|
;MOVE MESSAGE INTO 420.96
|
|
S LINE=10000 F S LINE=$O(^PRCF(423.6,XDA,1,LINE)) Q:'LINE D FILE(XDA,.LINE)
|
|
;GET OUT OF RANGE FY
|
|
D FY
|
|
IFCAP ;LOOP THROUGH PO FILE FOR OPEN IFCAP RECORDS
|
|
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)
|
|
;SEND BULLETIN TO MAIL GROUP
|
|
D BULL^PRCFOOR4(PRCDA)
|
|
;REMOVE MESSAGE
|
|
;D REMOVE^PRCFOOR4(PRCDA)
|
|
QUIT
|
|
ADD1(PODA) ;ADD RECORD TO 420.96 WITH STATUS OF 1
|
|
N DLAYGO,IFBAL
|
|
S IFBAL=$$GETBAL(PODA)
|
|
Q:+IFBAL=0
|
|
S (DIC,DLAYGO)=420.96,DIC(0)="MNL",X=$P($G(^PRC(442,PODA,0)),"^") Q:X=""
|
|
D ^DIC Q:Y<0
|
|
S DIE=DIC,DA=+Y,DR="3////"_PODA_";4////"_IFBAL_";5////1"
|
|
D ^DIE
|
|
QUIT
|
|
CHECK(PODA,FSO) ;QUIT WHEN CLOSED, NOT YET COMPLETE, OR NO MATCH ON SITE
|
|
;FSO=FISCAL STATUS ORDER
|
|
NEW XFSO,OPEN,MOP,ID
|
|
I +$G(^PRC(442,PODA,0))'=SITE QUIT 0
|
|
I $P($G(^PRC(442,PODA,1)),"^",15)<SELFY QUIT 0
|
|
S XFSO=$P($G(^PRC(442,PODA,7)),"^",4)
|
|
I XFSO'=FSO QUIT 0
|
|
;CHECK MOP QUIT WHEN MOP=9 OR MOP=24 (ISSUES OR AR)
|
|
S MOP=$P($G(^PRC(442,PODA,0)),"^",2)
|
|
I (MOP="")!(MOP=9)!(MOP=24) QUIT 0
|
|
;I MOP=A1358 QUIT WHEN BALANCE IS ZERO
|
|
I MOP=21,$P($$BAL^PRCH58(PODA),"^",2)=0 QUIT 0
|
|
;CHECK TO SEE IF DOCUMENT IS ALREADY IN 420.96
|
|
S ID=$P($G(^PRC(442,PODA,0)),"^") I ID="" QUIT 0
|
|
I $D(^PRCU(420.96,"B",ID)) QUIT 0
|
|
QUIT 1
|
|
ERRMSG(X) ;
|
|
S X=$P($T(MSG+X),";",3,99) D BULL1^PRCFOOR4(PRCDA,X) QUIT
|
|
MSG ;
|
|
;;Invalid Message Destination
|
|
;;Invalid Message Type/Segment
|
|
;;Station Number is Missing from Message
|
|
;;Message Contains No Data Lines
|
|
;;
|
|
FILE(XDA,LINE) ; check each transmission line sent and file in 420.6
|
|
NEW SITE,NODE,FMSBAL,OUT,FCP,VIFCAPCP,SITE,VSNAPCP,SNAPDA,SNAPSHOT,VARIANCE
|
|
S NODE=$G(^PRCF(423.6,XDA,1,LINE,0))
|
|
Q:NODE=""!($P(NODE,"^")'="OOR")
|
|
S SITE=$P(NODE,"^",10)
|
|
S FMSBAL=+$P(NODE,"^",5)
|
|
S FMSFCP=$P(NODE,"^",12)
|
|
S FMSLINE=$P(NODE,"^",4)
|
|
S FMSPAT=$E($P(NODE,"^",3),4,99)
|
|
;CHECK NEXT LINE - IF IT IS SAME PO, ACCUMULATE FMS BAL
|
|
F D I $D(OUT) K OUT Q
|
|
. N NEXTNODE,NSITE,NPAT
|
|
. S NEXTNODE=$G(^PRCF(423.6,XDA,1,LINE+1,0))
|
|
. I NEXTNODE=""!($P(NEXTNODE,"^")["{") S OUT="" Q
|
|
. S NPAT=$E($P(NEXTNODE,"^",3),4,99)
|
|
. I NPAT=FMSPAT S FMSBAL=FMSBAL+$P(NEXTNODE,"^",5),LINE=LINE+1 K OUT QUIT
|
|
. S OUT=1 QUIT
|
|
;S IFCP=KARENS CALL
|
|
S ID=+SITE_"-"_FMSPAT
|
|
S IFPODA=$$GET(ID)
|
|
S IFBAL=$$GETBAL(+IFPODA)
|
|
D ADD(ID,FMSFCP,FMSBAL,IFPODA,IFBAL,FMSLINE)
|
|
QUIT
|
|
GET(X) ;GET IFCAP PO NUMBER
|
|
N DIC,Y
|
|
S DIC=442,DIC(0)="MN" D ^DIC
|
|
Q $S(Y>0:Y,1:"")
|
|
GETBAL(X) ;
|
|
NEW NODE,OBLIG,RECVD
|
|
I X="" QUIT ""
|
|
S NODE=$G(^PRC(442,X,0))
|
|
I NODE="" QUIT ""
|
|
;GET ORIGINAL OBLIGATION AMOUNT
|
|
S OBLIG=$P(NODE,"^",16)
|
|
;GET VALUE OF ALL RECEIVING REPORTS
|
|
S RECVD=$P(NODE,"^",17)
|
|
Q (OBLIG-RECVD)
|
|
ADD(ID,FMSFCP,FMSBAL,IFPODA,IFBAL,FMSLINE) ;
|
|
;NEW FSO,DIC,DIE,X,Y,DA,DR,DLAYGO,UDOBAL
|
|
;FSO=FISCAL STATUS ORDER
|
|
S FSO=$S(IFPODA="":"",1:$P($G(^PRC(442,IFPODA,7)),"^",4))
|
|
;SET FSO=4 IF NO PO, 2 IF COMPLETE, 3 IF OPEN, 0 IF VALID
|
|
S IFSTATUS=$S('IFPODA:4,FSO=40:2,FSO=41:2,(FMSBAL'=IFBAL):3,1:0)
|
|
IF IFSTATUS=0 QUIT
|
|
N DLAYGO S (DIC,DLAYGO)=420.96,DIC(0)="LN",X=ID D ^DIC
|
|
S DA=+Y
|
|
S DIE=DIC,DR="1////"_+FMSBAL_";2////"_FMSFCP_";2.5////"_FMSLINE_";3////"_+IFPODA_";4////"_IFBAL_";5////"_IFSTATUS
|
|
D ^DIE
|
|
QUIT
|
|
VALIDCP(SITE,CP) ;VALIDATE FUND CONTROL POINT NUMBER
|
|
I $D(^PRC(420,+SITE,1,+CP,0)) Q 1
|
|
Q 0
|
|
FY N CFY,X
|
|
D NOW^%DTC
|
|
S CFY=$E(X,1,3),CFY=$S(+$E(X,4,5)<10:CFY-1,1:CFY)
|
|
S SELFY=(CFY-1)_1000
|