Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: HLEMU

HLEMU.m

Go to the documentation of this file. 
  1. HLEMU ;ALB/CJM  Utility Routines ;02/04/2004 14:42
  1.  ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13, 1995
  1.  ;
  1. STATNUM(IEN) ;
  1.  ;Description:  Given an ien to the Institution file, returns as the function value the station number.  If IEN is NOT passed in, it assumes the local site.  Returns "" on failure.
  1.  ;
  1.  N STATION,RETURN
  1.  S RETURN=""
  1.  I $G(IEN) D
  1.  .Q:'$D(^DIC(4,IEN,0))
  1.  .S STATION=$P($$NNT^XUAF4(IEN),"^",2)
  1.  .S RETURN=$S(+STATION:STATION,1:"")
  1.  E  D
  1.  .S RETURN=$P($$SITE^VASITE(),"^",3)
  1.  Q RETURN
  1. INSTIEN(STATION) ;
  1.  ;Given the station number, this returns a pointer to the Institution file
  1.  Q $$LKUP^XUAF4(STATION)
  1.  ;
  1. UPD(FILE,HLDA,DATA,ERROR) ;File data into an existing record.
  1.  ; Input:
  1.  ;   FILE - File or sub-file number
  1.  ;   HLDA - New name for traditional DA array, with same meaning.
  1.  ;            Pass by reference.
  1.  ;   DATA - Data array to file (pass by reference)
  1.  ;          Format: DATA(<field #>)=<value>
  1.  ;
  1.  ; Output:
  1.  ;  Function Value -     0=error and 1=no error
  1.  ;  ERROR - optional error message - if needed, pass by reference
  1.  ;
  1.  ; Example: To update a record in subfile 2.0361 in record with ien=353,
  1.  ;          subrecord ien=68, with the field .01 value = 21:
  1.  ;    S DATA(.01)=21,HLDA=68,HLDA(1)=353 I $$UPD^HLEMU(2.0361,.HLDA,.DATA,.ERROR) W !,"DONE"
  1.  ;
  1.  N FDA,FIELD,IENS,ERRORS
  1.  ;
  1.  ;IENS - Internal Entry Number String defined by FM
  1.  ;FDA - the FDA array as defined by FM
  1.  ;
  1.  I '$G(HLDA) S ERROR="IEN OF RECORD TO BE UPDATED NOT SPECIFIED" Q 0
  1.  S IENS=$$IENS^DILF(.HLDA)
  1.  S FIELD=0
  1.  F  S FIELD=$O(DATA(FIELD)) Q:'FIELD  D
  1.  .S FDA(FILE,IENS,FIELD)=$G(DATA(FIELD))
  1.  D FILE^HLDIE(,"FDA","ERRORS(1)","UPD","HLEMU")
  1.  I +$G(DIERR) D
  1.  .S ERROR=$G(ERRORS(1,"DIERR",1,"TEXT",1))
  1.  E  D
  1.  .S ERROR=""
  1.  ;
  1.  I $S(+$G(DIERR):0,1:1) D CLEAN^DILF Q 1
  1.  E  D CLEAN^DILF Q 0
  1.  ;
  1. GETFIELD(FILE,FIELD,HLDA,ERROR,EXT) ;Get field value from an existing record.
  1.  ; Input:
  1.  ;   FILE - File or sub-file number
  1.  ;   HLDA - New name for traditional DA array, with same meaning.
  1.  ;            Pass by reference.
  1.  ;   FIELD - Field for which value is needed
  1.  ;   EXT - (optional) If $G(EXT) then returns the external display form of the value
  1.  ; Output:
  1.  ;  Function Value -  field value in internal format,"" if an error was encountered
  1.  ;  ERROR - optional error message - if needed, pass by reference
  1.  ;
  1.  N FDA,IENS,ERRORS,VALUE
  1.  ;
  1.  ;IENS - Internal Entry Number String defined by FM
  1.  ;FDA - the FDA array as defined by FM
  1.  ;
  1.  I '$G(HLDA) S ERROR="IEN OF RECORD TO BE UPDATED NOT SPECIFIED" Q ""
  1.  S IENS=$$IENS^DILF(.HLDA)
  1.  S VALUE=$$GET1^DIQ(FILE,IENS,FIELD,$S($G(EXT):"",1:"I"),,"ERRORS(1)")
  1.  I +$G(DIERR) D
  1.  .S ERROR=$G(ERRORS(1,"DIERR",1,"TEXT",1))
  1.  E  D
  1.  .S ERROR=""
  1.  ;
  1.  I $S(+$G(DIERR):0,1:1) D CLEAN^DILF Q VALUE
  1.  E  D CLEAN^DILF Q ""
  1.  ;
  1. DELETE(FILE,DA,ERROR) ;Delete an existing record.
  1.  ; Input:
  1.  ;   FILE - File or sub-file number
  1.  ;   DA - Traditional DA array, with same meaning.
  1.  ;           ** Pass by reference**
  1.  ;
  1.  ; Output:
  1.  ;  Function Value -     0=error and 1=no error
  1.  ;  ERROR - optional error message - if needed, pass by reference
  1.  ;
  1.  ; Example: To delete a record in subfile 2.0361 in record with ien=353,
  1.  ;          subrecord ien=68:
  1.  ;    S DA=68,DA(1)=353 I $$DELETE^HLEMU(2.0361,.DA,.ERROR) W !,"DONE"
  1.  ;
  1.  N DATA
  1.  S DATA(.01)="@"
  1.  Q $$UPD^HLEMU(FILE,.DA,.DATA,.ERROR)
  1.  Q
  1.  ;
  1. ADD(FILE,HLDA,DATA,ERROR,IEN) ;
  1.  ;Description: Creates a new record and files the data.
  1.  ; Input:
  1.  ;   FILE - File or sub-file number
  1.  ;   HLDA - New name for traditional FileMan DA array with same
  1.  ;            meaning. Pass by reference.  Only needed if adding to a
  1.  ;            subfile.
  1.  ;   DATA - Data array to file, pass by reference
  1.  ;          Format: DATA(<field #>)=<value>
  1.  ;   IEN - internal entry number to use (optional)
  1.  ;
  1.  ; Output:
  1.  ;   Function Value - If no error then it returns the ien of the created record, else returns NULL.
  1.  ;  HLDA - returns the ien of the new record, NULL if none created.  If needed, pass by reference.
  1.  ;  ERROR - optional error message - if needed, pass by reference
  1.  ;
  1.  ; Example: Adding a record in subfile 2.0361 in the record with ien=353
  1.  ;          with the field .01 value = 21:
  1.  ;  S DATA(.01)=21,HLDA(1)=353 I $$ADD^HLEMU(2.0361,.HLDA,.DATA) W !,"DONE"
  1.  ;
  1.  ; Example: Creating a record NOT in a subfile:
  1.  ;          S DATA(.01)=21 I $$ADD^HLEMU(867,,.DATA) W !,"DONE"
  1.  ;
  1.  N FDA,FIELD,IENA,IENS,ERRORS
  1.  ;
  1.  ;IENS - Internal Entry Number String defined by FM
  1.  ;IENA - the Internal Entry Numebr Array defined by FM
  1.  ;FDA - the FDA array defined by FM
  1.  ;IEN - the ien of the new record
  1.  ;
  1.  S HLDA="+1"
  1.  S IENS=$$IENS^DILF(.HLDA)
  1.  S FIELD=0
  1.  F  S FIELD=$O(DATA(FIELD)) Q:'FIELD  D
  1.  .S FDA(FILE,IENS,FIELD)=$G(DATA(FIELD))
  1.  I $G(IEN) S IENA(1)=IEN
  1.  D UPDATE^DIE("","FDA","IENA","ERRORS(1)")
  1.  I +$G(DIERR) D
  1.  .S ERROR=$G(ERRORS(1,"DIERR",1,"TEXT",1))
  1.  .S IEN=""
  1.  E  D
  1.  .S IEN=IENA(1)
  1.  .S ERROR=""
  1.  D CLEAN^DILF
  1.  S HLDA=IEN
  1.  Q IEN
  1.  ;
  1. TESTVAL(FILE,FIELD,VALUE) ;
  1.  ;Description: returns 1 if VALUE is a valid value for FIELD in FILE
  1.  ;
  1.  Q:(('$G(FILE))!('$G(FIELD))) 0
  1.  ;
  1.  N DISPLAY,VALID,RESULT
  1.  S VALID=1
  1.  ;
  1.  ;if there is no external value then it is not valid
  1.  S DISPLAY=$$EXTERNAL^DILFD(FILE,FIELD,"F",VALUE)
  1.  I (DISPLAY="") S VALID=0
  1.  ; 
  1.  I VALID,$$GET1^DID(FILE,FIELD,"","TYPE")'["POINTER" D
  1.  .D CHK^DIE(FILE,FIELD,,VALUE,.RESULT) I RESULT="^" S VALID=0 Q
  1.  Q VALID
  1.  ;
  1.  ;Description:  Returns name of logical link for institition, given the institution ien.  Returns "" if a logical link name not found.
  1.  ;
  1.  Q:'$G(INSTIEN) ""
  1.  ;
  1.  N LINK,I,LINKNAME
  1.  S LINKNAME=""
  1.  D
  1.  .D LINK^HLUTIL3(INSTIEN,.LINK)
  1.  .S I=$O(LINK(0))
  1.  .I I,$L(LINK(I)) S LINKNAME=LINK(I)
  1.  Q LINKNAME
  1.  ;
  1. ASKYESNO(PROMPT,DEFAULT) ;
  1.  ;Description: Displays PROMPT, appending '?'.  Expects a YES NO response.
  1.  ;Input:
  1.  ;   PROMPT - text to display as prompt.  Appends '?'
  1.  ;   DEFAULT - (optional) YES or NO.  If not passed, defaults to YES
  1.  ;Output:
  1.  ;  Function value: 1 if yes, 0 if no, "" if '^' entered or timeout
  1.  ;
  1.  N DIR,Y
  1.  S DIR(0)="Y"
  1.  S DIR("A")=PROMPT
  1.  S DIR("B")=$S($G(DEFAULT)="NO":"NO",1:"YES")
  1.  D ^DIR
  1.  Q:$D(DIRUT) ""
  1.  Q Y
  1.  ;
  1. MSGIEN(MSGID) ;
  1.  ;Given the message id, returns the ien from file 773, or 0 on failure.
  1.  Q:'$L($G(MSGID)) 0
  1.  Q $O(^HLMA("C",MSGID,0))
  1.  ;
  1.  ;Given the message ien from file 773, returns the HL Logical Link in the format <link ien>^<link name>
  1.  Q:'$G(MSGIEN) ""
  1.  N LINKIEN
  1.  S LINKIEN=$P($G(^HLMA(MSGIEN,0)),"^",7)
  1.  Q:'LINKIEN 0
  1.  Q LINKIEN_"^"_$P(^HLCS(870,LINKIEN,0),"^")
  1.  ;
  1. HL7EVENT(MSGIEN) ;
  1.  ;Given the message ien from file 773, returns the 3 character HL7 event type
  1.  Q:'$G(MSGIEN) ""
  1.  N EVENT
  1.  S EVENT=$P($G(^HLMA(MSGIEN,0)),"^",14)
  1.  Q:'EVENT ""
  1.  Q $P(^HL(779.001,EVENT,0),"^")
  1.  ;
  1. MSGTYPE(MSGIEN) ;
  1.  ;Given the message ien from file 773, returns the 3 character HL7 message type
  1.  Q:'$G(MSGIEN) ""
  1.  N MSG
  1.  S MSG=$P($G(^HLMA(MSGIEN,0)),"^",13)
  1.  Q:'MSG ""
  1.  Q $P(^HL(771.2,MSG,0),"^")
  1.  ;
  1. APP(MSGIEN) ;
  1.  ;Given the message ien from file 773, returns the name of the sending application from file 771
  1.  ;
  1.  Q:'$G(MSGIEN)
  1.  N APPIEN
  1.  S APPIEN=$P($G(^HLMA(MSGIEN,0)),"^",11)
  1.  Q $$APPNAME(APPIEN)
  1.  ;
  1. APPNAME(APPIEN) ;
  1.  ;Given an ien to the HL7 Application Parameter file (#771), it returns the NAME (field .01)
  1.  Q $S('APPIEN:"",1:$P($G(^HL(771,APPIEN,0)),"^"))
  1.  ;
  1. PROMPT(FILE,FIELD,DEFAULT,RESPONSE,REQUIRE) ;
  1.  ;Description: requests user to enter a single field value.
  1.  ;Input:
  1.  ;  FILE - the file #
  1.  ;  FIELD - the field #
  1.  ;  DEFAULT - default value, internal form
  1.  ;  REQUIRE - a flag, (+value)'=0 means to require a value to be
  1.  ;            entered and to return failure otherwise (optional)
  1.  ;Output:
  1.  ;  Function Value - 0 on failure, 1 on success
  1.  ;  RESPONSE - value entered by user, pass by reference
  1.  ;
  1.  Q:(('$G(FILE))!('$G(FIELD))) 0
  1.  S REQUIRE=$G(REQUIRE)
  1.  N DIR,DA,QUIT,AGAIN
  1.  ;
  1.  S DIR(0)=FILE_","_FIELD_$S($G(REQUIRE):"",1:"O")_"AO"
  1.  S:$G(DEFAULT)'="" DIR("A")=$$GET1^DID(FILE,FIELD,"","LABEL")_": "_$$EXTERNAL^DILFD(FILE,FIELD,"F",DEFAULT)_"// "
  1.  S QUIT=0
  1.  F  D  Q:QUIT
  1.  . D ^DIR
  1.  . I $D(DTOUT)!$D(DUOUT) S QUIT=1 Q
  1.  . I X="@" D  Q:AGAIN
  1.  . . S AGAIN=0
  1.  . . I 'REQUIRE,"Yy"'[$E($$ASKYESNO("  Are you sure")_"X") S AGAIN=1 Q
  1.  . . S RESPONSE="" ; This might trigger the "required" message below.
  1.  . E  I X="" S RESPONSE=$G(DEFAULT)
  1.  . E  S RESPONSE=$P(Y,"^")
  1.  . ;
  1.  . ; quit this loop if the user entered value OR value not required
  1.  . I RESPONSE'="" S QUIT=1 Q
  1.  . I 'REQUIRE S QUIT=1 Q
  1.  . W !,"This is a required response. Enter '^' to exit"
  1.  I $D(DTOUT)!$D(DUOUT) Q 0
  1.  Q 1
  1. I(VAR,N) ;This funtion increments the local or global variable by the amount N
  1.  ;Input:
  1.  ;  VAR - a string representing the name of a local or global variable to be referenced by indirection
  1.  ;  N - a number to increment @VAR by.  If not passed it is set to 1
  1.  ;OUTPUT
  1.  ;    @VAR is incremented by the amount N and also returned as the function value
  1.  ;
  1.  N X
  1.  I VAR["^" L +VAR:1
  1.  I '$G(N) S N=1
  1.  S X=$G(@VAR)+N
  1.  S @VAR=X
  1.  I VAR["^" L -VAR
  1.  Q X
  1.  ;
  1. INC(VAR,N) ;This funtion increments the local variable by the amount N
  1.  ;Input:
  1.  ;  VAR - a local or global variable passed by reference
  1.  ;  N - a number to increment VAR by.  If not passed or =0 it is set to 1
  1.  ;OUTPUT
  1.  ;    VAR is incremented by the amount N and also returned as the function value
  1.  ;
  1.  I '$G(N) S N=1
  1.  S VAR=$G(VAR)+N
  1.  Q VAR