- INHUSEQ2 ;DGH; 13 Jan 95 09:22;More SEQuence number protocol functions
- ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
- ;COPYRIGHT 1991-2000 SAIC
- ;
- ;Following functions are used when CHCS is originiating system for
- ;sequence number protocol. Originiating system need only send
- ;a message containing an MSH segment to initiate or to resynch
- ;the link.
- INIT ;This entry point initializes seq. no. protocol. It creates
- ;a MSH with MSH-9 =0. It is called from a menu option.
- N INSEQ,SRC
- S INSEQ=0,SRC="Initialization message"
- D DEST Q
- ;
- SYNCH ;This entry point resynches the link. It creates a MSH with
- ;MSH-9 = -1. It is called from a menu option.
- N INSEQ,SRC
- S INSEQ=-1,SRC="Re-synchronization message"
- D DEST Q
- ;
- DEST ;Prompt for background process. The process must be inactive and
- ;must have a destination. Seq. No. Protocol is by destination.
- N DIC,X,Y,DEST,TT,DXS,ING,INUIF,MSH,INDELIM,INSUBDEL,INSUBCOM,BP,INREP,MSG,DST
- S DIC=4004,DIC(0)="AEZ",DIC("S")="I $P(^(0),U,7)" D ^DIC Q:Y<1
- S BP=+Y I $D(^INRHB("RUN","SRVR",BP)) S MSG="This process is active. You must shut this job down before proceeding." D DISP Q
- S DST=$P(Y(0),U,7) I '$D(^INRHD(DST)) S MSG="Destination does not exist" D DISP Q
- S DEST=$P(^INRHD(DST,0),U)
- ;Create MSH segment !!NOTE that MESSAGE TYPE field is null.
- S MESSID=$$MESSID^INHD
- S INDELIM=$$FIELD^INHUT(),INSUBDEL=$$COMP^INHUT(),INSUBCOM=$$SUBCOMP^INHUT(),INREP=$$REP^INHUT()
- S ING="INDATA"
- S MSH="MSH"_INDELIM_INSUBDEL_INREP_"~"_INSUBCOM
- S DXS="N X1 S %=$P($H,"","",2) S:%<60 %=60 S:$G(X)'=""S"" %=%\60*60 S:$G(X)=""H"" %=%\3600*3600 S X=DT_(%\60#60/100+(%\3600)+(%#60/10000)/100) S X=X,Y(1)=$G(X) S X=""TS"""
- N Y,X1 X DXS S X1=Y(1) S X=$$TRX^INHSG(X1,X,"O") S L1=X
- S $P(MSH,U,7)=L1,$P(MSH,U,10)=MESSID,$P(MSH,U,13)=INSEQ,$P(MSH,U,15)="AL"
- S @ING@(1)=MSH
- ;create entry in UIF, but don't set in output queue
- S INUIF=$$NEW^INHD(MESSID,DEST,SRC,ING,0,"O",1)
- I INUIF<0 N INSTERR S INSTERR="",MSG="Error creating entry in UIF" D ERROR^INHS("UIF creation failed in routine ^INHUSEQ2",2),DISP Q
- ;set into destination queue (required for sequence # protocol)
- S X=$$DSTQUE^INHUSEN3(INUIF,.INERR)
- I X S MSG="Error creating entry in queue" D ENT^INHE(INUIF,DEST,.INERR),DISP Q
- ;Now that entry is in "BP" queue, start background process
- S X=$$A^INHB(BP)
- I 'X S MSG="Background process failed to start" D DISP Q
- Q
- ;
- DISP ;Display message to user
- W !?5,MSG S X=$$CR^INHU1 Q
- ;
- ;following functions are called from other routines
- SEQ(GBL,SEQ,INERR) ;Return Sequence number from MSH
- ;;;;THIS FUNCTION MAY NOT BE NEEDED
- ;INPUT
- ;--GBL = global being checked, can be ^INTHU
- ;--------If numeric, assumed to be IEN for ^INTHU
- ;--------If non-numeric, assumed to be global reference
- ;RETURN
- ;0=success 1=failure
- N LCT,X,SEQ
- S X=$$VERIF^INHUSEN(GBL,.INMSH)
- I X S ERR(1)="Message does not have the MSH segment in the correct location" Q 1
- S INDELIM=$E(INMSH,4)
- S SEQ=+$P(INMSH,INDELIM,13)
- Q 0
- ;
- ;
- EXPECT(GBL,EXPCT,STAT,ERR) ;Returns expected seq # and status from MSA
- ;INPUT
- ;--GBL = global being checked, can be ^INTHU
- ;--------If numeric, assumed to be IEN for ^INTHU
- ;--------If non-numeric, assumed to be global reference
- ;--EXPCT = Expected sequence #, MSA-5
- ;--STAT = Status, MSA-2
- ;--ERR = error message array
- ;RETURN
- ;0=success 1=error
- N MSA,MSH,LCT
- I GBL S LCT=0 D GETLINE^INHOU(GBL,.LCT,.MSH)
- I 'GBL S MSH=$G(@GBL@(1))
- I MSH'["MSH" S ERR(1)="Message does not have the MSH segment in the correct location" Q 1
- S INDELIM=$E(MSH,4)
- ;Check for MSA segment in line count subsequent to MSH
- I GBL D GETLINE^INHOU(GBL,.LCT,.MSA)
- I 'GBL S MSA=$G(@GBL@(2))
- I '$D(MSA) S ERR="Message does not have a MSA segment in the correct location" Q 1
- I MSA'["MSA" S ERR="Message does not have a MSA segment in the correct location" Q 1
- S STAT=$P(MSA,INDELIM,2),EXPCT=$P(MSA,INDELIM,5)
- Q 0
- ;
- REQUE(INDSTR,INSEND,INERR) ;Requeue previously sent messages
- ;INPUT:
- ;INDSTR = (REQ) Destination of backgroundprocess
- ;INSEND = (REQ) Array of messages in format INSEND(SEQ)=UIF
- ;INERR = (OPT) Variable for error messages (PBR)
- ;OUTPUT:
- ;0=success 1=error
- N SEQ,P,H,UIF
- ;For sequenced message, priority and time to process don't matter
- S (P,H)=0
- F I=1:1:5 L +^INLHDEST(INDSTR):5 Q:$T
- E S INERR="Unable to lock message queue ^INLHDEST("_$P(^INRHD(INDSTR,0),U)_") " Q 1
- S SEQ="" F S SEQ=$O(INSEND(SEQ)) Q:'SEQ D
- .S UIF=INSEND(SEQ)
- .S ^INLHDEST(INDSTR,P,H,UIF)=""
- L -^INLHDEST(INDSTR)
- Q 0
- INHUSEQ2 ;DGH; 13 Jan 95 09:22;More SEQuence number protocol functions
- +1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
- +2 ;COPYRIGHT 1991-2000 SAIC
- +3 ;
- +4 ;Following functions are used when CHCS is originiating system for
- +5 ;sequence number protocol. Originiating system need only send
- +6 ;a message containing an MSH segment to initiate or to resynch
- +7 ;the link.
- INIT ;This entry point initializes seq. no. protocol. It creates
- +1 ;a MSH with MSH-9 =0. It is called from a menu option.
- +2 NEW INSEQ,SRC
- +3 SET INSEQ=0
- SET SRC="Initialization message"
- +4 DO DEST
- QUIT
- +5 ;
- SYNCH ;This entry point resynches the link. It creates a MSH with
- +1 ;MSH-9 = -1. It is called from a menu option.
- +2 NEW INSEQ,SRC
- +3 SET INSEQ=-1
- SET SRC="Re-synchronization message"
- +4 DO DEST
- QUIT
- +5 ;
- DEST ;Prompt for background process. The process must be inactive and
- +1 ;must have a destination. Seq. No. Protocol is by destination.
- +2 NEW DIC,X,Y,DEST,TT,DXS,ING,INUIF,MSH,INDELIM,INSUBDEL,INSUBCOM,BP,INREP,MSG,DST
- +3 SET DIC=4004
- SET DIC(0)="AEZ"
- SET DIC("S")="I $P(^(0),U,7)"
- DO ^DIC
- IF Y<1
- QUIT
- +4 SET BP=+Y
- IF $DATA(^INRHB("RUN","SRVR",BP))
- SET MSG="This process is active. You must shut this job down before proceeding."
- DO DISP
- QUIT
- +5 SET DST=$PIECE(Y(0),U,7)
- IF '$DATA(^INRHD(DST))
- SET MSG="Destination does not exist"
- DO DISP
- QUIT
- +6 SET DEST=$PIECE(^INRHD(DST,0),U)
- +7 ;Create MSH segment !!NOTE that MESSAGE TYPE field is null.
- +8 SET MESSID=$$MESSID^INHD
- +9 SET INDELIM=$$FIELD^INHUT()
- SET INSUBDEL=$$COMP^INHUT()
- SET INSUBCOM=$$SUBCOMP^INHUT()
- SET INREP=$$REP^INHUT()
- +10 SET ING="INDATA"
- +11 SET MSH="MSH"_INDELIM_INSUBDEL_INREP_"~"_INSUBCOM
- +12 SET DXS="N X1 S %=$P($H,"","",2) S:%<60 %=60 S:$G(X)'=""S"" %=%\60*60 S:$G(X)=""H"" %=%\3600*3600 S X=DT_(%\60#60/100+(%\3600)+(%#60/10000)/100) S X=X,Y(1)=$G(X) S X=""TS"""
- +13 NEW Y,X1
- XECUTE DXS
- SET X1=Y(1)
- SET X=$$TRX^INHSG(X1,X,"O")
- SET L1=X
- +14 SET $PIECE(MSH,U,7)=L1
- SET $PIECE(MSH,U,10)=MESSID
- SET $PIECE(MSH,U,13)=INSEQ
- SET $PIECE(MSH,U,15)="AL"
- +15 SET @ING@(1)=MSH
- +16 ;create entry in UIF, but don't set in output queue
- +17 SET INUIF=$$NEW^INHD(MESSID,DEST,SRC,ING,0,"O",1)
- +18 IF INUIF<0
- NEW INSTERR
- SET INSTERR=""
- SET MSG="Error creating entry in UIF"
- DO ERROR^INHS("UIF creation failed in routine ^INHUSEQ2",2)
- DO DISP
- QUIT
- +19 ;set into destination queue (required for sequence # protocol)
- +20 SET X=$$DSTQUE^INHUSEN3(INUIF,.INERR)
- +21 IF X
- SET MSG="Error creating entry in queue"
- DO ENT^INHE(INUIF,DEST,.INERR)
- DO DISP
- QUIT
- +22 ;Now that entry is in "BP" queue, start background process
- +23 SET X=$$A^INHB(BP)
- +24 IF 'X
- SET MSG="Background process failed to start"
- DO DISP
- QUIT
- +25 QUIT
- +26 ;
- DISP ;Display message to user
- +1 WRITE !?5,MSG
- SET X=$$CR^INHU1
- QUIT
- +2 ;
- +3 ;following functions are called from other routines
- SEQ(GBL,SEQ,INERR) ;Return Sequence number from MSH
- +1 ;;;;THIS FUNCTION MAY NOT BE NEEDED
- +2 ;INPUT
- +3 ;--GBL = global being checked, can be ^INTHU
- +4 ;--------If numeric, assumed to be IEN for ^INTHU
- +5 ;--------If non-numeric, assumed to be global reference
- +6 ;RETURN
- +7 ;0=success 1=failure
- +8 NEW LCT,X,SEQ
- +9 SET X=$$VERIF^INHUSEN(GBL,.INMSH)
- +10 IF X
- SET ERR(1)="Message does not have the MSH segment in the correct location"
- QUIT 1
- +11 SET INDELIM=$EXTRACT(INMSH,4)
- +12 SET SEQ=+$PIECE(INMSH,INDELIM,13)
- +13 QUIT 0
- +14 ;
- +15 ;
- EXPECT(GBL,EXPCT,STAT,ERR) ;Returns expected seq # and status from MSA
- +1 ;INPUT
- +2 ;--GBL = global being checked, can be ^INTHU
- +3 ;--------If numeric, assumed to be IEN for ^INTHU
- +4 ;--------If non-numeric, assumed to be global reference
- +5 ;--EXPCT = Expected sequence #, MSA-5
- +6 ;--STAT = Status, MSA-2
- +7 ;--ERR = error message array
- +8 ;RETURN
- +9 ;0=success 1=error
- +10 NEW MSA,MSH,LCT
- +11 IF GBL
- SET LCT=0
- DO GETLINE^INHOU(GBL,.LCT,.MSH)
- +12 IF 'GBL
- SET MSH=$GET(@GBL@(1))
- +13 IF MSH'["MSH"
- SET ERR(1)="Message does not have the MSH segment in the correct location"
- QUIT 1
- +14 SET INDELIM=$EXTRACT(MSH,4)
- +15 ;Check for MSA segment in line count subsequent to MSH
- +16 IF GBL
- DO GETLINE^INHOU(GBL,.LCT,.MSA)
- +17 IF 'GBL
- SET MSA=$GET(@GBL@(2))
- +18 IF '$DATA(MSA)
- SET ERR="Message does not have a MSA segment in the correct location"
- QUIT 1
- +19 IF MSA'["MSA"
- SET ERR="Message does not have a MSA segment in the correct location"
- QUIT 1
- +20 SET STAT=$PIECE(MSA,INDELIM,2)
- SET EXPCT=$PIECE(MSA,INDELIM,5)
- +21 QUIT 0
- +22 ;
- REQUE(INDSTR,INSEND,INERR) ;Requeue previously sent messages
- +1 ;INPUT:
- +2 ;INDSTR = (REQ) Destination of backgroundprocess
- +3 ;INSEND = (REQ) Array of messages in format INSEND(SEQ)=UIF
- +4 ;INERR = (OPT) Variable for error messages (PBR)
- +5 ;OUTPUT:
- +6 ;0=success 1=error
- +7 NEW SEQ,P,H,UIF
- +8 ;For sequenced message, priority and time to process don't matter
- +9 SET (P,H)=0
- +10 FOR I=1:1:5
- LOCK +^INLHDEST(INDSTR):5
- IF $TEST
- QUIT
- +11 IF '$TEST
- SET INERR="Unable to lock message queue ^INLHDEST("_$PIECE(^INRHD(INDSTR,0),U)_") "
- QUIT 1
- +12 SET SEQ=""
- FOR
- SET SEQ=$ORDER(INSEND(SEQ))
- IF 'SEQ
- QUIT
- Begin DoDot:1
- +13 SET UIF=INSEND(SEQ)
- +14 SET ^INLHDEST(INDSTR,P,H,UIF)=""
- End DoDot:1
- +15 LOCK -^INLHDEST(INDSTR)
- +16 QUIT 0