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