HLCS1.m

HLCS1 ;ALB/JRP - OPTIONS FOR BACKGROUND FILERS ;10/15/98  10:44

 ;;1.6;HEALTH LEVEL SEVEN;**19**;Oct 13, 1995

 ;

STARTDEF ;Entry point used by OPTION file to task default number of each filer

 N PTRMAIN,ONENODE,DEFCNT,CURCNT,LOOP

 ;Get entry in HL COMMUNICATION SERVER PARAMETER file (#869.3)

 S PTRMAIN=+$O(^HLCS(869.3,0))

 I ('PTRMAIN) D  Q

 .W $C(7)

 .W !!,"Entry in HL COMMUNICATION SERVER PARAMETER file (#869.3) has"

 .W !,"not been made.  Entry must be made in order to start execute"

 .W !,"this option.",!!

 ;Get zero node of parameter file

 S ONENODE=$G(^HLCS(869.3,PTRMAIN,1))

 ;Get default number of incoming filers (piece 1 of node 1)

 S DEFCNT=+$P(ONENODE,"^",1)

 I ('DEFCNT) D

 .;No default value found

 .S DEFCNT=1

 .W $C(7)

 .W !!,"Default number of incoming servers has not been entered into"

 .W !,"the HL COMMUNICATION SERVER PARAMETER file (#869.3).  Will use"

 .W !,"a value of ",DEFCNT,".",!!

 ;Get current number of incoming filers running

 S CURCNT=$$CNTFLR^HLCSUTL2("IN")

 I ((CURCNT>DEFCNT)!(CURCNT=DEFCNT)) D

 .;No more incoming filers needed

 .W $C(7)

 .W !!,"Default number of incoming servers is set to ",DEFCNT," and"

 .W !,CURCNT," incoming servers are currently running.  No more"

 .W !,"incoming servers will be started.",!!

 I (CURCNT<DEFCNT) D

 .;Start DEFCNT-CURCNT incoming filers

 .F LOOP=1:1:(DEFCNT-CURCNT) D STARTIN

 W !

 ;Get default number of outgoing filers (piece 2 of node 1)

 S DEFCNT=+$P(ONENODE,"^",2)

 I ('DEFCNT) D

 .;No default value found

 .S DEFCNT=1

 .W $C(7)

 .W !!,"Default number of outgoing servers has not been entered into"

 .W !,"the HL COMMUNICATION SERVER PARAMETER file (#869.3).  Will use"

 .W !,"a value of ",DEFCNT,".",!!

 ;Get current number of outgoing filers running

 S CURCNT=$$CNTFLR^HLCSUTL2("OUT")

 I ((CURCNT>DEFCNT)!(CURCNT=DEFCNT)) D

 .;No more outgoing filers needed

 .W $C(7)

 .W !!,"Default number of outgoing servers is set to ",DEFCNT," and"

 .W !,CURCNT," outgoing servers are currently running.  No more"

 .W !,"outgoing servers will be started.",!!

 I (CURCNT<DEFCNT) D

 .;Start DEFCNT-CURCNT outgoing filers

 .F LOOP=1:1:(DEFCNT-CURCNT) D STARTOUT

 W !

 Q

STARTIN ;Entry point used by OPTION file to task an incoming filer

 N TASKNUM

 S TASKNUM=$$TASKFLR("IN")

 W:(TASKNUM) !,"Incoming filer queued as task number ",TASKNUM

 W:('TASKNUM) $C(7),!!,"Unable to queue incoming filer"

 Q

STARTOUT ;Entry point used by OPTION file to task an outgoing filer

 N TASKNUM

 S TASKNUM=$$TASKFLR("OUT")

 W:(TASKNUM) !,"Outgoing filer queued as task number ",TASKNUM

 W:('TASKNUM) $C(7),!!,"Unable to queue outgoing filer"

 Q

STOPIN ;Entry point used by OPTION file to stop an incoming filer

 N PTRSUB,FLRLST

 ;Get list of filers

 D GETFLRS^HLCSUTL2("IN","FLRLST")

 ;No filers running

 I ('$D(FLRLST)) W $C(7),!!,"No incoming filers are running",!! Q

 ;Get first filer out of list

 S PTRSUB=+$O(FLRLST(0))

 I ('PTRSUB) W $C(7),!!,"No incoming filers are running",!! Q

 ;Stop incoming filer

 D STOPFLR^HLCSUTL1(PTRSUB,"IN")

 W !!,"Incoming filer queued as task number ",+FLRLST(PTRSUB)," has been asked to stop",!!

 Q

STOPOUT ;Entry point used by OPTION file to stop an outgoing filer

 N PTRSUB,FLRLST

 ;Get list of filers

 D GETFLRS^HLCSUTL2("OUT","FLRLST")

 ;No filers running

 I ('$D(FLRLST)) W $C(7),!!,"No outgoing filers are running",!! Q

 ;Get first filer out of list

 S PTRSUB=+$O(FLRLST(0))

 I ('PTRSUB) W $C(7),!!,"No outgoing filers are running",!! Q

 ;Stop filer

 D STOPFLR^HLCSUTL1(PTRSUB,"OUT")

 W !!,"Outgoing filer queued as task number ",+FLRLST(PTRSUB)," has been asked to stop",!!

 Q

STOPAIN ;Entry point used by OPTION file to stop all incoming filers

 N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT

 ;Make sure user wants to stop all filers

 S DIR(0)="YA"

 S DIR("A")="Are you sure you want to stop all incoming filers ? "

 S DIR("B")="NO"

 S DIR("?",1)="Stopping all incoming filers will prevent messages being"

 S DIR("?",2)="received through Logical Links from being passed to the"

 S DIR("?",3)="appropriate application.  Answer 'YES' if you really want"

 S DIR("?")="this to occur."

 W !!

 D ^DIR

 I (($D(DIRUT))!('$G(Y))) W !!,"Incoming filers will not be stopped",!! Q

 ;Stop all filers

 W !!,"Please wait while all incoming filers are asked to stop ..."

 D STOPALL("IN")

 W !,"All incoming filers have been asked to stop",!!

 Q

STOPAOUT ;Entry point used by OPTION file to stop all outgoing filers

 N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT

 ;Make sure user wants to stop all filers

 S DIR(0)="YA"

 S DIR("A")="Are you sure you want to stop all outgoing filers ? "

 S DIR("B")="NO"

 S DIR("?",1)="Stopping all outgoing filers will prevent messages from"

 S DIR("?",2)="being transmitted to external systems through Logical"

 S DIR("?")="Links.  Answer 'YES' if you really want this to occur."

 W !!

 D ^DIR

 I (($D(DIRUT))!('$G(Y))) W !!,"Outgoing filers will not be stopped",!! Q

 ;Stop all filers

 W !!,"Please wait while all outgoing filers are asked to stop ..."

 D STOPALL("OUT")

 W !,"All outgoing filers have been asked to stop",!!

 Q

TASKFLR(FLRTYPE) ;Task an incoming/outgoing filer

 ;INPUT  : FLRTYPE - Flag denote type of filer to start

 ;                   IN - Incoming filer (default)

 ;                   OUT - Outgoing filer

 ;OUTPUT : ZTSK (results of call to TaskMan)

 ;

 ;Check input

 S FLRTYPE=$G(FLRTYPE)

 ;Declare variables

 N ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK,TMP

 S ZTIO=""

 S ZTDTH=$H

 ;Task incoming filer

 S ZTRTN="STARTIN^HLCSIN"

 S ZTDESC="HL7 Incoming Filer"

 ;Task outgoing filer

 I (FLRTYPE="OUT") D

 .S ZTRTN="STARTOUT^HLCSOUT"

 .S ZTDESC="HL7 Outgoing Filer"

 ;Call TaskMan

 S ZTSK=0

 D ^%ZTLOAD

 S ZTSK=+$G(ZTSK)

 ;Not tasked

 Q:('ZTSK)

 ;Create entry in HL COMMUNICATION SERVER PARAMETER file

 S TMP=$$CRTFLR^HLCSUTL1(ZTSK,FLRTYPE)

 ;Return task number

 Q ZTSK

STOPALL(FLRTYPE) ;Stop all incoming/outgoing filers

 ;INPUT  : FLRTYPE - Flag denote type of filer to start

 ;                   IN - Incoming filer (default)

 ;                   OUT - Outgoing filer

 ;OUTPUT : None

 ;

 ;Check input

 S FLRTYPE=$G(FLRTYPE)

 S:((FLRTYPE'="OUT")&(FLRTYPE'="IN")) FLRTYPE="IN"

 ;Declare variables

 N PTRSUB,FLRLST

 ;Get list of filers

 D GETFLRS^HLCSUTL2(FLRTYPE,"FLRLST")

 ;No filers running

 Q:('$D(FLRLST))

 ;Loop through list of filers, stopping each

 S PTRSUB=0

 F  S PTRSUB=+$O(FLRLST(PTRSUB)) Q:('PTRSUB)  D STOPFLR^HLCSUTL1(PTRSUB,FLRTYPE)

 Q

EDITPRAM ;Entry point used by OPTION file to edit file 869.3

 ;Declare variables

 N DIC,X,Y,DTOUT,DUOUT,DLAYGO,DIE,DA,DR

 ;Create/find entry HL COMMUNICATION SERVER PARAMETER file (#869.3)

 S DLAYGO=869.3

 S DIC="^HLCS(869.3,"

 S DIC(0)="L"

 S DIC("DR")="11///1;12///1"

 S X=1

 D ^DIC

 ;Error

 I (Y="-1") D  Q

 .W !!,"Unable to create/find entry in HL COMMUNICATION SERVER"

 .W !,"PARAMETER file (#869.3).  Entry must exist in order for"

 .W !,"the incoming & outgoing filers to run.  Use FileMan to"

 .W !,"create an initial entry for editing.",!!

 ;Entry created

 I ($P(Y,"^",3)) D

 .;Tell user entry was created

 .W !!,"Initial entry in HL COMMUNICATION SERVER PARAMETER file"

 .W !,"(#869.3) has been created.",!

 ;Edit parameters

 S DIE="^HLCS(869.3,"

 S DA=+Y

 S DR="11Default number of incoming filers;12Default number of outgoing filers"

 D ^DIE

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---HLCS1   7420     printed  Feb 18, 2025@23:22:42                                                                                                                                                                                                       Page 2

HLCS1     ;ALB/JRP - OPTIONS FOR BACKGROUND FILERS ;10/15/98  10:44

 +1       ;;1.6;HEALTH LEVEL SEVEN;**19**;Oct 13, 1995

 +2       ;

STARTDEF  ;Entry point used by OPTION file to task default number of each filer

 +1        NEW PTRMAIN,ONENODE,DEFCNT,CURCNT,LOOP

 +2       ;Get entry in HL COMMUNICATION SERVER PARAMETER file (#869.3)

 +3        SET PTRMAIN=+$ORDER(^HLCS(869.3,0))

 +4        IF ('PTRMAIN)

               Begin DoDot:1

 +5                WRITE $CHAR(7)

 +6                WRITE !!,"Entry in HL COMMUNICATION SERVER PARAMETER file (#869.3) has"

 +7                WRITE !,"not been made.  Entry must be made in order to start execute"

 +8                WRITE !,"this option.",!!

               End DoDot:1

               QUIT 

 +9       ;Get zero node of parameter file

 +10       SET ONENODE=$GET(^HLCS(869.3,PTRMAIN,1))

 +11      ;Get default number of incoming filers (piece 1 of node 1)

 +12       SET DEFCNT=+$PIECE(ONENODE,"^",1)

 +13       IF ('DEFCNT)

               Begin DoDot:1

 +14      ;No default value found

 +15               SET DEFCNT=1

 +16               WRITE $CHAR(7)

 +17               WRITE !!,"Default number of incoming servers has not been entered into"

 +18               WRITE !,"the HL COMMUNICATION SERVER PARAMETER file (#869.3).  Will use"

 +19               WRITE !,"a value of ",DEFCNT,".",!!

               End DoDot:1

 +20      ;Get current number of incoming filers running

 +21       SET CURCNT=$$CNTFLR^HLCSUTL2("IN")

 +22       IF ((CURCNT>DEFCNT)!(CURCNT=DEFCNT))

               Begin DoDot:1

 +23      ;No more incoming filers needed

 +24               WRITE $CHAR(7)

 +25               WRITE !!,"Default number of incoming servers is set to ",DEFCNT," and"

 +26               WRITE !,CURCNT," incoming servers are currently running.  No more"

 +27               WRITE !,"incoming servers will be started.",!!

               End DoDot:1

 +28       IF (CURCNT<DEFCNT)

               Begin DoDot:1

 +29      ;Start DEFCNT-CURCNT incoming filers

 +30               FOR LOOP=1:1:(DEFCNT-CURCNT)

                       DO STARTIN

               End DoDot:1

 +31       WRITE !

 +32      ;Get default number of outgoing filers (piece 2 of node 1)

 +33       SET DEFCNT=+$PIECE(ONENODE,"^",2)

 +34       IF ('DEFCNT)

               Begin DoDot:1

 +35      ;No default value found

 +36               SET DEFCNT=1

 +37               WRITE $CHAR(7)

 +38               WRITE !!,"Default number of outgoing servers has not been entered into"

 +39               WRITE !,"the HL COMMUNICATION SERVER PARAMETER file (#869.3).  Will use"

 +40               WRITE !,"a value of ",DEFCNT,".",!!

               End DoDot:1

 +41      ;Get current number of outgoing filers running

 +42       SET CURCNT=$$CNTFLR^HLCSUTL2("OUT")

 +43       IF ((CURCNT>DEFCNT)!(CURCNT=DEFCNT))

               Begin DoDot:1

 +44      ;No more outgoing filers needed

 +45               WRITE $CHAR(7)

 +46               WRITE !!,"Default number of outgoing servers is set to ",DEFCNT," and"

 +47               WRITE !,CURCNT," outgoing servers are currently running.  No more"

 +48               WRITE !,"outgoing servers will be started.",!!

               End DoDot:1

 +49       IF (CURCNT<DEFCNT)

               Begin DoDot:1

 +50      ;Start DEFCNT-CURCNT outgoing filers

 +51               FOR LOOP=1:1:(DEFCNT-CURCNT)

                       DO STARTOUT

               End DoDot:1

 +52       WRITE !

 +53       QUIT 

STARTIN   ;Entry point used by OPTION file to task an incoming filer

 +1        NEW TASKNUM

 +2        SET TASKNUM=$$TASKFLR("IN")

 +3        if (TASKNUM)

               WRITE !,"Incoming filer queued as task number ",TASKNUM

 +4        if ('TASKNUM)

               WRITE $CHAR(7),!!,"Unable to queue incoming filer"

 +5        QUIT 

STARTOUT  ;Entry point used by OPTION file to task an outgoing filer

 +1        NEW TASKNUM

 +2        SET TASKNUM=$$TASKFLR("OUT")

 +3        if (TASKNUM)

               WRITE !,"Outgoing filer queued as task number ",TASKNUM

 +4        if ('TASKNUM)

               WRITE $CHAR(7),!!,"Unable to queue outgoing filer"

 +5        QUIT 

STOPIN    ;Entry point used by OPTION file to stop an incoming filer

 +1        NEW PTRSUB,FLRLST

 +2       ;Get list of filers

 +3        DO GETFLRS^HLCSUTL2("IN","FLRLST")

 +4       ;No filers running

 +5        IF ('$DATA(FLRLST))

               WRITE $CHAR(7),!!,"No incoming filers are running",!!

               QUIT 

 +6       ;Get first filer out of list

 +7        SET PTRSUB=+$ORDER(FLRLST(0))

 +8        IF ('PTRSUB)

               WRITE $CHAR(7),!!,"No incoming filers are running",!!

               QUIT 

 +9       ;Stop incoming filer

 +10       DO STOPFLR^HLCSUTL1(PTRSUB,"IN")

 +11       WRITE !!,"Incoming filer queued as task number ",+FLRLST(PTRSUB)," has been asked to stop",!!

 +12       QUIT 

STOPOUT   ;Entry point used by OPTION file to stop an outgoing filer

 +1        NEW PTRSUB,FLRLST

 +2       ;Get list of filers

 +3        DO GETFLRS^HLCSUTL2("OUT","FLRLST")

 +4       ;No filers running

 +5        IF ('$DATA(FLRLST))

               WRITE $CHAR(7),!!,"No outgoing filers are running",!!

               QUIT 

 +6       ;Get first filer out of list

 +7        SET PTRSUB=+$ORDER(FLRLST(0))

 +8        IF ('PTRSUB)

               WRITE $CHAR(7),!!,"No outgoing filers are running",!!

               QUIT 

 +9       ;Stop filer

 +10       DO STOPFLR^HLCSUTL1(PTRSUB,"OUT")

 +11       WRITE !!,"Outgoing filer queued as task number ",+FLRLST(PTRSUB)," has been asked to stop",!!

 +12       QUIT 

STOPAIN   ;Entry point used by OPTION file to stop all incoming filers

 +1        NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT

 +2       ;Make sure user wants to stop all filers

 +3        SET DIR(0)="YA"

 +4        SET DIR("A")="Are you sure you want to stop all incoming filers ? "

 +5        SET DIR("B")="NO"

 +6        SET DIR("?",1)="Stopping all incoming filers will prevent messages being"

 +7        SET DIR("?",2)="received through Logical Links from being passed to the"

 +8        SET DIR("?",3)="appropriate application.  Answer 'YES' if you really want"

 +9        SET DIR("?")="this to occur."

 +10       WRITE !!

 +11       DO ^DIR

 +12       IF (($DATA(DIRUT))!('$GET(Y)))

               WRITE !!,"Incoming filers will not be stopped",!!

               QUIT 

 +13      ;Stop all filers

 +14       WRITE !!,"Please wait while all incoming filers are asked to stop ..."

 +15       DO STOPALL("IN")

 +16       WRITE !,"All incoming filers have been asked to stop",!!

 +17       QUIT 

STOPAOUT  ;Entry point used by OPTION file to stop all outgoing filers

 +1        NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT

 +2       ;Make sure user wants to stop all filers

 +3        SET DIR(0)="YA"

 +4        SET DIR("A")="Are you sure you want to stop all outgoing filers ? "

 +5        SET DIR("B")="NO"

 +6        SET DIR("?",1)="Stopping all outgoing filers will prevent messages from"

 +7        SET DIR("?",2)="being transmitted to external systems through Logical"

 +8        SET DIR("?")="Links.  Answer 'YES' if you really want this to occur."

 +9        WRITE !!

 +10       DO ^DIR

 +11       IF (($DATA(DIRUT))!('$GET(Y)))

               WRITE !!,"Outgoing filers will not be stopped",!!

               QUIT 

 +12      ;Stop all filers

 +13       WRITE !!,"Please wait while all outgoing filers are asked to stop ..."

 +14       DO STOPALL("OUT")

 +15       WRITE !,"All outgoing filers have been asked to stop",!!

 +16       QUIT 

TASKFLR(FLRTYPE) ;Task an incoming/outgoing filer

 +1       ;INPUT  : FLRTYPE - Flag denote type of filer to start

 +2       ;                   IN - Incoming filer (default)

 +3       ;                   OUT - Outgoing filer

 +4       ;OUTPUT : ZTSK (results of call to TaskMan)

 +5       ;

 +6       ;Check input

 +7        SET FLRTYPE=$GET(FLRTYPE)

 +8       ;Declare variables

 +9        NEW ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK,TMP

 +10       SET ZTIO=""

 +11       SET ZTDTH=$HOROLOG

 +12      ;Task incoming filer

 +13       SET ZTRTN="STARTIN^HLCSIN"

 +14       SET ZTDESC="HL7 Incoming Filer"

 +15      ;Task outgoing filer

 +16       IF (FLRTYPE="OUT")

               Begin DoDot:1

 +17               SET ZTRTN="STARTOUT^HLCSOUT"

 +18               SET ZTDESC="HL7 Outgoing Filer"

               End DoDot:1

 +19      ;Call TaskMan

 +20       SET ZTSK=0

 +21       DO ^%ZTLOAD

 +22       SET ZTSK=+$GET(ZTSK)

 +23      ;Not tasked

 +24       if ('ZTSK)

               QUIT 

 +25      ;Create entry in HL COMMUNICATION SERVER PARAMETER file

 +26       SET TMP=$$CRTFLR^HLCSUTL1(ZTSK,FLRTYPE)

 +27      ;Return task number

 +28       QUIT ZTSK

STOPALL(FLRTYPE) ;Stop all incoming/outgoing filers

 +1       ;INPUT  : FLRTYPE - Flag denote type of filer to start

 +2       ;                   IN - Incoming filer (default)

 +3       ;                   OUT - Outgoing filer

 +4       ;OUTPUT : None

 +5       ;

 +6       ;Check input

 +7        SET FLRTYPE=$GET(FLRTYPE)

 +8        if ((FLRTYPE'="OUT")&(FLRTYPE'="IN"))

               SET FLRTYPE="IN"

 +9       ;Declare variables

 +10       NEW PTRSUB,FLRLST

 +11      ;Get list of filers

 +12       DO GETFLRS^HLCSUTL2(FLRTYPE,"FLRLST")

 +13      ;No filers running

 +14       if ('$DATA(FLRLST))

               QUIT 

 +15      ;Loop through list of filers, stopping each

 +16       SET PTRSUB=0

 +17       FOR 

               SET PTRSUB=+$ORDER(FLRLST(PTRSUB))

               if ('PTRSUB)

                   QUIT 

               DO STOPFLR^HLCSUTL1(PTRSUB,FLRTYPE)

 +18       QUIT 

EDITPRAM  ;Entry point used by OPTION file to edit file 869.3

 +1       ;Declare variables

 +2        NEW DIC,X,Y,DTOUT,DUOUT,DLAYGO,DIE,DA,DR

 +3       ;Create/find entry HL COMMUNICATION SERVER PARAMETER file (#869.3)

 +4        SET DLAYGO=869.3

 +5        SET DIC="^HLCS(869.3,"

 +6        SET DIC(0)="L"

 +7        SET DIC("DR")="11///1;12///1"

 +8        SET X=1

 +9        DO ^DIC

 +10      ;Error

 +11       IF (Y="-1")

               Begin DoDot:1

 +12               WRITE !!,"Unable to create/find entry in HL COMMUNICATION SERVER"

 +13               WRITE !,"PARAMETER file (#869.3).  Entry must exist in order for"

 +14               WRITE !,"the incoming & outgoing filers to run.  Use FileMan to"

 +15               WRITE !,"create an initial entry for editing.",!!

               End DoDot:1

               QUIT 

 +16      ;Entry created

 +17       IF ($PIECE(Y,"^",3))

               Begin DoDot:1

 +18      ;Tell user entry was created

 +19               WRITE !!,"Initial entry in HL COMMUNICATION SERVER PARAMETER file"

 +20               WRITE !,"(#869.3) has been created.",!

               End DoDot:1

 +21      ;Edit parameters

 +22       SET DIE="^HLCS(869.3,"

 +23       SET DA=+Y

 +24       SET DR="11Default number of incoming filers;12Default number of outgoing filers"

 +25       DO ^DIE

 +26       QUIT