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

PRCSREC.m

Go to the documentation of this file.
  1. PRCSREC ;WISC/KMB/DL-FMS 820 RECONCILIATION INTERCEPT ;12/28/99 11:06
  1. V ;;5.1;IFCAP;**96,192**;Oct 20, 2000;Build 3
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ; add entry to file 417, update CP balance on File 420
  1. ; finally, send 820 to designee at CP
  1. ; if duplicate, or CP is not in IFCAP, set status to "N" or "D"
  1. ;
  1. ;PRC*5.1*192 Modify FMS interface to insure that regular monies
  1. ; are not attached to an old PO number + extra digit
  1. ; to pull FCP for posting. If the PO number has
  1. ; length >9 ignore PO matching for FCP, defaulting to
  1. ; FCP using required fields table.
  1. ;
  1. START ;
  1. Q:'$D(PRCDA)
  1. N AA,STATUS,STATION,CHECK,FILE,FCP,PODA,OUT,RDA,FY,QTR,TEMP,PONUM,PONUM1,TRANSNUM,X,Y,TDATE
  1. N LINE,LNN,TRANCODE,COUNTER,AMT,RDATE,FMSREF,K,ERROR,STRING
  1. N ENDFY,BEGFY
  1. S OUT=0,(FCP,STATION)=""
  1. D NOW^%DTC S RDATE=%,RDA=PRCDA
  1. ; 1,2 is this the right type of transaction
  1. S CHECK=$P($G(^PRCF(423.6,RDA,1,10000,0)),"^",3) I CHECK'["IFC" S OUT=1 D EVAL Q
  1. S CHECK=$P($G(^PRCF(423.6,RDA,1,10000,0)),"^",5) I CHECK'["REC" S OUT=2 D EVAL Q
  1. ; 3 is site correct
  1. S STATION=$P($G(^PRCF(423.6,RDA,1,10000,0)),"^",4) I STATION="" S OUT=3 D EVAL Q
  1. I '$D(^PRC(420,STATION)) S OUT=3 D EVAL Q
  1. S LINE=10000 F S LINE=$O(^PRCF(423.6,RDA,1,LINE)) Q:'LINE D PROCESS
  1. D KILL^PRCOSRV3(PRCDA)
  1. QUIT
  1. PROCESS ; check each transmission line sent
  1. Q:$P($G(^PRCF(423.6,RDA,1,LINE,0)),"^")["{"
  1. S STRING=^PRCF(423.6,RDA,1,LINE,0)
  1. ; 5,7 can a unique transmission record be determined
  1. S (PONUM,PONUM1)=$P(STRING,"^",18) I PONUM="" S OUT=5 D EVAL Q
  1. S LNN=$P(STRING,"^",19),TDATE=$P(STRING,"^",22) I TDATE="" S OUT=5 D EVAL Q
  1. S TRANCODE=$P(STRING,"^",17) I TRANCODE="" S OUT=7 D EVAL Q
  1. ; 8 is there a fiscal year/quarter
  1. S STATION=$P(STRING,"^",8),FY=$P(STRING,"^",4),QUARTER=$P(STRING,"^",5),AMT=$P(STRING,"^",20)
  1. I (FY="")!(QUARTER="") S OUT=8 D EVAL Q
  1. I (QUARTER'?1N)!(QUARTER>5) S OUT=8 D EVAL Q
  1. S ENDFY=$P(STRING,"^",3),BEGFY=$P(STRING,"^",2)
  1. S TRANSNUM=TRANCODE_"-"_PONUM_"-"_TDATE_"-"_+LNN_"-"_QUARTER
  1. FCPCHEC ;
  1. ; if there is a PO number, get CP from 442 record
  1. S $P(STRING,"^",9)=$P(STRING,"^",21)
  1. S PODA=0,(FCP,FILE)="" S PONUM=$E(PONUM,4,9),PONUM=STATION_"-"_PONUM
  1. ; if it is not an employee payroll transaction ok to search file 442
  1. I TRANCODE'="PR"&($L(PONUM1)<10) D I $D(^PRC(420,STATION,1,+FCP,4,FY)) D CONTINU Q
  1. .S:$D(^PRC(442,"B",PONUM)) PODA=$O(^PRC(442,"B",PONUM,0))
  1. .I +PODA'=0 S FCP=$P($G(^PRC(442,PODA,0)),"^",3),FCP=+$P(FCP," ")
  1. .Q
  1. ; if no PO match is found, use required fields table
  1. S ARRAY("BFY")=+$$YEAR^PRC0C($P(STRING,"^",2))
  1. S FILE=417.1
  1. S ARRAY("FUND")=$P(STRING,"^",6),ARRAY("AO")=$P(STRING,"^",7),ARRAY("FCPRJ")=$P(STRING,"^",10)
  1. S ARRAY("PGM")=$P(STRING,"^",21),ARRAY("OC")=$P(STRING,"^",16),ARRAY("JOB")=$P(STRING,"^",14),ARRAY("SITE")=STATION
  1. ;
  1. S A="" D FINDCP I A="" S FCP="000" S STATUS="N" D SET Q
  1. ;
  1. S B=$$FIRST^PRC0B1("^PRCD(420.141,""B"","""_A_""",",0)
  1. I 'B S FCP="000" S STATUS="N" D SET Q
  1. S FCP=+$P(^PRCD(420.141,B,0),"^",2)
  1. I +FCP=0 S FCP="000" S STATUS="N" D SET Q
  1. I '$D(^PRC(420,STATION,1,+FCP)) S FCP="000",STATUS="N" D SET Q
  1. CONTINU ; set control point balance on file 420
  1. S FILE=417,TRANSNUM=TRANSNUM_"-"_FCP
  1. S CHECK=TRANSNUM I $D(^PRCS(417,"B",CHECK)) S FILE=417.1 D SET Q
  1. S STATUS="P" D SET S AA=STATION_"^"_+FCP_"^"_FY_"^"_QUARTER_"^"_AMT
  1. I TRANCODE'="CC",$E(PONUM1,4,7)'?4A D EBAL^PRCSEZ(AA,"C")
  1. D EBAL^PRCSEZ(AA,"O")
  1. S INFORM=$P($T(MESSAGE+9),";;",2)
  1. I STATUS="P" D ^PRCSREC1 K INFORM QUIT
  1. EVAL I OUT'=0 S ERROR=$P($T(MESSAGE+OUT),";;",2) D ^PRCSREC1
  1. S OUT=0 K ERROR QUIT
  1. SET ; set data on file 417 with status of "P" (posted), "D" (duplicate), "N" (no CP)
  1. S X=TRANSNUM,DIC="^PRCS("_FILE_",",DIC(0)="LZ",DLAYGO=FILE D FILE^DICN Q:Y=-1 S FMSDA=+Y K DLAYGO
  1. L +^PRCS(FILE,FMSDA):5 Q:'$T F K=2,3,5:1:20 S $P(^PRCS(FILE,FMSDA,0),"^",K)=$P(STRING,"^",K)
  1. S K=$P(STRING,"^",4),DIE=DIC,DA=FMSDA,DR="3////^S X=K" D ^DIE
  1. S X=TDATE,X=$E(X,3,4)_"/"_$E(X,5,6)_"/"_$E(X,1,2) K %DT D ^%DT
  1. S $P(^PRCS(FILE,FMSDA,0),"^",22)=Y
  1. I FILE=417 S DIE=DIC,DA=FMSDA,DR="51///^S X=STATUS"_";"_"22///^S X=1" D ^DIE
  1. S COUNTER=STATION_"-"_FY_"-"_QUARTER_"-"_FCP,$P(^PRCS(FILE,FMSDA,0),"^",21)=COUNTER
  1. S ^PRCS(FILE,"C",COUNTER,FMSDA)=""
  1. L -^PRCS(FILE,FMSDA)
  1. K ARRAY,DA,DIC,DIE,DR QUIT
  1. FINDCP ;
  1. S FUNDCODE=+$$FUND^PRC0C(ARRAY("FUND"),ARRAY("BFY")) Q:FUNDCODE=0
  1. D DOCREQ^PRC0C(FUNDCODE,"AB","AB"),DOCREQ^PRC0C(FUNDCODE,"SAB","SAB")
  1. F A="SPE","REV","GL" I $$REQ^PRC0C(FUNDCODE,A,"JOB")="Y" S SAB("JOB")="Y"
  1. S EE="~",A=ARRAY("SITE")_EE_ARRAY("BFY")_EE_ARRAY("FUND")
  1. F I="AO","PGM","FCPRJ","OC","JOB" D
  1. .I $G(AB(I))="Y"!($G(SAB(I))="Y") S PIECE=ARRAY(I)
  1. .E S PIECE=""
  1. .S A=A_EE_PIECE
  1. K AB,EE,I,PIECE,FIELD,FUNDCODE,SAB Q
  1. MESSAGE ;
  1. ;;IFCAP transmission code is incorrect
  1. ;;Transmission type is not correct for 820 processing
  1. ;;Site reference is incorrect
  1. ;;
  1. ;;No FMS message transmission number sent in this transaction
  1. ;;Duplicate message transmission number sent in transaction
  1. ;;No FMS transaction code was sent for this transaction
  1. ;;Invalid fiscal year or quarter sent in this transaction
  1. ;;Your control point balances have been adjusted by the amount above