- PSXSND ;BIR/BAB,WPB-Transmit a Message ;[ 05/13/97 8:39 AM ]
- ;;2.0;CMOP;**1**;11 Apr 97
- GETMSG ;Get first message in queue
- S PSXQN=$O(^PSX(552.2,"AQ",PSXB,"")) K PSXPOP
- S PSXMSGID=$P(^PSX(552.2,PSXQN,0),"^")
- G:'PSXQN ^PSXJOB
- G:$G(PSXBHS)'=1 HDR
- S BHST=0
- D GETTXT Q:$G(QRYPOP)=1
- G:PSXPOP ^PSXJOB
- I PSXPOP D SND8 D LOG^PSXUTL,FLUSH1^PSXUTL
- I PSXPOP G DONE ;dont store last if mess never sent
- S ^PSX(553,1,99)=$P(^PSX(552.2,PSXQN,0),"^") ;last message sent, wait for ACK message
- DONE W *EOT,*TERM ;send termination sequence to slave
- D EN^PSXACK ;get ACK message
- G ^PSXJOB
- FILE Q:$G(PSXDA)="" D NOW^%DTC S REC=PSXDA L +^PSX(552.1,REC):30 G:'$T FILE S $P(^PSX(552.1,REC,0),U,2)=3,DIE="^PSX(552.1,",DA=REC,DR="16////"_%_";18////"_$G(PSXMSH)_$G(PSXMSA)_";20////@"
- D ^DIE L -^PSX(552.1,REC) K DIE,REC S DIK="^PSX(552.1," D IX^DIK K DA,DIK
- S LOG(1)="Transmission # "_PSXB_" finished downloading." D LOG^PSXUTL
- S $P(^PSX(554,1,0),"^",2)=PSXB
- D ACK^PSXNOTE
- Q
- HDR D TSOUT^PSXUTL
- S PSXBLK=1,PSXBHS=0,LOG(1)="Downloading Transmission # "_PSXB D LOG^PSXUTL
- ;S $P(^PSX(552.1,PSXDA,0),"^",2)=7
- S PSXTXT="BHS|^~\&|DHCP||"_$S($G(PSXVNDR)>0:"SI BAKER",1:"ELECTROCOM")_"||"_PSXTS_"||ORM|"_PSXB_"|P|2.1|",PSXLAST=0 D XMIT G:$G(PSXPOP) ^PSXJOB
- S PSXBLK=PSXBLK+1
- S REC=PSXDA,PSXMSGID=PSXB
- F CNT=0:0 S CNT=$O(^PSX(552.1,REC,"S",CNT)) Q:CNT'>0 S PSXBLK=(CNT#8)+1,PSXTXT=$G(^PSX(552.1,REC,"S",CNT,0)),PSXLAST=$S($O(^PSX(552.1,REC,"S",CNT)):0,1:1) S:PSXBLK>7 PSXBLK=0 D XMIT G:$G(PSXPOP) ^PSXJOB
- W *EOT,*TERM
- D EN^PSXACK K:$G(PSXBHS)>0 XTRY G:PSXBHS=1 BID1^PSXMST
- S XTRY=$G(XTRY)+1 S LOG(1)="Batch Header Rejected by Vendor for Transmission "_$G(PSXB) D LOG^PSXUTL G:$G(XTRY)'>5 ^PSXJOB
- I $G(XTRY)>5 S LOG(1)="Batch Header for transmission "_$G(PSXB)_" rejected max times.",LOG(2)="DHCP Stopping interface." D LOG^PSXUTL G STOP^PSXJOB
- Q
- GETTXT F I=0:0 S I=$O(^PSX(552.2,PSXQN,"T",I)) Q:'I K PSXTXT S PSXBLK=I#8,PSXTXTN=I,PSXTXT=$G(^(PSXTXTN,0)),PSXLAST=$S($O(^PSX(552.2,PSXQN,"T",I)):0,1:1) Q:PSXTXT="" D XMIT Q:PSXPOP
- Q
- XMIT S (PSXPOP,PSXTRYN)=0
- S PSXLEN=$L(PSXTXT)
- S PSXLEN=$E("00000",1,5-$L(PSXLEN))_PSXLEN
- S PSXTXT=PSXBLK_PSXLEN_PSXTXT_$S(PSXLAST:$C(ETX),1:$C(ETB))
- ;Get 2 byte hex Csum
- S X=PSXTXT X ^%ZOSF("LPC") S PSXHEX=Y D HEX^PSXUTL
- S PSXTXT=$C(STX)_PSXTXT_PSXHEX_$C(TERM)
- RETRY W PSXTXT
- S PSXBLK=$A(PSXBLK)
- TRY R *X:PSXDLTA E D SND1 G ERROR ;look for ACK or NAK
- I X=ACK R *X:PSXDLTA D:('$T)!(X'=PSXBLK) SND2 G:('$T)!(X'=PSXBLK) ERROR R *X:PSXDLTA D:('$T)!(X'=TERM) SND9 G:('$T)!(X'=TERM) ERROR Q
- I X=NAK R *X:PSXDLTA D:('$T)!(X'=TERM) SND3 D SND4 G ERROR
- I X=EOT R *X:PSXDLTA D:('$T)!(X'=TERM) SND5 D SND7 G:('$T)!(X'=TERM) ERROR S PSXTRYN=9999 G ERROR
- D SND6
- ERROR D FLUSH1^PSXUTL,LOG^PSXUTL
- S PSXTRYN=PSXTRYN+1
- S PSXBLK=$C(PSXBLK)
- G:PSXTRYN'>PSXTRYL RETRY
- S PSXPOP=1
- Q
- SND1 K LOG S LOG(1)="SND1 Timer A timeout after sending a line of text."_$G(PSXBLK) Q
- SND2 K LOG S LOG(1)="SND2 ACK Received with bad block number after sending line of text, ASCII ("_$G(X)_") "_X
- S LOG(2)="Expected ASCII ("_$G(PSXBLK)_")." Q
- SND3 K LOG S LOG(1)="SND3 NAK Received with no terminator after sending a line of text." Q
- SND4 K LOG S LOG(1)="SND4 NAK Received after sending a line of text." Q
- SND5 K LOG S LOG(1)="SND5 EOT Received with no terminator after sending a line of text." Q
- SND6 K LOG S LOG(1)="SND6 Garbage received after sending a line of text. ("_X_")" Q
- SND7 K LOG S LOG(1)="SND7 EOT Received, aborting send." Q
- SND8 K LOG S LOG(1)="SND8 Aborting Send. Error processing order # "_$P($G(^PSX(552.2,PSXQN,0)),"^",1)_". Text: "_PSXTXT Q
- SND9 K LOG S LOG(1)="SND9 ACK,"_$G(PSXBLK)_" received with no terminator after sending",LOG(2)="a line of text." Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSXSND 3751 printed Jan 18, 2025@02:46:26 Page 2
- PSXSND ;BIR/BAB,WPB-Transmit a Message ;[ 05/13/97 8:39 AM ]
- +1 ;;2.0;CMOP;**1**;11 Apr 97
- GETMSG ;Get first message in queue
- +1 SET PSXQN=$ORDER(^PSX(552.2,"AQ",PSXB,""))
- KILL PSXPOP
- +2 SET PSXMSGID=$PIECE(^PSX(552.2,PSXQN,0),"^")
- +3 if 'PSXQN
- GOTO ^PSXJOB
- +4 if $GET(PSXBHS)'=1
- GOTO HDR
- +5 SET BHST=0
- +6 DO GETTXT
- if $GET(QRYPOP)=1
- QUIT
- +7 if PSXPOP
- GOTO ^PSXJOB
- +8 IF PSXPOP
- DO SND8
- DO LOG^PSXUTL
- DO FLUSH1^PSXUTL
- +9 ;dont store last if mess never sent
- IF PSXPOP
- GOTO DONE
- +10 ;last message sent, wait for ACK message
- SET ^PSX(553,1,99)=$PIECE(^PSX(552.2,PSXQN,0),"^")
- DONE ;send termination sequence to slave
- WRITE *EOT,*TERM
- +1 ;get ACK message
- DO EN^PSXACK
- +2 GOTO ^PSXJOB
- FILE if $GET(PSXDA)=""
- QUIT
- DO NOW^%DTC
- SET REC=PSXDA
- LOCK +^PSX(552.1,REC):30
- if '$TEST
- GOTO FILE
- SET $PIECE(^PSX(552.1,REC,0),U,2)=3
- SET DIE="^PSX(552.1,"
- SET DA=REC
- SET DR="16////"_%_";18////"_$GET(PSXMSH)_$GET(PSXMSA)_";20////@"
- +1 DO ^DIE
- LOCK -^PSX(552.1,REC)
- KILL DIE,REC
- SET DIK="^PSX(552.1,"
- DO IX^DIK
- KILL DA,DIK
- +2 SET LOG(1)="Transmission # "_PSXB_" finished downloading."
- DO LOG^PSXUTL
- +3 SET $PIECE(^PSX(554,1,0),"^",2)=PSXB
- +4 DO ACK^PSXNOTE
- +5 QUIT
- HDR DO TSOUT^PSXUTL
- +1 SET PSXBLK=1
- SET PSXBHS=0
- SET LOG(1)="Downloading Transmission # "_PSXB
- DO LOG^PSXUTL
- +2 ;S $P(^PSX(552.1,PSXDA,0),"^",2)=7
- +3 SET PSXTXT="BHS|^~\&|DHCP||"_$SELECT($GET(PSXVNDR)>0:"SI BAKER",1:"ELECTROCOM")_"||"_PSXTS_"||ORM|"_PSXB_"|P|2.1|"
- SET PSXLAST=0
- DO XMIT
- if $GET(PSXPOP)
- GOTO ^PSXJOB
- +4 SET PSXBLK=PSXBLK+1
- +5 SET REC=PSXDA
- SET PSXMSGID=PSXB
- +6 FOR CNT=0:0
- SET CNT=$ORDER(^PSX(552.1,REC,"S",CNT))
- if CNT'>0
- QUIT
- SET PSXBLK=(CNT#8)+1
- SET PSXTXT=$GET(^PSX(552.1,REC,"S",CNT,0))
- SET PSXLAST=$SELECT($ORDER(^PSX(552.1,REC,"S",CNT)):0,1:1)
- if PSXBLK>7
- SET PSXBLK=0
- DO XMIT
- if $GET(PSXPOP)
- GOTO ^PSXJOB
- +7 WRITE *EOT,*TERM
- +8 DO EN^PSXACK
- if $GET(PSXBHS)>0
- KILL XTRY
- if PSXBHS=1
- GOTO BID1^PSXMST
- +9 SET XTRY=$GET(XTRY)+1
- SET LOG(1)="Batch Header Rejected by Vendor for Transmission "_$GET(PSXB)
- DO LOG^PSXUTL
- if $GET(XTRY)'>5
- GOTO ^PSXJOB
- +10 IF $GET(XTRY)>5
- SET LOG(1)="Batch Header for transmission "_$GET(PSXB)_" rejected max times."
- SET LOG(2)="DHCP Stopping interface."
- DO LOG^PSXUTL
- GOTO STOP^PSXJOB
- +11 QUIT
- GETTXT FOR I=0:0
- SET I=$ORDER(^PSX(552.2,PSXQN,"T",I))
- if 'I
- QUIT
- KILL PSXTXT
- SET PSXBLK=I#8
- SET PSXTXTN=I
- SET PSXTXT=$GET(^(PSXTXTN,0))
- SET PSXLAST=$SELECT($ORDER(^PSX(552.2,PSXQN,"T",I)):0,1:1)
- if PSXTXT=""
- QUIT
- DO XMIT
- if PSXPOP
- QUIT
- +1 QUIT
- XMIT SET (PSXPOP,PSXTRYN)=0
- +1 SET PSXLEN=$LENGTH(PSXTXT)
- +2 SET PSXLEN=$EXTRACT("00000",1,5-$LENGTH(PSXLEN))_PSXLEN
- +3 SET PSXTXT=PSXBLK_PSXLEN_PSXTXT_$SELECT(PSXLAST:$CHAR(ETX),1:$CHAR(ETB))
- +4 ;Get 2 byte hex Csum
- +5 SET X=PSXTXT
- XECUTE ^%ZOSF("LPC")
- SET PSXHEX=Y
- DO HEX^PSXUTL
- +6 SET PSXTXT=$CHAR(STX)_PSXTXT_PSXHEX_$CHAR(TERM)
- RETRY WRITE PSXTXT
- +1 SET PSXBLK=$ASCII(PSXBLK)
- TRY ;look for ACK or NAK
- READ *X:PSXDLTA
- IF '$TEST
- DO SND1
- GOTO ERROR
- +1 IF X=ACK
- READ *X:PSXDLTA
- if ('$TEST)!(X'=PSXBLK)
- DO SND2
- if ('$TEST)!(X'=PSXBLK)
- GOTO ERROR
- READ *X:PSXDLTA
- if ('$TEST)!(X'=TERM)
- DO SND9
- if ('$TEST)!(X'=TERM)
- GOTO ERROR
- QUIT
- +2 IF X=NAK
- READ *X:PSXDLTA
- if ('$TEST)!(X'=TERM)
- DO SND3
- DO SND4
- GOTO ERROR
- +3 IF X=EOT
- READ *X:PSXDLTA
- if ('$TEST)!(X'=TERM)
- DO SND5
- DO SND7
- if ('$TEST)!(X'=TERM)
- GOTO ERROR
- SET PSXTRYN=9999
- GOTO ERROR
- +4 DO SND6
- ERROR DO FLUSH1^PSXUTL
- DO LOG^PSXUTL
- +1 SET PSXTRYN=PSXTRYN+1
- +2 SET PSXBLK=$CHAR(PSXBLK)
- +3 if PSXTRYN'>PSXTRYL
- GOTO RETRY
- +4 SET PSXPOP=1
- +5 QUIT
- SND1 KILL LOG
- SET LOG(1)="SND1 Timer A timeout after sending a line of text."_$GET(PSXBLK)
- QUIT
- SND2 KILL LOG
- SET LOG(1)="SND2 ACK Received with bad block number after sending line of text, ASCII ("_$GET(X)_") "_X
- +1 SET LOG(2)="Expected ASCII ("_$GET(PSXBLK)_")."
- QUIT
- SND3 KILL LOG
- SET LOG(1)="SND3 NAK Received with no terminator after sending a line of text."
- QUIT
- SND4 KILL LOG
- SET LOG(1)="SND4 NAK Received after sending a line of text."
- QUIT
- SND5 KILL LOG
- SET LOG(1)="SND5 EOT Received with no terminator after sending a line of text."
- QUIT
- SND6 KILL LOG
- SET LOG(1)="SND6 Garbage received after sending a line of text. ("_X_")"
- QUIT
- SND7 KILL LOG
- SET LOG(1)="SND7 EOT Received, aborting send."
- QUIT
- SND8 KILL LOG
- SET LOG(1)="SND8 Aborting Send. Error processing order # "_$PIECE($GET(^PSX(552.2,PSXQN,0)),"^",1)_". Text: "_PSXTXT
- QUIT
- SND9 KILL LOG
- SET LOG(1)="SND9 ACK,"_$GET(PSXBLK)_" received with no terminator after sending"
- SET LOG(2)="a line of text."
- QUIT