Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed
  • WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLTF.m

    r613 r623  
    1 HLTF    ;AISC/SAW,JRP-Create/Process Message Text File Entries ;10/17/2007  09:41
    2         ;;1.6;HEALTH LEVEL SEVEN;**1,19,43,55,109,120,122**;Oct 13, 1995;Build 14
    3         ;Per VHA Directive 2004-038, this routine should not be modified.
    4         ;
    5         Q
    6         ;
    7 FILE    ;Create Entries in files 772 and 773 for Version 1.5 Interface Only
    8         D CREATE(,.HLDA,.HLDT,.HLDT1)
    9         Q
    10 CREATE(HLMID,MTIEN,HLDT,HLDT1)  ;Create entries in Message Text (#772)
    11         ;
    12         ;Input  : HLMID = Variable in which value of message ID will be
    13         ;                 returned (pass by reference)
    14         ;         MTIEN = Variable in which IEN of Message Text file entry
    15         ;                 will be returned (pass by reference)
    16         ;         HLDT = Variable in which current date/time in FM internal
    17         ;                format will be returned (pass by reference)
    18         ;         HLDT1 = Variable in which current date/time in HL7 format
    19         ;                 will be returned (pass by reference)
    20         ;
    21         ;Output : See above
    22         ;
    23         ;Notes  : If HLDT has a value [upon entry], the created entries will
    24         ;         be given that value for their date/time (value of .01)
    25         ;       : Current date/time used if HLDT is not passed or invalid
    26         ;
    27         ;Make entry in Message Administration file
    28         N Y
    29         S HLDT=$G(HLDT)
    30         D MT(.HLDT)
    31         S Y=$$CHNGMID(MTIEN,.HLMID),HLDT1=$$HLDATE^HLFNC(HLDT)
    32         Q
    33 TCP(HLMID,MTIEN,HLDT)   ;create new message in 772 & 773 entries
    34         ;used for incoming messages and outgoing responses
    35         ;Input  : HLMID = Variable in which value of message ID will be
    36         ;                 returned (pass by reference)
    37         ;         MTIEN = Variable in which IEN of file 773 entry
    38         ;                 will be returned (pass by reference)
    39         ;         HLDT = Variable in which current date/time in FM internal
    40         ;                format will be returned (pass by reference)
    41         ;
    42         S HLDT=$G(HLDT),HLMID=$G(HLMID)
    43         D MT(.HLDT)
    44         S MTIEN=$$MA(MTIEN,.HLMID)
    45         Q
    46         ;
    47 MT(HLX) ;Create entry in Message Text file (#772)
    48         ;
    49         ;Input  : HLX = Date/time entry in file should be given (value of .01)
    50         ;               Defaults to current date/time
    51         ;
    52         ;Output : HLDT = Date/time of created entry (value of .01)
    53         ;       : HLDT1 = HLDT in HL7 format
    54         ;
    55         ;Notes  : HLX must be in FileMan format (default value used if not)
    56         ;       : HLDT will be in FileMan format
    57         ;       : MTIEN is ien in file 772
    58         ;
    59         ;Check for input
    60         S HLX=$G(HLX)
    61         ;Declare variables
    62         N DIC,DD,DO,HLCNT,HLJ,X,Y
    63         F HLCNT=0:1 D  Q:Y>0  H HLCNT
    64         . I (HLX'?7N.1".".6N) S HLX=$$NOW^XLFDT
    65         . S DIC="^HL(772,",DIC(0)="L",(HLDT,X)=HLX
    66         . S Y=$$STUB772(X) ; This call substituted for D FILE^DICN by HL*1.6*109
    67         . ;Entry not created - try again
    68         . I Y<0 S HLX="" Q
    69         . S MTIEN=+Y
    70         ;***If we didn't get a record in 772, need to do something
    71         I Y<0 Q
    72         S HLDT1=$$HLDATE^HLFNC(HLDT)
    73         Q
    74         ;add to Message Admin file #773
    75 MA(X,HLMID)     ;X=ien in file 772, HLMID=msg. id (passed by ref.)
    76         ;return ien in file 773
    77         ;
    78         ; patch HL*1.6*122: MPI-client/server start
    79         F  L +^HL(772,+$G(X)):10 Q:$T  H 1
    80         Q:'$G(^HL(772,X,0)) 0
    81         L -^HL(772,+$G(X))
    82         ; patch HL*1.6*122: MPI-client/server end
    83         ;
    84         N DA,DD,DO,DIC,DIE,DR,HLDA,HLCNT,HLJ,Y
    85         S DIC="^HLMA(",DIC(0)="L"
    86         F HLCNT=0:1 D  Q:Y>0  H HLCNT
    87         . S Y=$$STUB773(X) ; This call substituted for D FILE^DICN by HL*1.6*109
    88         ;***If we didn't get a record in 773, need to do something
    89         I Y<0 Q 0
    90         S HLDA=+Y,HLMID=$$MAID(HLDA,$G(HLMID))
    91         Q HLDA
    92         ;
    93 MAID(Y,HLMID)   ;Determine message ID (if needed) & store message ID
    94         ;Y=ien in 773, HLMID=id,  Output message id
    95         N HLJ
    96         ;need to have id contain institution number to make unique
    97         S:$G(HLMID)="" HLMID=+$P($$PARAM^HLCS2,U,6)_Y
    98         S HLJ(773,Y_",",2)=HLMID
    99         D FILE^HLDIE("","HLJ","","MAID","HLTF") ;HL*1.6*109
    100         Q HLMID
    101         ;
    102 CHNGMID(PTRMT,NEWID)    ;Change message ID for entry in Message Text file
    103         ;Input  : PTRMT - Pointer to entry in Message Text file (#772)
    104         ;         NEWID - New message ID
    105         ;Output : 0 = Success
    106         ;         -1^ErrorText = Error/Bad input
    107         ;
    108         ;Check input
    109         S PTRMT=+$G(PTRMT)
    110         S NEWID=$G(NEWID)
    111         Q:('$D(^HL(772,PTRMT,0))) "-1^Did not pass valid pointer to Message Text file (#772)"
    112         N HLJ
    113         I $G(NEWID)="" S NEWID=+$P($$PARAM^HLCS2,U,6)_PTRMT
    114         S HLJ(772,PTRMT_",",6)=NEWID
    115         D FILE^HLDIE("","HLJ","","CHNGMID","HLTF") ; HL*1.6*109
    116         Q 0
    117         ;
    118 OUT(HLDA,HLMID,HLMTN)   ;File Data in Message Text File for Outgoing Message
    119         ;Version 1.5 Interface Only
    120         ;
    121         ; patch HL*1.6*122: HLTF routine splitted, moves sub-routines,
    122         ; OUT, IN, and ACK to HLTF2 routine.
    123         ;
    124         D OUT^HLTF2($G(HLDA),$G(HLMID),$G(HLMTN))
    125         Q
    126         ;
    127 IN(HLMTN,HLMID,HLTIME)  ;File Data in Message Text File for Incoming Message
    128         ;Version 1.5 Interface Only
    129         ;
    130         ; patch HL*1.6*122: HLTF routine splitted, moves sub-routines,
    131         ; OUT, IN, and ACK to HLTF2 routine.
    132         ;
    133         D IN^HLTF2($G(HLMTN),$G(HLMID),$G(HLTIME))
    134         Q
    135         ;
    136 ACK(HLMSA,HLIO,HLDA)    ;Process 'ACK' Message Type - Version 1.5 Interface Only
    137         ;
    138         ; patch HL*1.6*122: HLTF routine splitted, moves sub-routines,
    139         ; OUT, IN, and ACK to HLTF2 routine.
    140         ;
    141         D ACK^HLTF2($G(HLMSA),$G(HLIO),$G(HLDA))
    142         Q
    143         ;
    144 STUB772(FLD01,OS)       ;
    145         ;This function creates a new stub record in file 772. The Stub record may consist of only the 0 node with a value of "^". If a value is passed in for the .01 field it will be included in the 0 node and its "B" x-ref set.
    146         ;Inputs:
    147         ;  OS (optional), the value of ^%ZOSF("OS")
    148         ;  FLD01 (optional), the value for the .01 field
    149         ;Output - the function returns the ien of the newly created record
    150         ;
    151         N IEN
    152         I '$L($G(OS)) N OS S OS=$G(^%ZOSF("OS"))
    153         ;
    154         I OS'["DSM",OS'["OpenM" D
    155         .F  L +^HLCS(869.3,1,772):10 S IEN=+$G(^HLCS(869.3,1,772))+1,^HLCS(869.3,1,772)=IEN S:$D(^HL(772,IEN)) IEN=0,^HLCS(869.3,1,772)=($O(^HL(772,":"),-1)\1) L -^HLCS(869.3,1,772) Q:IEN
    156         E  D
    157         .F  S IEN=$I(^HLCS(869.3,1,772),1) S:$D(^HL(772,IEN)) IEN=0,^HLCS(869.3,1,772)=($O(^HL(772,":"),-1)\1) Q:IEN
    158         ;
    159         ; patch HL*1.6*122: MPI-client/server start
    160         F  L +^HL(772,IEN):10 Q:$T  H 1
    161         S ^HL(772,IEN,0)=$G(FLD01)_"^"
    162         I $L($G(FLD01)) S ^HL(772,"B",FLD01,IEN)=""
    163         L -^HL(772,IEN)
    164         ; patch HL*1.6*122: MPI-client/server end
    165         ;
    166         Q IEN
    167         ;
    168 STUB773(FLD01,OS)       ;
    169         ;This function creates a new stub record in file 772. The Stub record may consist of only the 0 node with a value of "^". If a value is passed in for the .01 field it will be included in the 0 node and its "B" x-ref set.
    170         ;Inputs:
    171         ;  OS (optional), the value of ^%ZOSF("OS")
    172         ;  FLD01 (optional), the value for the .01 field
    173         ;Output - the function returns the ien of the newly created record
    174         ;
    175         N IEN
    176         I '$L($G(OS)) N OS S OS=$G(^%ZOSF("OS"))
    177         ;
    178         I OS'["DSM",OS'["OpenM" D
    179         .F  L +^HLCS(869.3,1,773):10 S IEN=+$G(^HLCS(869.3,1,773))+1,^HLCS(869.3,1,773)=IEN S:$D(^HLMA(IEN)) IEN=0,^HLCS(869.3,1,773)=($O(^HLMA(":"),-1)\1) L -^HLCS(869.3,1,773) Q:IEN
    180         E  D
    181         .F  S IEN=$I(^HLCS(869.3,1,773),1) S:$D(^HLMA(IEN)) IEN=0,^HLCS(869.3,1,773)=($O(^HLMA(":"),-1)\1) Q:IEN
    182         ;
    183         ; patch HL*1.6*122: MPI-client/server
    184         F  L +^HLMA(IEN):10 Q:$T  H 1
    185         S ^HLMA(IEN,0)=$G(FLD01)_"^"
    186         I $L($G(FLD01)) S ^HLMA("B",FLD01,IEN)=""
    187         L -^HLMA(IEN)
    188         ;
    189         Q IEN
     1HLTF ;AISC/SAW,JRP-Create/Process Message Text File Entries ;01/23/06  12:56
     2 ;;1.6;HEALTH LEVEL SEVEN;**1,19,43,55,109,120**;Oct 13, 1995;Build 12
     3FILE ;Create Entries in files 772 and 773 for Version 1.5 Interface Only
     4 D CREATE(,.HLDA,.HLDT,.HLDT1)
     5 Q
     6CREATE(HLMID,MTIEN,HLDT,HLDT1) ;Create entries in Message Text (#772)
     7 ;
     8 ;Input  : HLMID = Variable in which value of message ID will be
     9 ;                 returned (pass by reference)
     10 ;         MTIEN = Variable in which IEN of Message Text file entry
     11 ;                 will be returned (pass by reference)
     12 ;         HLDT = Variable in which current date/time in FM internal
     13 ;                format will be returned (pass by reference)
     14 ;         HLDT1 = Variable in which current date/time in HL7 format
     15 ;                 will be returned (pass by reference)
     16 ;
     17 ;Output : See above
     18 ;
     19 ;Notes  : If HLDT has a value [upon entry], the created entries will
     20 ;         be given that value for their date/time (value of .01)
     21 ;       : Current date/time used if HLDT is not passed or invalid
     22 ;
     23 ;Make entry in Message Administration file
     24 N Y
     25 S HLDT=$G(HLDT)
     26 D MT(.HLDT)
     27 S Y=$$CHNGMID(MTIEN,.HLMID),HLDT1=$$HLDATE^HLFNC(HLDT)
     28 Q
     29TCP(HLMID,MTIEN,HLDT) ;create new message in 772 & 773 entries
     30 ;used for incoming messages and outgoing responses
     31 ;Input  : HLMID = Variable in which value of message ID will be
     32 ;                 returned (pass by reference)
     33 ;         MTIEN = Variable in which IEN of file 773 entry
     34 ;                 will be returned (pass by reference)
     35 ;         HLDT = Variable in which current date/time in FM internal
     36 ;                format will be returned (pass by reference)
     37 ;
     38 S HLDT=$G(HLDT),HLMID=$G(HLMID)
     39 D MT(.HLDT)
     40 S MTIEN=$$MA(MTIEN,.HLMID)
     41 Q
     42 ;
     43MT(HLX) ;Create entry in Message Text file (#772)
     44 ;
     45 ;Input  : HLX = Date/time entry in file should be given (value of .01)
     46 ;               Defaults to current date/time
     47 ;
     48 ;Output : HLDT = Date/time of created entry (value of .01)
     49 ;       : HLDT1 = HLDT in HL7 format
     50 ;
     51 ;Notes  : HLX must be in FileMan format (default value used if not)
     52 ;       : HLDT will be in FileMan format
     53 ;       : MTIEN is ien in file 772
     54 ;
     55 ;Check for input
     56 S HLX=$G(HLX)
     57 ;Declare variables
     58 N DIC,DD,DO,HLCNT,HLJ,X,Y
     59 F HLCNT=0:1 D  Q:Y>0  H HLCNT
     60 . I (HLX'?7N.1".".6N) S HLX=$$NOW^XLFDT
     61 . S DIC="^HL(772,",DIC(0)="L",(HLDT,X)=HLX
     62 . S Y=$$STUB772(X) ; This call substituted for D FILE^DICN by HL*1.6*109
     63 . ;Entry not created - try again
     64 . I Y<0 S HLX="" Q
     65 . S MTIEN=+Y
     66 ;***If we didn't get a record in 772, need to do something
     67 I Y<0 Q
     68 S HLDT1=$$HLDATE^HLFNC(HLDT)
     69 Q
     70 ;add to Message Admin file #773
     71MA(X,HLMID) ;X=ien in file 772, HLMID=msg. id (passed by ref.)
     72 ;return ien in file 773
     73 Q:'$G(^HL(772,X,0)) 0
     74 N DA,DD,DO,DIC,DIE,DR,HLDA,HLCNT,HLJ,Y
     75 S DIC="^HLMA(",DIC(0)="L"
     76 F HLCNT=0:1 D  Q:Y>0  H HLCNT
     77 . S Y=$$STUB773(X) ; This call substituted for D FILE^DICN by HL*1.6*109
     78 ;***If we didn't get a record in 773, need to do something
     79 I Y<0 Q 0
     80 S HLDA=+Y,HLMID=$$MAID(HLDA,$G(HLMID))
     81 Q HLDA
     82 ;
     83MAID(Y,HLMID) ;Determine message ID (if needed) & store message ID
     84 ;Y=ien in 773, HLMID=id,  Output message id
     85 N HLJ
     86 ;need to have id contain institution number to make unique
     87 S:$G(HLMID)="" HLMID=+$P($$PARAM^HLCS2,U,6)_Y
     88 S HLJ(773,Y_",",2)=HLMID
     89 D FILE^HLDIE("","HLJ","","MAID","HLTF") ;HL*1.6*109
     90 Q HLMID
     91 ;
     92CHNGMID(PTRMT,NEWID) ;Change message ID for entry in Message Text file
     93 ;Input  : PTRMT - Pointer to entry in Message Text file (#772)
     94 ;         NEWID - New message ID
     95 ;Output : 0 = Success
     96 ;         -1^ErrorText = Error/Bad input
     97 ;
     98 ;Check input
     99 S PTRMT=+$G(PTRMT)
     100 S NEWID=$G(NEWID)
     101 Q:('$D(^HL(772,PTRMT,0))) "-1^Did not pass valid pointer to Message Text file (#772)"
     102 N HLJ
     103 I $G(NEWID)="" S NEWID=+$P($$PARAM^HLCS2,U,6)_PTRMT
     104 S HLJ(772,PTRMT_",",6)=NEWID
     105 D FILE^HLDIE("","HLJ","","CHNGMID","HLTF") ; HL*1.6*109
     106 Q 0
     107 ;
     108OUT(HLDA,HLMID,HLMTN) ;File Data in Message Text File for Outgoing Message
     109 ;Version 1.5 Interface Only
     110 Q:'$D(HLFS)
     111 ;
     112 I HLMTN="ACK"!(HLMTN="MCF")!(HLMTN="ORR") Q:'$D(HLMSA)  D ACK(HLMSA,"I") Q
     113 ;
     114 ;-- if message contained MSA find inbound message
     115 I $D(HLMSA),$D(HLNDAP),$P(HLMSA,HLFS,3)]"" D
     116 . N HLDAI
     117 . S HLDAI=0
     118 . F  S HLDAI=$O(^HL(772,"AH",+$P($G(HLNDAP0),U,12),$P(HLMSA,HLFS,3),HLDAI)) Q:'HLDAI!($P($G(^HL(772,+HLDAI,0)),U,4)="I")
     119 . I 'HLDAI K HLDAI
     120 ;
     121 D STUFF^HLTF0("O")
     122 ;
     123 N HLAC S HLAC=$S($D(HLERR):4,'$P(HLNDAP0,"^",10):1,1:2) D STATUS^HLTF0(HLDA,HLAC,$G(HLMSG))
     124 D:$D(HLCHAR) STATS^HLTF0(HLDA,HLCHAR,$G(HLEVN))
     125 ;
     126 ;-- update status if MSA and found inbound message
     127 I $D(HLMSA),$D(HLDAI) D
     128 .N HLERR,HLMSG I $P(HLMSA,HLFS,4)]"" S HLERR=$P(HLMSA,HLFS,4)
     129 .S HLAC=$P(HLMSA,HLFS,2)
     130 .I HLAC'="AA" S HLMSG=$S(HLAC="AR":"Application Reject",HLAC="AE":"Application Error",1:"")_" - "_HLERR
     131 .S HLAC=$S(HLAC'="AA":4,1:3) D STATUS^HLTF0(HLDAI,HLAC,$G(HLMSG))
     132 Q
     133 ;
     134IN(HLMTN,HLMID,HLTIME) ;File Data in Message Text File for Incoming Message
     135 ;Version 1.5 Interface Only
     136 Q:'$D(HLFS)
     137 I HLMTN="ACK"!(HLMTN="MCF")!(HLMTN="ORR") Q:'$D(HLMSA)  D ACK(HLMSA,"O",$G(HLDA)) Q
     138 ;
     139 N HLDAI S HLDA=0
     140 I $D(HLNDAP),HLMID]"" D
     141 .F  S HLDA=+$O(^HL(772,"AH",+$P($G(HLNDAP0),U,12),HLMID,HLDA)) Q:'HLDA!($P($G(^HL(772,+HLDA,0)),U,4)="I")
     142 .I HLDA D
     143 ..S HLDT=+$P($G(^HL(772,HLDA,0)),"^"),HLDT1=$$HLDATE^HLFNC(HLDT)
     144 ..K ^HL(772,HLDA,"IN")
     145 .I $D(HLMSA),$P(HLMSA,HLFS,3)]"" D
     146 ..S HLDAI=0
     147 ..F  S HLDAI=$O(^HL(772,"AH",+$P($G(HLNDAP0),U,12),$P(HLMSA,HLFS,3),HLDAI)) Q:'HLDAI!($P($G(^HL(772,+HLDAI,0)),U,4)="O")
     148 ..I 'HLDAI K HLDAI
     149 ;
     150 I 'HLDA D CREATE(.HLMID,.HLDA,.HLDT,.HLDT1) K HLZ
     151 ;
     152 D STUFF^HLTF0("I")
     153 N HLAC S HLAC=$S($D(HLERR):4,1:1) D STATUS^HLTF0(HLDA,HLAC,$G(HLMSG))
     154 ;
     155 D MERGE15^HLTF1("G",HLDA,"HLR",HLTIME)
     156 ;
     157 I '$D(HLERR),$D(HLMSA),$D(HLDAI) D
     158 .N HLAC,HLERR,HLMSG I $P(HLMSA,HLFS,4)]"" S HLERR=$P(HLMSA,HLFS,4)
     159 .S HLAC=$P(HLMSA,HLFS,2) I HLAC'="AA" S HLMSG=$S(HLAC="AR":"Application Reject",1:"Application Error")_" - "_HLERR
     160 .S HLAC=$S(HLAC'="AA":4,1:3) D STATUS^HLTF0(HLDAI,HLAC,$G(HLMSG))
     161 Q
     162 ;
     163ACK(HLMSA,HLIO,HLDA) ;Process 'ACK' Message Type - Version 1.5 Interface Only
     164 ; To determine the correct message to link the ACK, HLIO is used.
     165 ; For an ack from DHCP (original message from remote system) then
     166 ; HLIO should be "I" so that the correct inbound message is ack-ed. For
     167 ; an inbound ack (original message outbound from DHCP) HLIO should be
     168 ; "O". This distinction must be made due to the possible duplicate
     169 ; message ids from a bi-direction interface.
     170 ;
     171 ; Input : MSA - MSA from ACK message.
     172 ;         HLIO - Either "I" or "O" : See note above.
     173 ;Output : None
     174 ;
     175 N HLAC,HLMIDI
     176 ;-- set up required vars
     177 S HLAC=$P(HLMSA,HLFS,2),HLMIDI=$P(HLMSA,HLFS,3)
     178 ;-- quit
     179 Q:HLMIDI']""!(HLAC']"")!('$D(HLNDAP))
     180 ;-- find message to ack
     181 I '$G(HLDA) S HLDA=0 D
     182 . F  S HLDA=+$O(^HL(772,"AH",+$P($G(HLNDAP0),U,12),HLMIDI,HLDA)) Q:'HLDA!($P($G(^HL(772,+HLDA,0)),U,4)=HLIO)
     183 ;-- quit if no message
     184 Q:'$D(^HL(772,+HLDA,0))
     185 ;-- check for error
     186 I $P(HLMSA,HLFS,4)]"" N HLERR S HLERR=$P(HLMSA,HLFS,4)
     187 I $D(HLERR),'$D(HLMSG) N HLMSG S HLMSG="Error During Receipt of Acknowledgement Message"_$S(HLAC="AR":" - Application Reject",HLAC="AE":" - Application Error",1:"")_" - "_HLERR
     188 ;-- update status
     189 S HLAC=$S(HLMTN="MCF":2,HLAC'="AA":4,1:3)
     190 D STATUS^HLTF0(HLDA,HLAC,$G(HLMSG))
     191 Q
     192 ;
     193STUB772(FLD01,OS) ;
     194 ;This function creates a new stub record in file 772. The Stub record may consist of only the 0 node with a value of "^". If a value is passed in for the .01 field it will be included in the 0 node and its "B" x-ref set.
     195 ;Inputs:
     196 ;  OS (optional), the value of ^%ZOSF("OS")
     197 ;  FLD01 (optional), the value for the .01 field
     198 ;Output - the function returns the ien of the newly created record
     199 ;
     200 N IEN
     201 I '$L($G(OS)) N OS S OS=$G(^%ZOSF("OS"))
     202 ;
     203 ; patch HL*1.6*120, protect Else command
     204 ; I OS'["DSM",OS'["OpenM" D
     205 I OS'["DSM",OS'["OpenM" D  I 1
     206 .F  L +^HLCS(869.3,1,772):10 S IEN=+$G(^HLCS(869.3,1,772))+1,^HLCS(869.3,1,772)=IEN S:$D(^HL(772,IEN)) IEN=0,^HLCS(869.3,1,772)=($O(^HL(772,":"),-1)\1) L -^HLCS(869.3,1,772) Q:IEN
     207 E  D
     208 .F  S IEN=$I(^HLCS(869.3,1,772),1) S:$D(^HL(772,IEN)) IEN=0,^HLCS(869.3,1,772)=($O(^HL(772,":"),-1)\1) Q:IEN
     209 S ^HL(772,IEN,0)=$G(FLD01)_"^"
     210 I $L($G(FLD01)) S ^HL(772,"B",FLD01,IEN)=""
     211 Q IEN
     212 ;
     213STUB773(FLD01,OS) ;
     214 ;This function creates a new stub record in file 772. The Stub record may consist of only the 0 node with a value of "^". If a value is passed in for the .01 field it will be included in the 0 node and its "B" x-ref set.
     215 ;Inputs:
     216 ;  OS (optional), the value of ^%ZOSF("OS")
     217 ;  FLD01 (optional), the value for the .01 field
     218 ;Output - the function returns the ien of the newly created record
     219 ;
     220 N IEN
     221 I '$L($G(OS)) N OS S OS=$G(^%ZOSF("OS"))
     222 ;
     223 ; patch HL*1.6*120, protect Else command
     224 ; I OS'["DSM",OS'["OpenM" D
     225 I OS'["DSM",OS'["OpenM" D  I 1
     226 .F  L +^HLCS(869.3,1,773):10 S IEN=+$G(^HLCS(869.3,1,773))+1,^HLCS(869.3,1,773)=IEN S:$D(^HLMA(IEN)) IEN=0,^HLCS(869.3,1,773)=($O(^HLMA(":"),-1)\1) L -^HLCS(869.3,1,773) Q:IEN
     227 E  D
     228 .F  S IEN=$I(^HLCS(869.3,1,773),1) S:$D(^HLMA(IEN)) IEN=0,^HLCS(869.3,1,773)=($O(^HLMA(":"),-1)\1) Q:IEN
     229 S ^HLMA(IEN,0)=$G(FLD01)_"^"
     230 I $L($G(FLD01)) S ^HLMA("B",FLD01,IEN)=""
     231 Q IEN
Note: See TracChangeset for help on using the changeset viewer.