PSXACK ;BIR/BAB-Process MSA Segment after Msg Transmits ; [ 04/08/97 2:06 PM ]
;;2.0;CMOP;;11 Apr 97
EN ;This routine processes an MSA segment and returns PSXPOP=1
;if there was a problem.
;Requires PSXQN = message entry number
SLAVE ;wait to enter slave mode to receive ACK message
R *X:PSXDLTD E D
E D ACK1 G ERROR
I X'=ENQ D ACK5 G ERROR
R *X:PSXDLTA
I ('$T)!(X'=TERM) D ACK4 G ERROR
W *ACK,0,*TERM
S BFLAG=0
S BHST=0
MSG R *X:PSXDLTD E D ACK1 G ERROR
I X=STX G READ
I X=EOT R *X:PSXDLTA I X=TERM G TST
D ACK5 ;unexpected character received
ERROR D FLUSH1^PSXUTL
D LOG^PSXUTL
S PSXPOP=1
K PSXHEX,PSXACK,PSXREJ,LOG,PSXSUM
QUIT
READ S PSXACK=""
S PSXTMD=$P($H,",",2)
GETMSG S AA=0 F %=1:1 D Q:'%
.R *X:PSXDLTA E D ACK6,LOG^PSXUTL S %=0,X="" Q
.D CHKD^PSXUTL I PSXTMOUT D ACK6,LOG^PSXUTL S %=0,X="" Q
.I %>240 D ACK7,LOG^PSXUTL S %=0,X="" Q
.S PSXACK=PSXACK_$C(X)
.I (X=ETX)!(X=ETB) S %=0
I X=ETX S AA=1 G TEST
I X=ETB S AA=2 G TEST
I X=EOT R *X:PSXDLTA G:X=TERM TST
I (X'=ETX)!(X'=ETB)!(X'=EOT) D ACK8 G ERROR
I PSXACK="" D ACK9 G ERROR
Q
TEST R *X:PSXDLTA E D ACK10 G ERROR
I "0123456789ABCDEF"'[$C(X) D ACK11 G ERROR
S PSXSUM=$C(X)
CHKSUM R *X:PSXDLTA E D ACK10 G ERROR
I "0123456789ABCDEF"'[$C(X) D ACK11 G ERROR
S PSXSUM=PSXSUM_$C(X)
S X=PSXACK X ^%ZOSF("LPC") S PSXHEX=Y D HEX^PSXUTL
R *X:1 I X'=TERM D ACK5
I PSXHEX'=PSXSUM D ACK12 G ERROR
I PSXHEX=PSXSUM D FLUSH1^PSXUTL
;S:$P(PSXACK,"|",1)["BHS" BHST=1,BFLAG=1,PSXBHS=1
S:$P(PSXACK,"|",1)["BHS" BHST=1,BFLAG=1
I (BFLAG=1)&($P(PSXACK,"|",1)["BHS") S PSXMSH=$G(PSXMSH)_"+"_$E(PSXACK,7,$L(PSXACK)-2)
I (BFLAG=1)&($P(PSXACK,"|",1)["MSA") S PSXMSA=$G(PSXMSA)_"+"_$E(PSXACK,7,$L(PSXACK)-2),BFLAG=0,PSXBHS=1 S:$G(PSXMSA)["|AR|" PSXBHS=0 K:$G(PSXBHS)'>0 PSXMSH,PSXMSA
I $E(PSXACK,7,10)["MSH|" S TACK=$E(PSXACK,7,$L(PSXACK)-2)
W *ACK,$S(AA=1:2,AA=2:1,1:""),*TERM D:$P(PSXACK,"|",1)["MSA" FILE G MSG
Q
FILE Q:$G(BHST)=1
I $P($P(PSXACK,"MSA",2),"|",3)'=PSXMSGID D ACK15 G ERROR
S XXX=$P($P(PSXACK,"MSA",2),"|",3),REC=$O(^PSX(552.2,"B",XXX,""))
S REC=$G(PSXQN)
Q:$G(REC)=""
S ^PSX(552.2,REC,"ACK")=TACK_$E(PSXACK,7,$L(PSXACK)-2)
S (PSXPOP,PSXREJ)=0
I (PSXACK["AR") S PSXREJ=1 D ACK13,LOG^PSXUTL
L +^PSX(552.2,REC):DTIME I $T S DIE="^PSX(552.2,",DA=REC,DR="1///"_$S(PSXREJ:99,'PSXREJ:3,1:0)_";3///^S X=$H" D ^DIE K DIE,DA L -^PSX(552.2,REC)
K XXX,REC,PSXREJ,PSXACK,TACK
Q
TST D FLUSH1^PSXUTL
K PSXHEX,PSXACK,PSXREJ,LOG,PSXSUM
Q
ACK1 K LOG S LOG(1)="ACK1 ACK message never received for order #"_$P($G(^PSX(552.2,PSXQN,0)),"^",1) Q
ACK2 K LOG S LOG(1)="ACK2 EOT received with no terminator while waiting for ACK message" Q
ACK3 K LOG S LOG(1)="ACK3 EOT received while waiting for ACK message" Q
ACK4 K LOG S LOG(1)="ACK4 ENQ received with no terminator while waiting for ACK message" Q
ACK5 K LOG S LOG(1)="ACK5 Unexpected character received: "_$S(X>31:$C(X),1:"")_" ("_X_") while waiting for ACK message" Q
ACK6 K LOG S LOG(1)="ACK6 Timeout Timer D reading ACK message" Q
ACK7 K LOG S LOG(1)="ACK7 ACK message longer than 240 characters" Q
ACK8 K LOG S LOG(1)="ACK8 ACK message did not end with ETX" Q
ACK9 K LOG S LOG(1)="ACK9 ACK was null" Q
ACK10 K LOG S LOG(1)="ACK10 Timeout reading ACK checksum" Q
ACK11 K LOG S LOG(1)="ACK11 ACK checksum contained an invalid hex digit ("_X_")" Q
ACK12 K LOG S LOG(1)="ACK12 ACK checksum does not match" Q
ACK13 K LOG S LOG(1)="ACK13 Order #"_$P($G(^PSX(552.2,PSXQN,0)),"^",1)_" was rejected by CMOP" Q
ACK14 K LOG S LOG(1)="ACK14 ENQ received with no terminator" Q
ACK15 K LOG S LOG(1)="ACK15 MSA order # did not match "_$P($G(^PSX(552.2,PSXQN,0)),"^",1)_" # expected" Q
PSXACK ;BIR/BAB-Process MSA Segment after Msg Transmits ; [ 04/08/97 2:06 PM ]
+1 ;;2.0;CMOP;;11 Apr 97
EN ;This routine processes an MSA segment and returns PSXPOP=1
+1 ;if there was a problem.
+2 ;Requires PSXQN = message entry number
SLAVE ;wait to enter slave mode to receive ACK message
+1 READ *X:PSXDLTD
IF '$TEST
Begin DoDot:1
End DoDot:1
+2 IF '$TEST
DO ACK1
GOTO ERROR
+3 IF X'=ENQ
DO ACK5
GOTO ERROR
+4 READ *X:PSXDLTA
+5 IF ('$TEST)!(X'=TERM)
DO ACK4
GOTO ERROR
+6 WRITE *ACK,0,*TERM
+7 SET BFLAG=0
+8 SET BHST=0
MSG READ *X:PSXDLTD
IF '$TEST
DO ACK1
GOTO ERROR
+1 IF X=STX
GOTO READ
+2 IF X=EOT
READ *X:PSXDLTA
IF X=TERM
GOTO TST
+3 ;unexpected character received
DO ACK5
ERROR DO FLUSH1^PSXUTL
+1 DO LOG^PSXUTL
+2 SET PSXPOP=1
+3 KILL PSXHEX,PSXACK,PSXREJ,LOG,PSXSUM
+4 QUIT
READ SET PSXACK=""
+1 SET PSXTMD=$PIECE($HOROLOG,",",2)
GETMSG SET AA=0
FOR %=1:1
Begin DoDot:1
+1 READ *X:PSXDLTA
IF '$TEST
DO ACK6
DO LOG^PSXUTL
SET %=0
SET X=""
QUIT
+2 DO CHKD^PSXUTL
IF PSXTMOUT
DO ACK6
DO LOG^PSXUTL
SET %=0
SET X=""
QUIT
+3 IF %>240
DO ACK7
DO LOG^PSXUTL
SET %=0
SET X=""
QUIT
+4 SET PSXACK=PSXACK_$CHAR(X)
+5 IF (X=ETX)!(X=ETB)
SET %=0
End DoDot:1
IF '%
QUIT
+6 IF X=ETX
SET AA=1
GOTO TEST
+7 IF X=ETB
SET AA=2
GOTO TEST
+8 IF X=EOT
READ *X:PSXDLTA
IF X=TERM
GOTO TST
+9 IF (X'=ETX)!(X'=ETB)!(X'=EOT)
DO ACK8
GOTO ERROR
+10 IF PSXACK=""
DO ACK9
GOTO ERROR
+11 QUIT
TEST READ *X:PSXDLTA
IF '$TEST
DO ACK10
GOTO ERROR
+1 IF "0123456789ABCDEF"'[$CHAR(X)
DO ACK11
GOTO ERROR
+2 SET PSXSUM=$CHAR(X)
CHKSUM READ *X:PSXDLTA
IF '$TEST
DO ACK10
GOTO ERROR
+1 IF "0123456789ABCDEF"'[$CHAR(X)
DO ACK11
GOTO ERROR
+2 SET PSXSUM=PSXSUM_$CHAR(X)
+3 SET X=PSXACK
XECUTE ^%ZOSF("LPC")
SET PSXHEX=Y
DO HEX^PSXUTL
+4 READ *X:1
IF X'=TERM
DO ACK5
+5 IF PSXHEX'=PSXSUM
DO ACK12
GOTO ERROR
+6 IF PSXHEX=PSXSUM
DO FLUSH1^PSXUTL
+7 ;S:$P(PSXACK,"|",1)["BHS" BHST=1,BFLAG=1,PSXBHS=1
+8 IF $PIECE(PSXACK,"|",1)["BHS"
SET BHST=1
SET BFLAG=1
+9 IF (BFLAG=1)&($PIECE(PSXACK,"|",1)["BHS")
SET PSXMSH=$GET(PSXMSH)_"+"_$EXTRACT(PSXACK,7,$LENGTH(PSXACK)-2)
+10 IF (BFLAG=1)&($PIECE(PSXACK,"|",1)["MSA")
SET PSXMSA=$GET(PSXMSA)_"+"_$EXTRACT(PSXACK,7,$LENGTH(PSXACK)-2)
SET BFLAG=0
SET PSXBHS=1
IF $GET(PSXMSA)["|AR|"
SET PSXBHS=0
IF $GET(PSXBHS)'>0
KILL PSXMSH,PSXMSA
+11 IF $EXTRACT(PSXACK,7,10)["MSH|"
SET TACK=$EXTRACT(PSXACK,7,$LENGTH(PSXACK)-2)
+12 WRITE *ACK,$SELECT(AA=1:2,AA=2:1,1:""),*TERM
IF $PIECE(PSXACK,"|",1)["MSA"
DO FILE
GOTO MSG
+13 QUIT
FILE IF $GET(BHST)=1
QUIT
+1 IF $PIECE($PIECE(PSXACK,"MSA",2),"|",3)'=PSXMSGID
DO ACK15
GOTO ERROR
+2 SET XXX=$PIECE($PIECE(PSXACK,"MSA",2),"|",3)
SET REC=$ORDER(^PSX(552.2,"B",XXX,""))
+3 SET REC=$GET(PSXQN)
+4 IF $GET(REC)=""
QUIT
+5 SET ^PSX(552.2,REC,"ACK")=TACK_$EXTRACT(PSXACK,7,$LENGTH(PSXACK)-2)
+6 SET (PSXPOP,PSXREJ)=0
+7 IF (PSXACK["AR")
SET PSXREJ=1
DO ACK13
DO LOG^PSXUTL
+8 LOCK +^PSX(552.2,REC):DTIME
IF $TEST
SET DIE="^PSX(552.2,"
SET DA=REC
SET DR="1///"_$SELECT(PSXREJ:99,'PSXREJ:3,1:0)_";3///^S X=$H"
DO ^DIE
KILL DIE,DA
LOCK -^PSX(552.2,REC)
+9 KILL XXX,REC,PSXREJ,PSXACK,TACK
+10 QUIT
TST DO FLUSH1^PSXUTL
+1 KILL PSXHEX,PSXACK,PSXREJ,LOG,PSXSUM
+2 QUIT
ACK1 KILL LOG
SET LOG(1)="ACK1 ACK message never received for order #"_$PIECE($GET(^PSX(552.2,PSXQN,0)),"^",1)
QUIT
ACK2 KILL LOG
SET LOG(1)="ACK2 EOT received with no terminator while waiting for ACK message"
QUIT
ACK3 KILL LOG
SET LOG(1)="ACK3 EOT received while waiting for ACK message"
QUIT
ACK4 KILL LOG
SET LOG(1)="ACK4 ENQ received with no terminator while waiting for ACK message"
QUIT
ACK5 KILL LOG
SET LOG(1)="ACK5 Unexpected character received: "_$SELECT(X>31:$CHAR(X),1:"")_" ("_X_") while waiting for ACK message"
QUIT
ACK6 KILL LOG
SET LOG(1)="ACK6 Timeout Timer D reading ACK message"
QUIT
ACK7 KILL LOG
SET LOG(1)="ACK7 ACK message longer than 240 characters"
QUIT
ACK8 KILL LOG
SET LOG(1)="ACK8 ACK message did not end with ETX"
QUIT
ACK9 KILL LOG
SET LOG(1)="ACK9 ACK was null"
QUIT
ACK10 KILL LOG
SET LOG(1)="ACK10 Timeout reading ACK checksum"
QUIT
ACK11 KILL LOG
SET LOG(1)="ACK11 ACK checksum contained an invalid hex digit ("_X_")"
QUIT
ACK12 KILL LOG
SET LOG(1)="ACK12 ACK checksum does not match"
QUIT
ACK13 KILL LOG
SET LOG(1)="ACK13 Order #"_$PIECE($GET(^PSX(552.2,PSXQN,0)),"^",1)_" was rejected by CMOP"
QUIT
ACK14 KILL LOG
SET LOG(1)="ACK14 ENQ received with no terminator"
QUIT
ACK15 KILL LOG
SET LOG(1)="ACK15 MSA order # did not match "_$PIECE($GET(^PSX(552.2,PSXQN,0)),"^",1)_" # expected"
QUIT
