source: FOIAVistA/tag/r/HEALTH_LEVEL_SEVEN-HL/HLCSUTL1.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 5.1 KB
Line 
1HLCSUTL1 ;ALB/JRP - COMMUNICATION SERVER UTILITIES;15-MAY-95
2 ;;1.6;HEALTH LEVEL SEVEN;**99**;Oct 13, 1995
3 ;
4CRTFLR(TASKNUM,FLRTYPE) ;CREATE/FIND ENTRY IN FILER MULT OF FILE 869.3
5 ;INPUT : TASKNUM - Task number of filer
6 ; FLRTYPE - Indicates type of filer
7 ; IN = Incoming (default)
8 ; OUT = Outgoing
9 ;OUTPUT : X - Entry number in INCOMING FILER TASK NUMBER multiple
10 ; (field #20) or OUTGOING FILER TASK NUMBER multiple
11 ; (field #30) of the HL COMMUNICATION SERVER PARAMETER
12 ; file (#869.3)
13 ; -1^ErrorText - Entry not created/found
14 ;NOTES : Entries in multiple will be DINUMed to their task number
15 ;
16 ;Check input
17 S TASKNUM=+$G(TASKNUM)
18 Q:('TASKNUM) "-1^Did not pass task number of filer"
19 S FLRTYPE=$G(FLRTYPE)
20 ;Declare variables
21 N DA,DG,DIC,DINUM,DLAYGO,FLDNUM,NODE,PTRMAIN,PTRSUB,X,Y
22 S NODE=$S(FLRTYPE="OUT":3,1:2)
23 S FLDNUM=$S(FLRTYPE="OUT":30,1:20)
24 ;Get entry in parameter file
25 S PTRMAIN=+$O(^HLCS(869.3,0))
26 Q:('PTRMAIN) "-1^Entry in file #869.3 does not exist"
27 ;Set up call to FileMan
28 S DIC="^HLCS(869.3,"_PTRMAIN_","_NODE_","
29 S DIC(0)="LOX"
30 S (X,DINUM)=TASKNUM
31 S DLAYGO=869.3
32 S DIC("DR")=".02///NO"
33 ;These extra variables are needed since it's a multiple
34 S DA(1)=PTRMAIN
35 S DIC("P")=$P(^DD(869.3,FLDNUM,0),"^",2)
36 ;Create/find entry
37 D ^DIC
38 S PTRSUB=+Y
39 Q:(PTRSUB<1) "-1^Unable to create entry in filer multiple"
40 Q PTRSUB
41DELFLR(PTRSUB,FLRTYPE) ;DELETE ENTRY IN FILER MULT OF FILE 869.3
42 ;INPUT : PTRSUB - Pointer to incoming or outgoing filer subentry
43 ; FLRTYPE - Indicates type of filer
44 ; IN = Incoming (default)
45 ; OUT = Outgoing
46 ;OUTPUT : None
47 ;NOTES : This will delete the entry in the INCOMING FILER TASK NUMBER
48 ; multiple (field #20) or OUTGOING FILER TASK NUMBER multiple
49 ; (field #30) of the HL COMMUNICATION SERVER PARAMETER
50 ; file (#869.3) without prompting for confirmation
51 ;
52 ;Check input
53 Q:('$G(PTRSUB))
54 S FLRTYPE=$G(FLRTYPE)
55 ;Declare variables
56 N DA,DG,DIK,NODE,PTRMAIN
57 S NODE=$S(FLRTYPE="OUT":3,1:2)
58 ;Get entry in parameter file
59 S PTRMAIN=+$O(^HLCS(869.3,0))
60 Q:('PTRMAIN)
61 ;Nothing to delete
62 Q:('$D(^HLCS(869.3,PTRMAIN,NODE,PTRSUB)))
63 ;Set up call to FileMan
64 S DIK="^HLCS(869.3,"_PTRMAIN_","_NODE_","
65 S DA=PTRSUB
66 S DA(1)=PTRMAIN
67 ;Delete subentry
68 D ^DIK
69 Q
70SETFLRDH(PTRSUB,FLRTYPE) ;UPDATE $H FIELD FOR FILER MULT IN FILE 869.3
71 ;INPUT : PTRSUB - Pointer to incoming or outgoing filer subentry
72 ; FLRTYPE - Indicates type of filer
73 ; IN = Incoming (default)
74 ; OUT = Outgoing
75 ;OUTPUT : None
76 ;NOTES : This updates the LAST KNOW $H field (.03) of the INCOMING
77 ; FILER TASK NUMBER and OUTGOING FILER TASK NUMBER multiples
78 ; (fields 20 & 30) of the HL COMMUNICATION SERVER PARAMETER
79 ; file (#869.3)
80 ;
81 ;Check input
82 Q:('$G(PTRSUB))
83 S FLRTYPE=$G(FLRTYPE)
84 ;Declare variables
85 N DA,DG,DIE,DR,LOCKTRY,NODE,PTRMAIN
86 S NODE=$S(FLRTYPE="OUT":3,1:2)
87 ;Get entry in parameter file
88 S PTRMAIN=+$O(^HLCS(869.3,0))
89 Q:('PTRMAIN)
90 ;Subentry doesn't exist
91 Q:('$D(^HLCS(869.3,PTRMAIN,NODE,PTRSUB)))
92 ;Lock subentry
93 F LOCKTRY=0:1:20 L +^HLCS(869.3,PTRMAIN,NODE,PTRSUB):1 I ($T) S LOCKTRY=0 Q
94 ;Couldn't lock subentry
95 Q:(LOCKTRY)
96 ;Set up call to FileMan
97 S DIE="^HLCS(869.3,"_PTRMAIN_","_NODE_","
98 S DA(1)=PTRMAIN
99 S DA=PTRSUB
100 S DR=".03///"_$H
101 ;Update value
102 D ^DIE
103 ;Unlock subentry
104 L -^HLCS(869.3,PTRMAIN,NODE,PTRSUB)
105 Q
106STOPFLR(PTRSUB,FLRTYPE) ;UPDATE STOP FIELD FOR FILER MULT IN FILE 869.3
107 ;INPUT : PTRSUB - Pointer to incoming or outgoing filer subentry
108 ; FLRTYPE - Indicates type of filer
109 ; IN = Incoming (default)
110 ; OUT = Outgoing
111 ;OUTPUT : None
112 ;NOTES : This sets the STOP FILER field (#.02) of the INCOMING
113 ; FILER TASK NUMBER and OUTGOING FILER TASK NUMBER multiples
114 ; (fields 20 & 30) of the HL COMMUNICATION SERVER PARAMETER
115 ; file (#869.3). Setting this field to YES will ask the
116 ; filer to stop.
117 ;
118 ;Check input
119 Q:('$G(PTRSUB))
120 S FLRTYPE=$G(FLRTYPE)
121 ;Declare variables
122 N PTRMAIN,NODE,DIE,DA,DR,LOCKTRY
123 S NODE=$S(FLRTYPE="OUT":3,1:2)
124 ;Get entry in parameter file
125 S PTRMAIN=+$O(^HLCS(869.3,0))
126 Q:('PTRMAIN)
127 ;Subentry doesn't exist
128 Q:('$D(^HLCS(869.3,PTRMAIN,NODE,PTRSUB)))
129 ;Lock subentry
130 F LOCKTRY=0:1:20 L +^HLCS(869.3,PTRMAIN,NODE,PTRSUB):1 I ($T) S LOCKTRY=0 Q
131 ;Couldn't lock subentry
132 Q:(LOCKTRY)
133 ;Set up call to FileMan
134 S DIE="^HLCS(869.3,"_PTRMAIN_","_NODE_","
135 S DA(1)=PTRMAIN
136 S DA=PTRSUB
137 S DR=".02///YES"
138 ;Update value
139 D ^DIE
140 ;Unlock subentry
141 L -^HLCS(869.3,PTRMAIN,NODE,PTRSUB)
142 Q
143 ;
144CLEAN ; Clean out invalid 869.3 data. (HL*1.6*99 Post-init routine)
145 N IEN,KILLSUB,MIEN,SUB
146 S IEN=0
147 F S IEN=$O(^HLCS(869.3,IEN)) Q:IEN'>0 D
148 . F SUB=2,3 D ; Errors only in 2, but adding 3 just in case...
149 . . S MIEN=0
150 . . S MIEN=$O(^HLCS(869.3,IEN,SUB,MIEN)) Q:MIEN'>0 D
151 . . . S KILLSUB=0 ; Leave the zero node, but all above go!
152 . . . F S KILLSUB=$O(^HLCS(869.3,IEN,SUB,MIEN,KILLSUB)) Q:KILLSUB'>0 D
153 . . . . KILL ^HLCS(869.3,IEN,SUB,MIEN,KILLSUB)
154 QUIT
155 ;
Note: See TracBrowser for help on using the repository browser.