HLCSUTL1 ;ALB/JRP - COMMUNICATION SERVER UTILITIES;15-MAY-95
;;1.6;HEALTH LEVEL SEVEN;**99**;Oct 13, 1995
;
CRTFLR(TASKNUM,FLRTYPE) ;CREATE/FIND ENTRY IN FILER MULT OF FILE 869.3
;INPUT : TASKNUM - Task number of filer
; FLRTYPE - Indicates type of filer
; IN = Incoming (default)
; OUT = Outgoing
;OUTPUT : X - Entry number in INCOMING FILER TASK NUMBER multiple
; (field #20) or OUTGOING FILER TASK NUMBER multiple
; (field #30) of the HL COMMUNICATION SERVER PARAMETER
; file (#869.3)
; -1^ErrorText - Entry not created/found
;NOTES : Entries in multiple will be DINUMed to their task number
;
;Check input
S TASKNUM=+$G(TASKNUM)
Q:('TASKNUM) "-1^Did not pass task number of filer"
S FLRTYPE=$G(FLRTYPE)
;Declare variables
N DA,DG,DIC,DINUM,DLAYGO,FLDNUM,NODE,PTRMAIN,PTRSUB,X,Y
S NODE=$S(FLRTYPE="OUT":3,1:2)
S FLDNUM=$S(FLRTYPE="OUT":30,1:20)
;Get entry in parameter file
S PTRMAIN=+$O(^HLCS(869.3,0))
Q:('PTRMAIN) "-1^Entry in file #869.3 does not exist"
;Set up call to FileMan
S DIC="^HLCS(869.3,"_PTRMAIN_","_NODE_","
S DIC(0)="LOX"
S (X,DINUM)=TASKNUM
S DLAYGO=869.3
S DIC("DR")=".02///NO"
;These extra variables are needed since it's a multiple
S DA(1)=PTRMAIN
S DIC("P")=$P(^DD(869.3,FLDNUM,0),"^",2)
;Create/find entry
D ^DIC
S PTRSUB=+Y
Q:(PTRSUB<1) "-1^Unable to create entry in filer multiple"
Q PTRSUB
DELFLR(PTRSUB,FLRTYPE) ;DELETE ENTRY IN FILER MULT OF FILE 869.3
;INPUT : PTRSUB - Pointer to incoming or outgoing filer subentry
; FLRTYPE - Indicates type of filer
; IN = Incoming (default)
; OUT = Outgoing
;OUTPUT : None
;NOTES : This will delete the entry in the INCOMING FILER TASK NUMBER
; multiple (field #20) or OUTGOING FILER TASK NUMBER multiple
; (field #30) of the HL COMMUNICATION SERVER PARAMETER
; file (#869.3) without prompting for confirmation
;
;Check input
Q:('$G(PTRSUB))
S FLRTYPE=$G(FLRTYPE)
;Declare variables
N DA,DG,DIK,NODE,PTRMAIN
S NODE=$S(FLRTYPE="OUT":3,1:2)
;Get entry in parameter file
S PTRMAIN=+$O(^HLCS(869.3,0))
Q:('PTRMAIN)
;Nothing to delete
Q:('$D(^HLCS(869.3,PTRMAIN,NODE,PTRSUB)))
;Set up call to FileMan
S DIK="^HLCS(869.3,"_PTRMAIN_","_NODE_","
S DA=PTRSUB
S DA(1)=PTRMAIN
;Delete subentry
D ^DIK
Q
SETFLRDH(PTRSUB,FLRTYPE) ;UPDATE $H FIELD FOR FILER MULT IN FILE 869.3
;INPUT : PTRSUB - Pointer to incoming or outgoing filer subentry
; FLRTYPE - Indicates type of filer
; IN = Incoming (default)
; OUT = Outgoing
;OUTPUT : None
;NOTES : This updates the LAST KNOW $H field (.03) of the INCOMING
; FILER TASK NUMBER and OUTGOING FILER TASK NUMBER multiples
; (fields 20 & 30) of the HL COMMUNICATION SERVER PARAMETER
; file (#869.3)
;
;Check input
Q:('$G(PTRSUB))
S FLRTYPE=$G(FLRTYPE)
;Declare variables
N DA,DG,DIE,DR,LOCKTRY,NODE,PTRMAIN
S NODE=$S(FLRTYPE="OUT":3,1:2)
;Get entry in parameter file
S PTRMAIN=+$O(^HLCS(869.3,0))
Q:('PTRMAIN)
;Subentry doesn't exist
Q:('$D(^HLCS(869.3,PTRMAIN,NODE,PTRSUB)))
;Lock subentry
F LOCKTRY=0:1:20 L +^HLCS(869.3,PTRMAIN,NODE,PTRSUB):1 I ($T) S LOCKTRY=0 Q
;Couldn't lock subentry
Q:(LOCKTRY)
;Set up call to FileMan
S DIE="^HLCS(869.3,"_PTRMAIN_","_NODE_","
S DA(1)=PTRMAIN
S DA=PTRSUB
S DR=".03///"_$H
;Update value
D ^DIE
;Unlock subentry
L -^HLCS(869.3,PTRMAIN,NODE,PTRSUB)
Q
STOPFLR(PTRSUB,FLRTYPE) ;UPDATE STOP FIELD FOR FILER MULT IN FILE 869.3
;INPUT : PTRSUB - Pointer to incoming or outgoing filer subentry
; FLRTYPE - Indicates type of filer
; IN = Incoming (default)
; OUT = Outgoing
;OUTPUT : None
;NOTES : This sets the STOP FILER field (#.02) of the INCOMING
; FILER TASK NUMBER and OUTGOING FILER TASK NUMBER multiples
; (fields 20 & 30) of the HL COMMUNICATION SERVER PARAMETER
; file (#869.3). Setting this field to YES will ask the
; filer to stop.
;
;Check input
Q:('$G(PTRSUB))
S FLRTYPE=$G(FLRTYPE)
;Declare variables
N PTRMAIN,NODE,DIE,DA,DR,LOCKTRY
S NODE=$S(FLRTYPE="OUT":3,1:2)
;Get entry in parameter file
S PTRMAIN=+$O(^HLCS(869.3,0))
Q:('PTRMAIN)
;Subentry doesn't exist
Q:('$D(^HLCS(869.3,PTRMAIN,NODE,PTRSUB)))
;Lock subentry
F LOCKTRY=0:1:20 L +^HLCS(869.3,PTRMAIN,NODE,PTRSUB):1 I ($T) S LOCKTRY=0 Q
;Couldn't lock subentry
Q:(LOCKTRY)
;Set up call to FileMan
S DIE="^HLCS(869.3,"_PTRMAIN_","_NODE_","
S DA(1)=PTRMAIN
S DA=PTRSUB
S DR=".02///YES"
;Update value
D ^DIE
;Unlock subentry
L -^HLCS(869.3,PTRMAIN,NODE,PTRSUB)
Q
;
CLEAN ; Clean out invalid 869.3 data. (HL*1.6*99 Post-init routine)
N IEN,KILLSUB,MIEN,SUB
S IEN=0
F S IEN=$O(^HLCS(869.3,IEN)) Q:IEN'>0 D
. F SUB=2,3 D ; Errors only in 2, but adding 3 just in case...
. . S MIEN=0
. . S MIEN=$O(^HLCS(869.3,IEN,SUB,MIEN)) Q:MIEN'>0 D
. . . S KILLSUB=0 ; Leave the zero node, but all above go!
. . . F S KILLSUB=$O(^HLCS(869.3,IEN,SUB,MIEN,KILLSUB)) Q:KILLSUB'>0 D
. . . . KILL ^HLCS(869.3,IEN,SUB,MIEN,KILLSUB)
QUIT
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLCSUTL1 5353 printed Dec 13, 2024@01:57:13 Page 2
HLCSUTL1 ;ALB/JRP - COMMUNICATION SERVER UTILITIES;15-MAY-95
+1 ;;1.6;HEALTH LEVEL SEVEN;**99**;Oct 13, 1995
+2 ;
CRTFLR(TASKNUM,FLRTYPE) ;CREATE/FIND ENTRY IN FILER MULT OF FILE 869.3
+1 ;INPUT : TASKNUM - Task number of filer
+2 ; FLRTYPE - Indicates type of filer
+3 ; IN = Incoming (default)
+4 ; OUT = Outgoing
+5 ;OUTPUT : X - Entry number in INCOMING FILER TASK NUMBER multiple
+6 ; (field #20) or OUTGOING FILER TASK NUMBER multiple
+7 ; (field #30) of the HL COMMUNICATION SERVER PARAMETER
+8 ; file (#869.3)
+9 ; -1^ErrorText - Entry not created/found
+10 ;NOTES : Entries in multiple will be DINUMed to their task number
+11 ;
+12 ;Check input
+13 SET TASKNUM=+$GET(TASKNUM)
+14 if ('TASKNUM)
QUIT "-1^Did not pass task number of filer"
+15 SET FLRTYPE=$GET(FLRTYPE)
+16 ;Declare variables
+17 NEW DA,DG,DIC,DINUM,DLAYGO,FLDNUM,NODE,PTRMAIN,PTRSUB,X,Y
+18 SET NODE=$SELECT(FLRTYPE="OUT":3,1:2)
+19 SET FLDNUM=$SELECT(FLRTYPE="OUT":30,1:20)
+20 ;Get entry in parameter file
+21 SET PTRMAIN=+$ORDER(^HLCS(869.3,0))
+22 if ('PTRMAIN)
QUIT "-1^Entry in file #869.3 does not exist"
+23 ;Set up call to FileMan
+24 SET DIC="^HLCS(869.3,"_PTRMAIN_","_NODE_","
+25 SET DIC(0)="LOX"
+26 SET (X,DINUM)=TASKNUM
+27 SET DLAYGO=869.3
+28 SET DIC("DR")=".02///NO"
+29 ;These extra variables are needed since it's a multiple
+30 SET DA(1)=PTRMAIN
+31 SET DIC("P")=$PIECE(^DD(869.3,FLDNUM,0),"^",2)
+32 ;Create/find entry
+33 DO ^DIC
+34 SET PTRSUB=+Y
+35 if (PTRSUB<1)
QUIT "-1^Unable to create entry in filer multiple"
+36 QUIT PTRSUB
DELFLR(PTRSUB,FLRTYPE) ;DELETE ENTRY IN FILER MULT OF FILE 869.3
+1 ;INPUT : PTRSUB - Pointer to incoming or outgoing filer subentry
+2 ; FLRTYPE - Indicates type of filer
+3 ; IN = Incoming (default)
+4 ; OUT = Outgoing
+5 ;OUTPUT : None
+6 ;NOTES : This will delete the entry in the INCOMING FILER TASK NUMBER
+7 ; multiple (field #20) or OUTGOING FILER TASK NUMBER multiple
+8 ; (field #30) of the HL COMMUNICATION SERVER PARAMETER
+9 ; file (#869.3) without prompting for confirmation
+10 ;
+11 ;Check input
+12 if ('$GET(PTRSUB))
QUIT
+13 SET FLRTYPE=$GET(FLRTYPE)
+14 ;Declare variables
+15 NEW DA,DG,DIK,NODE,PTRMAIN
+16 SET NODE=$SELECT(FLRTYPE="OUT":3,1:2)
+17 ;Get entry in parameter file
+18 SET PTRMAIN=+$ORDER(^HLCS(869.3,0))
+19 if ('PTRMAIN)
QUIT
+20 ;Nothing to delete
+21 if ('$DATA(^HLCS(869.3,PTRMAIN,NODE,PTRSUB)))
QUIT
+22 ;Set up call to FileMan
+23 SET DIK="^HLCS(869.3,"_PTRMAIN_","_NODE_","
+24 SET DA=PTRSUB
+25 SET DA(1)=PTRMAIN
+26 ;Delete subentry
+27 DO ^DIK
+28 QUIT
SETFLRDH(PTRSUB,FLRTYPE) ;UPDATE $H FIELD FOR FILER MULT IN FILE 869.3
+1 ;INPUT : PTRSUB - Pointer to incoming or outgoing filer subentry
+2 ; FLRTYPE - Indicates type of filer
+3 ; IN = Incoming (default)
+4 ; OUT = Outgoing
+5 ;OUTPUT : None
+6 ;NOTES : This updates the LAST KNOW $H field (.03) of the INCOMING
+7 ; FILER TASK NUMBER and OUTGOING FILER TASK NUMBER multiples
+8 ; (fields 20 & 30) of the HL COMMUNICATION SERVER PARAMETER
+9 ; file (#869.3)
+10 ;
+11 ;Check input
+12 if ('$GET(PTRSUB))
QUIT
+13 SET FLRTYPE=$GET(FLRTYPE)
+14 ;Declare variables
+15 NEW DA,DG,DIE,DR,LOCKTRY,NODE,PTRMAIN
+16 SET NODE=$SELECT(FLRTYPE="OUT":3,1:2)
+17 ;Get entry in parameter file
+18 SET PTRMAIN=+$ORDER(^HLCS(869.3,0))
+19 if ('PTRMAIN)
QUIT
+20 ;Subentry doesn't exist
+21 if ('$DATA(^HLCS(869.3,PTRMAIN,NODE,PTRSUB)))
QUIT
+22 ;Lock subentry
+23 FOR LOCKTRY=0:1:20
LOCK +^HLCS(869.3,PTRMAIN,NODE,PTRSUB):1
IF ($TEST)
SET LOCKTRY=0
QUIT
+24 ;Couldn't lock subentry
+25 if (LOCKTRY)
QUIT
+26 ;Set up call to FileMan
+27 SET DIE="^HLCS(869.3,"_PTRMAIN_","_NODE_","
+28 SET DA(1)=PTRMAIN
+29 SET DA=PTRSUB
+30 SET DR=".03///"_$HOROLOG
+31 ;Update value
+32 DO ^DIE
+33 ;Unlock subentry
+34 LOCK -^HLCS(869.3,PTRMAIN,NODE,PTRSUB)
+35 QUIT
STOPFLR(PTRSUB,FLRTYPE) ;UPDATE STOP FIELD FOR FILER MULT IN FILE 869.3
+1 ;INPUT : PTRSUB - Pointer to incoming or outgoing filer subentry
+2 ; FLRTYPE - Indicates type of filer
+3 ; IN = Incoming (default)
+4 ; OUT = Outgoing
+5 ;OUTPUT : None
+6 ;NOTES : This sets the STOP FILER field (#.02) of the INCOMING
+7 ; FILER TASK NUMBER and OUTGOING FILER TASK NUMBER multiples
+8 ; (fields 20 & 30) of the HL COMMUNICATION SERVER PARAMETER
+9 ; file (#869.3). Setting this field to YES will ask the
+10 ; filer to stop.
+11 ;
+12 ;Check input
+13 if ('$GET(PTRSUB))
QUIT
+14 SET FLRTYPE=$GET(FLRTYPE)
+15 ;Declare variables
+16 NEW PTRMAIN,NODE,DIE,DA,DR,LOCKTRY
+17 SET NODE=$SELECT(FLRTYPE="OUT":3,1:2)
+18 ;Get entry in parameter file
+19 SET PTRMAIN=+$ORDER(^HLCS(869.3,0))
+20 if ('PTRMAIN)
QUIT
+21 ;Subentry doesn't exist
+22 if ('$DATA(^HLCS(869.3,PTRMAIN,NODE,PTRSUB)))
QUIT
+23 ;Lock subentry
+24 FOR LOCKTRY=0:1:20
LOCK +^HLCS(869.3,PTRMAIN,NODE,PTRSUB):1
IF ($TEST)
SET LOCKTRY=0
QUIT
+25 ;Couldn't lock subentry
+26 if (LOCKTRY)
QUIT
+27 ;Set up call to FileMan
+28 SET DIE="^HLCS(869.3,"_PTRMAIN_","_NODE_","
+29 SET DA(1)=PTRMAIN
+30 SET DA=PTRSUB
+31 SET DR=".02///YES"
+32 ;Update value
+33 DO ^DIE
+34 ;Unlock subentry
+35 LOCK -^HLCS(869.3,PTRMAIN,NODE,PTRSUB)
+36 QUIT
+37 ;
CLEAN ; Clean out invalid 869.3 data. (HL*1.6*99 Post-init routine)
+1 NEW IEN,KILLSUB,MIEN,SUB
+2 SET IEN=0
+3 FOR
SET IEN=$ORDER(^HLCS(869.3,IEN))
if IEN'>0
QUIT
Begin DoDot:1
+4 ; Errors only in 2, but adding 3 just in case...
FOR SUB=2,3
Begin DoDot:2
+5 SET MIEN=0
+6 SET MIEN=$ORDER(^HLCS(869.3,IEN,SUB,MIEN))
if MIEN'>0
QUIT
Begin DoDot:3
+7 ; Leave the zero node, but all above go!
SET KILLSUB=0
+8 FOR
SET KILLSUB=$ORDER(^HLCS(869.3,IEN,SUB,MIEN,KILLSUB))
if KILLSUB'>0
QUIT
Begin DoDot:4
+9 KILL ^HLCS(869.3,IEN,SUB,MIEN,KILLSUB)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
