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