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

PRCOACT.m

Go to the documentation of this file.
  1. PRCOACT ;WISC/DJM-"ACT" & "PRJ" TRANSACTIONS FROM AUSTIN ;7/21/96 21:45
  1. V ;;5.1;IFCAP;**202**;Oct 20, 2000;Build 27
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. START ;THIS ROUTINE WILL SAVE THE INCOMMING "ACT" OR "PRJ" TRANSACTION
  1. ;IN THE "EDI STATUS" FILE (#443.75) WITHIN AN EXISTING RECORD. THIS
  1. ;ROUTINE WILL START UP WHEN AN "ACT" OR "PRJ" TRANSACTION ARRIVES
  1. ;FROM AUSTIN AND IS SAVED IN FILE 423.6. AFTER SAVING IN 423.6 THE
  1. ;SERVER WILL START UP A BACKGROUND TASK THAT CALLS THIS ROUTINE.
  1. ;
  1. ;THE BACKGROUND TASK WILL SET UP **PRCDA**, THE INTERNAL ENTRY
  1. ;NUMBER FROM FILE 423.6. THE RECORD AT **PRCDA** CONTAINS THE DATA
  1. ;FROM THE "ACT" OR "PRJ" TRANSACTION THAT 'ARRIVED' FROM AUSTIN.
  1. ;
  1. N COUNT,COUNTER,I,LINE,MGP,PONO,PRC,PRCMG,PRCTC,PRCTT,PRCXM,RFQ,RECORD,ERRCNT
  1. N RRC,SEGT,STATION,STCK,TEXT,VENDOR,X,X1,X2
  1. ;
  1. ;NOW LETS VERIFY THAT THE TRANSACTION BELONGS TO THIS SITE.
  1. ;
  1. S LINE=$G(^PRCF(423.6,PRCDA,1,10000,0))
  1. S MGP=$O(^PRCF(423.5,"B",$P(LINE,U)_"-"_$P(LINE,U,4),0))
  1. I MGP="" S PRCXM(1)=$P($T(ERROR+8),";;",2)_$P(LINE,U)_"-"_$P(LINE,U,4)_"." G EXIT
  1. S MGP=$G(^PRCF(423.5,MGP,0))
  1. I MGP="" S PRCXM(1)=$P($T(ERROR+9),";;",2) G EXIT
  1. I $P(MGP,U,2)="" S PRCXM(1)=$P($T(ERROR+10),";;",2) G EXIT
  1. I $P(MGP,U,2)]"" S PRCMG=$P($G(^XMB(3.8,$P(MGP,U,2),0)),U)
  1. I PRCMG="" S PRCXM(1)=$P($T(ERROR+11),";;",2) G EXIT
  1. D I $D(PRCXM(1)) G EXIT
  1. . I ",ACT,PRJ,"'[","_$P(LINE,U,4)_"," S PRCXM(1)=$P($T(ERROR+1),";;",2)_$P(LINE,U,4)_"." Q
  1. . S STATION=$P(LINE,U,3) I STATION="" S PRCXM(1)=$P($T(ERROR+4),";;",2)_$G(PRCDA)_"." Q
  1. . S STCK=$O(^PRC(411,"B",STATION,0)) I STCK'>0 S PRCXM(1)=$P($T(ERROR+2),";;",2)_$G(STATION)_"." Q
  1. . Q
  1. S PRCTC=$P(LINE,U,4)
  1. ;
  1. ;GATHER THE DATA FROM THE 'AT' SEGMENT OF THE TRANSACTION.
  1. ;
  1. S LINE=$G(^PRCF(423.6,PRCDA,1,10001,0))
  1. I $P(LINE,U,1)'="AT" S PRCXM(1)=$P($T(ERROR+3),";;",2)_$P($G(LINE),U)_"." G EXIT
  1. S PRCTT=$P(LINE,U,2)
  1. I PRCTT="" S PRCXM(1)=$P($T(ERROR+13),";;",2)_$G(PRCDA)_"." G EXIT
  1. S COUNT=+$P(LINE,U,3)
  1. ;
  1. ;NOW GET THE DATA FROM EACH 'TR' OR 'RJ' SEGMENT.
  1. ;
  1. S I=10001
  1. S COUNTER=0,ERRCNT=1
  1. K PRCXM
  1. F S I=$O(^PRCF(423.6,PRCDA,1,I)) Q:I'>0 D D:$O(PRCXM(0)) PERROR^PRCOACT0 Q:LINE["$"
  1. . K PRC
  1. . S LINE=$G(^PRCF(423.6,PRCDA,1,I,0))
  1. . Q:$E(LINE,1)="$"
  1. . S SEGT=$P(LINE,U)
  1. . Q:",TR,RJ,"'[","_SEGT_","
  1. . S PRC(1,443.75,"?+1,",9)=PRCTC
  1. . S PRC(1,443.75,"?+1,",21)=COUNT
  1. . S PONO=$P(LINE,U,2)
  1. . I PRCTT="PHA" D
  1. . . F Q:$A(PONO,$L(PONO))'=32 S PONO=$E(PONO,1,$L(PONO)-1)
  1. . . S PONO=$E(PONO,1,3)_"-"_$E(PONO,4,$L(PONO))
  1. . . Q
  1. . S X1=$E($P(LINE,U,5),1,4)-1700_"0101"
  1. . S X2=$E($P(LINE,U,5),5,7)-1
  1. . D C^%DTC
  1. . S PRC(1,443.75,"?+1,",10)=X_"."_$P(LINE,U,6)
  1. . S PRC(1,443.75,"?+1,",22)=$S(PRCTC="ACT":$P(LINE,U,7),1:$P(LINE,U,14))
  1. . S VENDOR=$P(LINE,U,3)
  1. . S:PRCTT="RFQ" RFQ=$S(PRCTC="ACT":$P(LINE,U,8),1:$P(LINE,U,16))
  1. . S:PRCTT="TXT" TEXT=$P(LINE,U,4)
  1. . I PONO="" S PRCXM(ERRCNT)=$P($T(ERROR+14),";;",2)_$G(PRCDA)_"." D ERRCNT Q
  1. . I PRCTT'="PHA",VENDOR="" S PRCXM(ERRCNT)=$P($T(ERROR+15),";;",2)_$G(PRCDA)_"." D ERRCNT Q
  1. . I PRCTT="RFQ",RFQ="" S PRCXM(ERRCNT)=$P($T(ERROR+16),";;",2)_$G(PRCDA)_"." D ERRCNT Q
  1. . I PRCTT="TXT",TEXT="" S PRCXM(ERRCNT)=$P($T(ERROR+17),";;",2)_$G(PRCDA)_"." D ERRCNT Q
  1. . S RECORD=""
  1. . I PRCTT="PHA" D Q:$O(PRCXM(0))
  1. . . I VENDOR]"" S RECORD=$O(^PRC(443.75,"AO",PRCTT,PONO,VENDOR,0))
  1. . . I 'RECORD D I 'RECORD S PRCXM(ERRCNT)=$P($T(ERROR+19),";;",2)_$G(PRCDA)_"." D ERRCNT Q
  1. . . . S RECORD=$O(^PRC(443.75,"AR",PONO,0))
  1. . . Q:$O(PRCXM(0))
  1. . . S VENDOR(1)=$P($G(^PRC(443.75,+$G(RECORD),0)),U,6)
  1. . . I VENDOR]"",VENDOR(1)]""&(VENDOR'=VENDOR(1)) S PRCXM(ERRCNT)=$P($T(ERROR+20),";;",2)_$G(RECORD)_"." D ERRCNT Q
  1. . S:PRCTT="RFQ" RECORD=$O(^PRC(443.75,"AC",PRCTT,PONO,VENDOR,RFQ,0))
  1. . S:PRCTT="TXT" RECORD=$O(^PRC(443.75,"AF",PRCTT,PONO,VENDOR,TEXT,0))
  1. . I $G(^PRC(443.75,+$G(RECORD),0))']"" S PRCXM(ERRCNT)=$P($T(ERROR+12),";;",2)_$G(PONO)_"." D ERRCNT Q
  1. . L +^PRC(443.75,RECORD):180 E S PRCXM(ERRCNT)=$P($T(ERROR+18),";;",2)_$G(RECORD)_"." D ERRCNT Q
  1. . ;
  1. . I SEGT="RJ" D
  1. . . S PRC(1,443.75,"?+1,",11)=$P(LINE,U,7)
  1. . . S PRC(1,443.75,"?+1,",12)=$P(LINE,U,8)
  1. . . S PRC(1,443.75,"?+1,",13)=$P(LINE,U,9)
  1. . . S:$P(LINE,U,12)]"" PRC(1,443.75,"?+1,",17)=$P(LINE,U,12)
  1. . . S:$P(LINE,U,13)]"" PRC(1,443.75,"?+1,",18)=$P(LINE,U,13)
  1. . . S:$P(LINE,U,10)]"" PRC(1,443.75,"?+1,",14)=$P(LINE,U,10)
  1. . . S RRC=$$EXTRL^PRCOACT0($P(LINE,U,15),1)
  1. . . I RRC']"" S PRCXM(ERRCNT)=$P($T(ERROR+5),";;",2)_$G(PRCDA)_"." D ERRCNT
  1. . . I RRC']"" S PRC(1,443.75,"?+1,",19)="E"
  1. . . I RRC']"" S PRC(1,443.75,"?+1,",20)=$P($T(ERROR+5),";;",3) Q
  1. . . S RRC=$O(^PRC(443.76,"B",RRC,0))
  1. . . I RRC'>0 S PRCXM(ERRCNT)=$P($T(ERROR+6),";;",2)_$G(PRCDA)_" (Error Code is "_$$EXTRL^PRCOACT0($P(LINE,U,15),1)_")." D ERRCNT
  1. . . I RRC'>0 S PRC(1,443.75,"?+1,",19)="E"
  1. . . I RRC'>0 S PRC(1,443.75,"?+1,",20)=$P($T(ERROR+6),";;",3) Q
  1. . . S PRC(1,443.75,"?+1,",15)=RRC
  1. . . Q
  1. . S PRC(1,443.75,"?+1,",.01)=+$P($G(^PRC(443.75,RECORD,0)),U)
  1. . D UPDATE^DIE("","PRC(1)")
  1. . S COUNTER=COUNTER+1
  1. STOP . L:$G(RECORD) -^PRC(443.75,RECORD)
  1. . Q
  1. I $G(RECORD),COUNTER'=COUNT S PRCXM(ERRCNT)=$P($T(ERROR+7),";;",2)_$G(PRCDA)_"." D ERRCNT
  1. ;
  1. EXIT I $O(PRCXM(0)) D PERROR^PRCOACT0 Q
  1. D KILL^PRCOSRV3(PRCDA)
  1. Q
  1. ERRCNT ;increment counter for multiple errors within RJ,TR processing
  1. S ERRCNT=ERRCNT+1
  1. Q
  1. ;
  1. ERROR ;HERE IS THE LIST OF ERROR MESSAGES
  1. ;;Expected an ACT or a PRJ transaction. Received a ;;A1
  1. ;;The STATION number sent from EDI can not be found. The number is ;;A2
  1. ;;The second segment is not the expected AT segment. It was a ;;A3
  1. ;;There is no STATION number sent from EDI. IEN for 423.6 is ;;A4
  1. ;;No REJECT REASON CODE from EDI. The record IEN in 423.6 is ;;A5
  1. ;;The ERROR CODE can not be found in the EDI ERROR CODES file. The record IEN in 423.6 is ;;A6
  1. ;;There is a difference in the number of TR or RJ segments expected and how many found. File 423.6 entry is ;;A7
  1. ;;There is no "B" cross-reference entry for this transaction in file 423.5. The entry is ;;A8
  1. ;;There is a "B" cross-reference entry for this transaction but no record.;;A9
  1. ;;There is a record for this transaction but no mail group pointer is listed.;;A10
  1. ;;The mail group entered in the record in file 423.5 can not be found in the mail group file.;;A11
  1. ;;The incoming record can't be found in file 443.75. The RFQ/PO# is ;;A12
  1. ;;Required field TYPE OF TRANSACTION is blank. IEN for file 423.6 is ;;A13
  1. ;;Required field REF NUMBER is blank. IEN for file 423.6 is ;;A14
  1. ;;Required field VENDOR ID NUMBER is blank. IEN for file 423.6 is ;;A15
  1. ;;Required field TYPE OF RFQ is blank. IEN for file 423.6 is ;;A16
  1. ;;Required field TXT MESSAGE NUMBER is blank. IEN for file 423.6 is ;;A17
  1. ;;Unable to access record in file 443.75. IEN is ;;A18
  1. ;;Unable to locate entry in file 443.75. IEN for file 423.6 is ;;A19
  1. ;;VENDOR ID on transmission does not match 443.75 entry. The IEN is ;;A20