RGFIU ;ALB/CJM-MPI/PD NDBI MERGE UTILITY (CONTINUED) ;08/27/99
;;1.0;CLINICAL INFO RESOURCE NETWORK;**5,13,25**;30 Apr 99
;
STATNUM(IEN) ;
;Description: Given an ien to the Institution file, returns as the function value the station number. Returns "" on failure.
;
N STATION
Q:'$G(IEN) ""
Q:'$D(^DIC(4,IEN,0)) ""
S STATION=$P($$NNT^XUAF4(IEN),"^",2)
Q $S(+STATION:STATION,1:"")
;
UPD(FILE,RGDA,DATA,ERROR) ;File data into an existing record.
; Input:
; FILE - File or sub-file number
; RGDA - 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,RGDA=68,RGDA(1)=353 I $$UPD^RGFIU(2.0361,.RGDA,.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(RGDA) S ERROR="IEN OF RECORD TO BE UPDATED NOT SPECIFIED" Q 0
S IENS=$$IENS^DILF(.RGDA)
S FIELD=0
F S FIELD=$O(DATA(FIELD)) Q:'FIELD D
.S FDA(FILE,IENS,FIELD)=$G(DATA(FIELD))
D FILE^DIE("K","FDA","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 1
E D CLEAN^DILF Q 0
;
GETFIELD(FILE,FIELD,RGDA,ERROR,EXT) ;Get field value from an existing record.
; Input:
; FILE - File or sub-file number
; RGDA - 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(RGDA) S ERROR="IEN OF RECORD TO BE UPDATED NOT SPECIFIED" Q ""
S IENS=$$IENS^DILF(.RGDA)
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,RGDA,ERROR) ;Delete an existing record.
; Input:
; FILE - File or sub-file number
; RGDA - New name for 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 RGDA=68,RGDA(1)=353 I $$DELETE^RGFIU(2.0361,.RGDA,.DATA,.ERROR) W !,"DONE"
;
N DATA
S DATA(.01)="@"
Q $$UPD^RGFIU(FILE,.RGDA,.DATA,.ERROR)
Q
;
ADD(FILE,RGDA,DATA,ERROR,IEN) ;
;Description: Creates a new record and files the data.
; Input:
; FILE - File or sub-file number
; RGDA - 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.
; RGDA - 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: To add a record in subfile 2.0361 in the record with ien=353
; with the field .01 value = 21:
; S DATA(.01)=21,RGDA(1)=353 I $$ADD^RGFIU(2.0361,.RGDA,.DATA) W !,"DONE"
;
; Example: If creating a record not in a subfile, would look like this:
; S DATA(.01)=21 I $$ADD^RGFIU(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 RGDA="+1"
S IENS=$$IENS^DILF(.RGDA)
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 RGDA=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
.;don't check if enabled - if shut down, message will be queued
.;Q:'$$CHKLL^HLUTIL(INSTIEN)
.;
.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
;
EXC(RGEXC,RGERR,RGDFN,RGMSGID,RGSITE) ;
;Description: Calls the MPI/PD Exception Handler
;Inputs:
; RGEXC - the exception type
; RGERR - (optional) text
; RGDFN - (optional) patient DFN
; RGMSGID - (optional) HL7 message id
; RGSITE - (optional) station # of site where the exception occurred
N ICN
I +$G(RGDFN) D
.S ICN=+$$GETICN^MPIF001(RGDFN)
.I ICN'>0 S ICN=""
.S RGERR=$G(RGERR)_" Patient Name: "_$E($$NAME(RGDFN),1,25)_" SSN: "_$$SSN(RGDFN)_" ICN: "_ICN
D EXC^RGHLLOG($G(RGEXC),$E($G(RGERR),1,235),$G(RGDFN),$G(RGMSGID),$G(RGSITE))
Q
;
SSN(DFN) ;
;Description: Function returns the patient's SSN, or "" on failure.
Q $$GETFIELD(2,.09,.DFN)
;
NAME(DFN) ;
;Description: Function returns the patient's NAME, or "" on failure.
Q $$GETFIELD(2,.01,.DFN)
;
ICN(DFN) ;Return patient ICN
NEW RESULT
S RESULT=+$$GETICN^MPIF001($G(DFN))
I RESULT<0 Q ""
Q +RESULT
;
DFN(ICN) ;Return patient IEN
NEW RESULT
I ICN'="" S ICN=+ICN
S RESULT=$$GETDFN^MPIF001($G(ICN))
I RESULT<0 Q ""
Q RESULT
;
MPINODE(DFN) ;
N NODE
S NODE=$$MPINODE^MPIFAPI($G(DFN))
I +NODE=-1 S NODE=""
Q NODE
;
GETALL(DFN,MPIDATA) ;
;Descripition: Gets the MPI data and treating facility list
;
;Input:
; DFN - patient ien
;Output:
; MPIDATA - output array (pass by reference)
; "ICN") = <ICN>
; "CHKSUM") = <ICN checksum>
; "LOC") = <1 if ICN is local, 0 if national>
; "CMOR") = <station number of CMOR>
; "TF",<station number of TF>,"INSTIEN")=<ien of treating facility in Institution file>
; "TF",<station number of TF>,"LASTDATE")=<date last treated>
; "TF",<station number of TF>,"EVENT")=<ADT event reason (a pointer)>
; "SUB") = <ien of subscriber list>
;
N NODE,IEN,STAT,INST,LINK,I,HLL
;
K MPIDATA
;
;get MPI data
S NODE=$$MPINODE^RGFIU(DFN)
S MPIDATA("ICN")=$P(NODE,"^"),MPIDATA("CHKSUM")=$P(NODE,"^",2),MPIDATA("LOC")=$P(NODE,"^",4),MPIDATA("CMOR")=$$STATNUM^RGFIU($P(NODE,"^",3)),MPIDATA("SUB")=$P(NODE,"^",5)
;
;get TF list
I MPIDATA("ICN") D
.N ARRAY,ITEM,NODE,STAT
.Q:$$QUERYTF^VAFCTFU1(MPIDATA("ICN"),"ARRAY")
.S ITEM=0
.F S ITEM=$O(ARRAY(ITEM)) Q:'ITEM D
..S NODE=ARRAY(ITEM)
..S STAT=$$STATNUM^RGFIU($P(NODE,"^"))
..Q:'STAT
..S MPIDATA("TF",STAT,"INSTIEN")=$P(NODE,"^",1)
..S MPIDATA("TF",STAT,"LASTDATE")=$P(NODE,"^",2)
..S MPIDATA("TF",STAT,"EVENT")=$P(NODE,"^",3)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGFIU 8643 printed Apr 09, 2024@20:46:28 Page 2
RGFIU ;ALB/CJM-MPI/PD NDBI MERGE UTILITY (CONTINUED) ;08/27/99
+1 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**5,13,25**;30 Apr 99
+2 ;
STATNUM(IEN) ;
+1 ;Description: Given an ien to the Institution file, returns as the function value the station number. Returns "" on failure.
+2 ;
+3 NEW STATION
+4 if '$GET(IEN)
QUIT ""
+5 if '$DATA(^DIC(4,IEN,0))
QUIT ""
+6 SET STATION=$PIECE($$NNT^XUAF4(IEN),"^",2)
+7 QUIT $SELECT(+STATION:STATION,1:"")
+8 ;
UPD(FILE,RGDA,DATA,ERROR) ;File data into an existing record.
+1 ; Input:
+2 ; FILE - File or sub-file number
+3 ; RGDA - 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,RGDA=68,RGDA(1)=353 I $$UPD^RGFIU(2.0361,.RGDA,.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(RGDA)
SET ERROR="IEN OF RECORD TO BE UPDATED NOT SPECIFIED"
QUIT 0
+22 SET IENS=$$IENS^DILF(.RGDA)
+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^DIE("K","FDA","ERRORS(1)")
+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,RGDA,ERROR,EXT) ;Get field value from an existing record.
+1 ; Input:
+2 ; FILE - File or sub-file number
+3 ; RGDA - 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(RGDA)
SET ERROR="IEN OF RECORD TO BE UPDATED NOT SPECIFIED"
QUIT ""
+17 SET IENS=$$IENS^DILF(.RGDA)
+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,RGDA,ERROR) ;Delete an existing record.
+1 ; Input:
+2 ; FILE - File or sub-file number
+3 ; RGDA - New name for 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 RGDA=68,RGDA(1)=353 I $$DELETE^RGFIU(2.0361,.RGDA,.DATA,.ERROR) W !,"DONE"
+13 ;
+14 NEW DATA
+15 SET DATA(.01)="@"
+16 QUIT $$UPD^RGFIU(FILE,.RGDA,.DATA,.ERROR)
+17 QUIT
+18 ;
ADD(FILE,RGDA,DATA,ERROR,IEN) ;
+1 ;Description: Creates a new record and files the data.
+2 ; Input:
+3 ; FILE - File or sub-file number
+4 ; RGDA - 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 ; RGDA - 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: To add a record in subfile 2.0361 in the record with ien=353
+17 ; with the field .01 value = 21:
+18 ; S DATA(.01)=21,RGDA(1)=353 I $$ADD^RGFIU(2.0361,.RGDA,.DATA) W !,"DONE"
+19 ;
+20 ; Example: If creating a record not in a subfile, would look like this:
+21 ; S DATA(.01)=21 I $$ADD^RGFIU(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 RGDA="+1"
+31 SET IENS=$$IENS^DILF(.RGDA)
+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 RGDA=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 ;don't check if enabled - if shut down, message will be queued
+9 ;Q:'$$CHKLL^HLUTIL(INSTIEN)
+10 ;
+11 DO LINK^HLUTIL3(INSTIEN,.LINK)
+12 SET I=$ORDER(LINK(0))
+13 IF I
IF $LENGTH(LINK(I))
SET LINKNAME=LINK(I)
End DoDot:1
+14 QUIT LINKNAME
+15 ;
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 ;
EXC(RGEXC,RGERR,RGDFN,RGMSGID,RGSITE) ;
+1 ;Description: Calls the MPI/PD Exception Handler
+2 ;Inputs:
+3 ; RGEXC - the exception type
+4 ; RGERR - (optional) text
+5 ; RGDFN - (optional) patient DFN
+6 ; RGMSGID - (optional) HL7 message id
+7 ; RGSITE - (optional) station # of site where the exception occurred
+8 NEW ICN
+9 IF +$GET(RGDFN)
Begin DoDot:1
+10 SET ICN=+$$GETICN^MPIF001(RGDFN)
+11 IF ICN'>0
SET ICN=""
+12 SET RGERR=$GET(RGERR)_" Patient Name: "_$EXTRACT($$NAME(RGDFN),1,25)_" SSN: "_$$SSN(RGDFN)_" ICN: "_ICN
End DoDot:1
+13 DO EXC^RGHLLOG($GET(RGEXC),$EXTRACT($GET(RGERR),1,235),$GET(RGDFN),$GET(RGMSGID),$GET(RGSITE))
+14 QUIT
+15 ;
SSN(DFN) ;
+1 ;Description: Function returns the patient's SSN, or "" on failure.
+2 QUIT $$GETFIELD(2,.09,.DFN)
+3 ;
NAME(DFN) ;
+1 ;Description: Function returns the patient's NAME, or "" on failure.
+2 QUIT $$GETFIELD(2,.01,.DFN)
+3 ;
ICN(DFN) ;Return patient ICN
+1 NEW RESULT
+2 SET RESULT=+$$GETICN^MPIF001($GET(DFN))
+3 IF RESULT<0
QUIT ""
+4 QUIT +RESULT
+5 ;
DFN(ICN) ;Return patient IEN
+1 NEW RESULT
+2 IF ICN'=""
SET ICN=+ICN
+3 SET RESULT=$$GETDFN^MPIF001($GET(ICN))
+4 IF RESULT<0
QUIT ""
+5 QUIT RESULT
+6 ;
MPINODE(DFN) ;
+1 NEW NODE
+2 SET NODE=$$MPINODE^MPIFAPI($GET(DFN))
+3 IF +NODE=-1
SET NODE=""
+4 QUIT NODE
+5 ;
GETALL(DFN,MPIDATA) ;
+1 ;Descripition: Gets the MPI data and treating facility list
+2 ;
+3 ;Input:
+4 ; DFN - patient ien
+5 ;Output:
+6 ; MPIDATA - output array (pass by reference)
+7 ; "ICN") = <ICN>
+8 ; "CHKSUM") = <ICN checksum>
+9 ; "LOC") = <1 if ICN is local, 0 if national>
+10 ; "CMOR") = <station number of CMOR>
+11 ; "TF",<station number of TF>,"INSTIEN")=<ien of treating facility in Institution file>
+12 ; "TF",<station number of TF>,"LASTDATE")=<date last treated>
+13 ; "TF",<station number of TF>,"EVENT")=<ADT event reason (a pointer)>
+14 ; "SUB") = <ien of subscriber list>
+15 ;
+16 NEW NODE,IEN,STAT,INST,LINK,I,HLL
+17 ;
+18 KILL MPIDATA
+19 ;
+20 ;get MPI data
+21 SET NODE=$$MPINODE^RGFIU(DFN)
+22 SET MPIDATA("ICN")=$PIECE(NODE,"^")
SET MPIDATA("CHKSUM")=$PIECE(NODE,"^",2)
SET MPIDATA("LOC")=$PIECE(NODE,"^",4)
SET MPIDATA("CMOR")=$$STATNUM^RGFIU($PIECE(NODE,"^",3))
SET MPIDATA("SUB")=$PIECE(NODE,"^",5)
+23 ;
+24 ;get TF list
+25 IF MPIDATA("ICN")
Begin DoDot:1
+26 NEW ARRAY,ITEM,NODE,STAT
+27 if $$QUERYTF^VAFCTFU1(MPIDATA("ICN"),"ARRAY")
QUIT
+28 SET ITEM=0
+29 FOR
SET ITEM=$ORDER(ARRAY(ITEM))
if 'ITEM
QUIT
Begin DoDot:2
+30 SET NODE=ARRAY(ITEM)
+31 SET STAT=$$STATNUM^RGFIU($PIECE(NODE,"^"))
+32 if 'STAT
QUIT
+33 SET MPIDATA("TF",STAT,"INSTIEN")=$PIECE(NODE,"^",1)
+34 SET MPIDATA("TF",STAT,"LASTDATE")=$PIECE(NODE,"^",2)
+35 SET MPIDATA("TF",STAT,"EVENT")=$PIECE(NODE,"^",3)
End DoDot:2
End DoDot:1
+36 QUIT
