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

PSXYQRY.m

Go to the documentation of this file.
  1. PSXYQRY ;BIR/HTW-Dual Sends/Receives the Query ;[ 02/20/99 5:49 PM ]
  1. ;;2.0;CMOP;**17**;11 Apr 97
  1. EN I $P($G(^PSX(553,1,"Q")),"^")="S" S PSXSTOP=1 G TST
  1. D NOW^%DTC S XZ=$P(^PSX(553.1,0),"^",3),INT=$P(^PSX(553,1,0),"^",9) S:$G(INT)'>0 INT=1
  1. I $G(XZ) S LQRYTM=$P(^PSX(553.1,XZ,0),"^",2),NEXTQRY=$$FMADD^XLFDT(LQRYTM,0,INT,0,0)
  1. I %>NEXTQRY G EN1
  1. I %'>NEXTQRY H $$FMDIFF^XLFDT(%,LQRYTM,2)
  1. EN1 S (PSXCNT,PSXTRYN,RXCNT)=0,QLR=$P($G(^PSX(553,1,0)),"^",8)
  1. K DD,DO
  1. S (DA,X)=$P(^PSX(553.1,0),U,3)+1,DIC="^PSX(553.1,",DIC(0)="LZ",DIC("DR")="1////"_%_";4////1",DLAYGO=553.1
  1. F D FILE^DICN S PSXQRYID=+Y,LOG(1)="QUERY # "_PSXQRYID_" initiated."_$G(PSXQRYA) D LOG^PSXUTL
  1. I $P($G(^PSX(553,1,"Q")),"^")="S" S PSXSTOP=1 G TST
  1. K DA,DIC,DUOUT,DTOUT,DLAYGO,X,Y,%,DINUM,PSXPOP,TRY
  1. S PSXQRY=1 D BID G:$G(PSXQUIT) TST
  1. D TSOUT^PSXUTL
  1. S PSXBLK=1,PSXLAST=0
  1. S PSXTXT="MSH|^~\&|DHCP||"_$S($G(PSXVNDR)>1:"SI BAKER",$G(PSXVNDR)=1:"ELECTROCOM",1:"ELECTROCOM")_"||"_PSXTS_"||QRY|"_PSXQRYID_"|P|2.1|" D XMIT^PSXYSND G:$G(PSXPOP) TST
  1. S PSXBLK=2,PSXLAST=1 S PSXTXT="QRD|"_PSXTS_"|R|I|"_PSXQRYID_"|||"_QLR_"^ZO|OP|OTH|ALL" D XMIT^PSXYSND G:$G(PSXPOP) TST
  1. W *EOT,*TERM
  1. D SLAVE
  1. TST D FLUSH1^PSXUTL
  1. S LOG(1)="QUERY # "_$G(PSXQRYID)_" completed."_$G(PSXQRYA) S:$G(PSXSTOP) LOG(2)="DHCP STOPPED QUERY "_$G(PSXQRYID) S:$G(PSXQUIT) LOG(3)="No Response to Bid, DHCP terminated query." D LOG^PSXUTL
  1. S $P(^PSX(554,1,0),"^",3)=$G(PSXQRYID)
  1. K PSXHEX,PSXACK,LOG,BLK,BLKA,PSXQRYID,PSXTXT,PSXBLK,%,X,Y,PSXLAST,QLR,MESSID,MSGID,RXCNT,PSXQRY,PSXQRYA,PSXSTOP,PSXPOP,PSXQUIT
  1. S ZTREQ="@"
  1. G:$G(^PSX(553,1,"Q"))="S" STOP
  1. G EN
  1. NAK D FLUSH1^PSXUTL,LOG^PSXUTL
  1. W *NAK,*TERM
  1. S PSXTRYN=PSXTRYN+1 G:PSXTRYN>5 ERROR G MSG
  1. ND I $G(^PSX(553,1,"Q"))="S" S PSXSTOP=1 Q
  1. D QRY20^PSXYMSG,FLUSH1^PSXUTL,LOG^PSXUTL S PSXTRYN=PSXTRYN+1 G:PSXTRYN>5 ERROR G MSG
  1. RTN G:PSXCNT'>1 SLAVE
  1. Q:$G(PSXQRY)=0
  1. D BID G:$G(PSXQUIT) TST D TSOUT^PSXUTL K PSXTXT,PSXLAST S PSXBLK=1,PSXLAST=0
  1. S PSXTXT="MSH|^~\&|DHCP||"_$S($G(PSXVNDR)>0:"SI BAKER",1:"ELECTROCOM")_"||"_PSXTS_"||ACK|"_$G(MSGID)_"|P|2.1|" D XMIT^PSXYSND Q:$G(PSXPOP)
  1. S PSXBLK=2,PSXLAST=1
  1. S PSXTXT="MSA|"_$S(QRYFLG=0:"AA|"_$G(MSGID)_"|",QRYFLG>0:"AR|"_MSGID_"|"_$S(QRYFLG=1:"RX NUMBER",QRYFLG=2:"STATUS",QRYFLG=3:"COMPLETED DATE",QRYFLG=4:"EMPLOYEE ID",QRYFLG=5:"NO CANCELLED REASON",1:"UNKNOWN")) D XMIT^PSXYSND Q:$G(PSXPOP)
  1. I $G(QRYFLG)>0 S DR="1////1",DIE="^PSX(552.3," F I=2:1 S XX=$P(XDA,"^",I) Q:XX'>0 S DA=XX D ^DIE K DA
  1. I $G(QRYFLG)>0 K DA,DIE,DR
  1. W *EOT,*TERM
  1. D NOW^%DTC
  1. S $P(^PSX(553.1,PSXQRYID,0),"^",4)=%,$P(^PSX(553.1,PSXQRYID,0),"^",5)=5,$P(^PSX(553.1,PSXQRYID,0),"^",6)=$G(RXCNT)
  1. K MESSID,MSGID,TRY,CANFLAG
  1. I $G(^PSX(553,1,"Q"))="S" S PSXSTOP=1 Q
  1. SLAVE S BLKA=0
  1. R *X:PSXDLTD
  1. E D QRY1^PSXYMSG,LOG^PSXUTL G ND
  1. I X'=ENQ D QRY5^PSXYMSG S TRY=$G(TRY)+1 G:$G(TRY)'>5 SLAVE G ERROR
  1. R *X:PSXDLTA
  1. I ('$T)!(X'=TERM) D QRY14^PSXYMSG G ERROR
  1. W *ACK,0,*TERM
  1. R *X:PSXDLTD G:X=STX READ I X=EOT R *X:PSXDLTA Q:X=TERM
  1. MSG R *X:PSXDLTD E D QRY1^PSXYMSG,LOG^PSXUTL G ND
  1. I X=STX G READ
  1. I X=EOT R *X:PSXDLTA I X=TERM G RTN
  1. S QF="STX/EOT"
  1. D QRY5^PSXYMSG ;unexpected character received
  1. ERROR D FLUSH1^PSXUTL,LOG^PSXUTL S QRYPOP=1
  1. Q
  1. READ S PSXACK="" S PSXTMD=$P($H,",",2)
  1. GETMSG F %=1:1 D Q:'%
  1. .R *X:PSXDLTA E D QRY6^PSXYMSG,LOG^PSXUTL S %=0,X="" Q
  1. .D CHKD^PSXUTL I PSXTMOUT D QRY6^PSXYMSG,LOG^PSXUTL S %=0,X="" Q
  1. .I %>240 D QRY7^PSXYMSG,LOG^PSXUTL S %=0,X="" Q
  1. .S PSXACK=PSXACK_$C(X)
  1. .I (X=ETX)!(X=ETB) S %=0
  1. I X=ETX S PSXCNT=PSXCNT+1 G TEST
  1. I X=ETB G TEST
  1. I X=EOT R *X:PSXDLTA G:X=TERM MSG
  1. I (X'=ETX)!(X'=ETB)!(X'=EOT) D QRY8^PSXYMSG G NAK
  1. I PSXACK="" D QRY9^PSXYMSG G ERROR
  1. Q
  1. TEST R *X:PSXDLTA E D QRY10^PSXYMSG G ERROR
  1. I "0123456789ABCDEF"'[$C(X) D QRY11^PSXYMSG G NAK
  1. S PSXSUM=$C(X)
  1. CHKSUM R *X:PSXDLTA E D QRY10^PSXYMSG G ERROR
  1. I "0123456789ABCDEF"'[$C(X) D QRY11^PSXYMSG G NAK
  1. S PSXSUM=PSXSUM_$C(X)
  1. S X=PSXACK X ^%ZOSF("LPC") S PSXHEX=Y D HEX^PSXUTL
  1. R *X:1 I X'=TERM D QRY5^PSXYMSG
  1. I PSXHEX'=PSXSUM D QRY12^PSXYMSG G NAK
  1. I PSXHEX=PSXSUM D FLUSH1^PSXUTL
  1. S BLK=$E(PSXACK,1) I BLK>7 D QRY16^PSXYMSG G NAK
  1. I RXCNT=QLR&($E(PSXACK,7,10)'["BTS") D QRY19^PSXYMSG,LOG^PSXUTL W *EOT,*TERM Q
  1. I $E(PSXACK,7,10)["BTS|" S DA=PSXQRYID,PSXQRY=0,DIE="^PSX(553.1,",DR="4////1" S:RXCNT=0 PSXCNT=2 D ^DIE K DR,DA,DIE
  1. I $E(PSXACK,7,9)["MSA"&($P(PSXACK,"|",3)'=PSXQRYID) D QRY15^PSXYMSG G NAK
  1. I $E(PSXACK,7,9)["QRD"&($P(PSXACK,"|",5)'=PSXQRYID) D QRY15^PSXYMSG G NAK
  1. W *ACK,BLK,*TERM D FILE G MSG
  1. Q
  1. FILE I $E(PSXACK,7,10)["MSH|" S MESSID=$E(PSXACK,7,$L(PSXACK)-2),MSGID=$P(MESSID,"|",10),QRYFLG=0,XDA=""
  1. I $E(PSXACK,7,12)["NTE|99" D
  1. .S CANFLAG=0
  1. .S:($P($P(PSXACK,"\",1),"|",4)="")!($P($P(PSXACK,"\",1),"|",4)[" ") QRYFLG=1 Q:QRYFLG>0 S:"CACO"'[$P(PSXACK,"\F\",2) QRYFLG=2 S:$P(PSXACK,"\F\",2)["CA" CANFLAG=1 Q:QRYFLG>0
  1. .S:$P(PSXACK,"\F\",3)'?10.14N QRYFLG=3 Q:QRYFLG>0 S EMPID=$P(PSXACK,"\F\",5) S:$G(EMPID)="" QRYFLG=4 Q:QRYFLG>0 S:'$D(^XUSEC("PSXRPH",EMPID)) QRYFLG=4 Q:QRYFLG>0
  1. .I $G(EMPID)>0 N X,Y S DIC=200,DIC(0)="MNZ",X=EMPID D ^DIC K DIC S:$G(Y)<1 QRYFLG=4 K X,Y Q:QRYFLG>0
  1. .S RXCNT=RXCNT+1
  1. I $E(PSXACK,7,13)["NTE|100" S:($G(CANFLAG)>0&($P($P(PSXACK,"\",1),"|",4)="")) QRYFLG=5
  1. Q:BLK=BLKA
  1. Q:$G(QRYFLG)>0
  1. F1 L +^PSX(552.3,0):3 G:'$T F1 S NEW=$P(^PSX(552.3,0),"^",3)+1,$P(^PSX(552.3,0),"^",4)=$P(^PSX(552.3,0),"^",4)+1,$P(^PSX(552.3,0),"^",3)=NEW L -^PSX(552.3,0)
  1. G:$D(^PSX(552.3,NEW,0)) F1
  1. F2 L +^PSX(552.3,NEW):3 G:'$T F2 S ^PSX(552.3,NEW,0)=$E(PSXACK,7,$L(PSXACK)-2),^PSX(552.3,NEW,1)=2,^PSX(552.3,"AQ",NEW)="" L -^PSX(552.3,NEW) S XDA=$G(XDA)_"^"_NEW K NEW
  1. S BLKA=BLK
  1. Q
  1. XMIT S (PSXPOP,PSXTRYN)=0
  1. S PSXLEN=$L(PSXTXT)
  1. S PSXLEN=$E("00000",1,5-$L(PSXLEN))_PSXLEN
  1. S PSXTXT=PSXBLK_PSXLEN_PSXTXT_$S(PSXLAST:$C(ETX),1:$C(ETB))
  1. ;Get 2 byte hex Csum
  1. S X=PSXTXT X ^%ZOSF("LPC") S PSXHEX=Y D HEX^PSXUTL
  1. S PSXTXT=$C(STX)_PSXTXT_PSXHEX_$C(TERM)
  1. RETRY W PSXTXT
  1. S PSXBLK=$A(PSXBLK)
  1. TRY R *X:PSXDLTA E D SND1 G ERROR1 ;look for ACK or NAK
  1. I X=ACK R *X:PSXDLTA D:('$T)!(X'=PSXBLK) SND2 G:('$T)!(X'=PSXBLK) ERROR1 R *X:PSXDLTA D:('$T)!(X'=TERM) SND9 G:('$T)!(X'=TERM) ERROR1 Q
  1. I X=NAK R *X:PSXDLTA D:('$T)!(X'=TERM) SND3 D SND4 G ERROR1
  1. I X=EOT R *X:PSXDLTA D:('$T)!(X'=TERM) SND5 D SND7 G:('$T)!(X'=TERM) ERROR1 S PSXTRYN=9999 G ERROR1
  1. D SND6
  1. ERROR1 D FLUSH1^PSXUTL,LOG^PSXUTL
  1. S PSXTRYN=PSXTRYN+1
  1. S PSXBLK=$C(PSXBLK)
  1. G:PSXTRYN'>PSXTRYL RETRY
  1. S PSXPOP=1
  1. Q
  1. BID ;Set line bid retry counter
  1. S PSXTRY=0
  1. BID1 G:$P($G(^PSX(553,1,"Q")),"^")="S" STOP
  1. S PSXTME=$P($H,",",2)
  1. U IO
  1. W *ENQ,*TERM
  1. BID2 R *X:PSXDLTA E D MST6^PSXYMSG G BAD
  1. I X=EOT R *X:PSXDLTA G:X=TERM BID2
  1. I X=ENQ R *X:PSXDLTA D:'$T!(X'=TERM) MST1^PSXYMSG G:'$T!(X'=TERM) BAD S PSXTME=$P($H,",",2) S PSXTRY=PSXTRY+1 G:PSXTRY>PSXTRYM BAD D MST7^PSXYMSG,LOG^PSXUTL G BID2 ;ENQ received
  1. I X=NAK R *X:PSXDLTA D:'$T!(X'=TERM) MST2^PSXYMSG G:'$T!(X'=TERM) BAD D MST5^PSXYMSG,LOG^PSXUTL G BAD
  1. I X=ACK R *X:PSXDLTA D:'$T!(X'=48) MST3^PSXYMSG G:'$T!(X'=48) BAD R *X:PSXDLTA D:'$T!(X'=TERM) MST8^PSXYMSG G:($G(X)=TERM) OKAY
  1. D MST4^PSXYMSG ;if X wasn't ENQ or ACK or NAK then garbage
  1. BAD S PSXTRY=PSXTRY+1 D FLUSH1^PSXUTL,LOG^PSXUTL G:PSXTRY'>PSXTRYM BID1
  1. ;STOP interface if bid fails more that M times
  1. D MST9^PSXYMSG,LOG^PSXUTL,SETPAR^PSXYSTRT
  1. S PSXQUIT=1
  1. ;Hibernate awhile till CMOP comes on line,then try again
  1. H 45
  1. G ^PSXJOB
  1. OKAY ;Bid for Master was succesful
  1. S PSXTME=$P($H,",",2)
  1. ;Quit if Status is Stopped
  1. G:^PSX(553,1,"Q")="S" STOP
  1. Q
  1. STOP K LOG S LOG(1)="Stop Query interface request detected from DHCP."
  1. D LOG^PSXUTL
  1. K LOG,PSXONE S LOG(1)="Stopping the Query interface now!"
  1. D ^%ZISC S ZTREQ="@"
  1. D LOG^PSXUTL
  1. W "Done!"
  1. Q
  1. SND1 K LOG S LOG(1)="SND1 Timer A timeout after sending a line of text."_$G(PSXBLK) Q
  1. SND2 K LOG S LOG(1)="SND2 ACK Received with bad block number after sending line of text, ASCII ("_$G(X)_") "_X
  1. S LOG(2)="Expected ASCII ("_$G(PSXBLK)_")." Q
  1. SND3 K LOG S LOG(1)="SND3 NAK Received with no terminator after sending a line of text." Q
  1. SND4 K LOG S LOG(1)="SND4 NAK Received after sending a line of text." Q
  1. SND5 K LOG S LOG(1)="SND5 EOT Received with no terminator after sending a line of text." Q
  1. SND6 K LOG S LOG(1)="SND6 Garbage received after sending a line of text. ("_X_")" Q
  1. SND7 K LOG S LOG(1)="SND7 EOT Received, aborting send." Q
  1. SND8 K LOG S LOG(1)="SND8 Aborting Send. Error processing order # "_$P($G(^PSX(552.2,PSXQN,0)),"^",1)_". Text: "_PSXTXT Q
  1. SND9 K LOG S LOG(1)="SND9 ACK,"_$G(PSXBLK)_" received with no terminator after sending",LOG(2)="a line of text." Q