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