- 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
