| 1 | PRCFOOR3 ;WISC@ALTOONA/CTB-OUTSTANDING OBLIGATION RECONCILIATION ;12/15/94 3:59 PM
|
|---|
| 2 | V ;;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
|
|---|
| 11 | X 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
|
|---|
| 20 | CLEAN ;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
|
|---|
| 26 | IFCAP ;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
|
|---|
| 33 | ADD1(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
|
|---|
| 42 | CHECK(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
|
|---|
| 58 | ERRMSG(X) ;
|
|---|
| 59 | S X=$P($T(MSG+X),";",3,99) D BULL1^PRCFOOR4(PRCDA,X) QUIT
|
|---|
| 60 | MSG ;
|
|---|
| 61 | ;;Invalid Message Destination
|
|---|
| 62 | ;;Invalid Message Type/Segment
|
|---|
| 63 | ;;Station Number is Missing from Message
|
|---|
| 64 | ;;Message Contains No Data Lines
|
|---|
| 65 | ;;
|
|---|
| 66 | FILE(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
|
|---|
| 89 | GET(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:"")
|
|---|
| 93 | GETBAL(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)
|
|---|
| 103 | ADD(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
|
|---|
| 115 | VALIDCP(SITE,CP) ;VALIDATE FUND CONTROL POINT NUMBER
|
|---|
| 116 | I $D(^PRC(420,+SITE,1,+CP,0)) Q 1
|
|---|
| 117 | Q 0
|
|---|
| 118 | FY 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
|
|---|
