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

RGFIU.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1. STATNUM(IEN) ;
  1.  ;Description:  Given an ien to the Institution file, returns as the function value the station number.  Returns "" on failure.
  1.  ;
  1.  N STATION
  1.  Q:'$G(IEN) ""
  1.  Q:'$D(^DIC(4,IEN,0)) ""
  1.  S STATION=$P($$NNT^XUAF4(IEN),"^",2)
  1.  Q $S(+STATION:STATION,1:"")
  1.  ;
  1. UPD(FILE,RGDA,DATA,ERROR) ;File data into an existing record.
  1.  ; Input:
  1.  ;   FILE - File or sub-file number
  1.  ;   RGDA - 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,RGDA=68,RGDA(1)=353 I $$UPD^RGFIU(2.0361,.RGDA,.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(RGDA) S ERROR="IEN OF RECORD TO BE UPDATED NOT SPECIFIED" Q 0
  1.  S IENS=$$IENS^DILF(.RGDA)
  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^DIE("K","FDA","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 1
  1.  E  D CLEAN^DILF Q 0
  1.  ;
  1. GETFIELD(FILE,FIELD,RGDA,ERROR,EXT) ;Get field value from an existing record.
  1.  ; Input:
  1.  ;   FILE - File or sub-file number
  1.  ;   RGDA - 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(RGDA) S ERROR="IEN OF RECORD TO BE UPDATED NOT SPECIFIED" Q ""
  1.  S IENS=$$IENS^DILF(.RGDA)
  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,RGDA,ERROR) ;Delete an existing record.
  1.  ; Input:
  1.  ;   FILE - File or sub-file number
  1.  ;   RGDA - New name for 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 RGDA=68,RGDA(1)=353 I $$DELETE^RGFIU(2.0361,.RGDA,.DATA,.ERROR) W !,"DONE"
  1.  ;
  1.  N DATA
  1.  S DATA(.01)="@"
  1.  Q $$UPD^RGFIU(FILE,.RGDA,.DATA,.ERROR)
  1.  Q
  1.  ;
  1. ADD(FILE,RGDA,DATA,ERROR,IEN) ;
  1.  ;Description: Creates a new record and files the data.
  1.  ; Input:
  1.  ;   FILE - File or sub-file number
  1.  ;   RGDA - 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.  ;  RGDA - 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: To add a record in subfile 2.0361 in the record with ien=353
  1.  ;          with the field .01 value = 21:
  1.  ;  S DATA(.01)=21,RGDA(1)=353 I $$ADD^RGFIU(2.0361,.RGDA,.DATA) W !,"DONE"
  1.  ;
  1.  ; Example: If creating a record not in a subfile, would look like this:
  1.  ;          S DATA(.01)=21 I $$ADD^RGFIU(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 RGDA="+1"
  1.  S IENS=$$IENS^DILF(.RGDA)
  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 RGDA=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.  .;don't check if enabled - if shut down, message will be queued
  1.  .;Q:'$$CHKLL^HLUTIL(INSTIEN)
  1.  .;
  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. EXC(RGEXC,RGERR,RGDFN,RGMSGID,RGSITE) ;
  1.  ;Description: Calls the MPI/PD Exception Handler
  1.  ;Inputs:
  1.  ;  RGEXC - the exception type
  1.  ;  RGERR - (optional) text
  1.  ;  RGDFN - (optional) patient DFN
  1.  ;  RGMSGID - (optional) HL7 message id
  1.  ;  RGSITE - (optional) station # of site where the exception occurred
  1.  N ICN
  1.  I +$G(RGDFN) D
  1.  .S ICN=+$$GETICN^MPIF001(RGDFN)
  1.  .I ICN'>0 S ICN=""
  1.  .S RGERR=$G(RGERR)_"  Patient Name: "_$E($$NAME(RGDFN),1,25)_" SSN: "_$$SSN(RGDFN)_"  ICN: "_ICN
  1.  D EXC^RGHLLOG($G(RGEXC),$E($G(RGERR),1,235),$G(RGDFN),$G(RGMSGID),$G(RGSITE))
  1.  Q
  1.  ;
  1. SSN(DFN) ;
  1.  ;Description: Function returns the patient's SSN, or "" on failure.
  1.  Q $$GETFIELD(2,.09,.DFN)
  1.  ;
  1. NAME(DFN) ;
  1.  ;Description: Function returns the patient's NAME, or "" on failure.
  1.  Q $$GETFIELD(2,.01,.DFN)
  1.  ;
  1. ICN(DFN) ;Return patient ICN
  1.  NEW RESULT
  1.  S RESULT=+$$GETICN^MPIF001($G(DFN))
  1.  I RESULT<0 Q ""
  1.  Q +RESULT
  1.  ;
  1. DFN(ICN) ;Return patient IEN
  1.  NEW RESULT
  1.  I ICN'="" S ICN=+ICN
  1.  S RESULT=$$GETDFN^MPIF001($G(ICN))
  1.  I RESULT<0 Q ""
  1.  Q RESULT
  1.  ;
  1. MPINODE(DFN) ;
  1.  N NODE
  1.  S NODE=$$MPINODE^MPIFAPI($G(DFN))
  1.  I +NODE=-1 S NODE=""
  1.  Q NODE
  1.  ;
  1. GETALL(DFN,MPIDATA) ;
  1.  ;Descripition: Gets the MPI data and treating facility list
  1.  ;
  1.  ;Input:
  1.  ;   DFN - patient ien
  1.  ;Output:
  1.  ;   MPIDATA       - output array (pass by reference)
  1.  ;       "ICN") = <ICN>
  1.  ;       "CHKSUM") = <ICN checksum>
  1.  ;       "LOC") = <1 if ICN is local, 0 if national>
  1.  ;       "CMOR") = <station number of CMOR>
  1.  ;       "TF",<station number of TF>,"INSTIEN")=<ien of treating facility in Institution file>
  1.  ;       "TF",<station number of TF>,"LASTDATE")=<date last treated>
  1.  ;       "TF",<station number of TF>,"EVENT")=<ADT event reason (a pointer)>
  1.  ;       "SUB") = <ien of subscriber list>
  1.  ;
  1.  N NODE,IEN,STAT,INST,LINK,I,HLL
  1.  ;
  1.  K MPIDATA
  1.  ;
  1.  ;get MPI data
  1.  S NODE=$$MPINODE^RGFIU(DFN)
  1.  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)
  1.  ;
  1.  ;get TF list
  1.  I MPIDATA("ICN") D
  1.  .N ARRAY,ITEM,NODE,STAT
  1.  .Q:$$QUERYTF^VAFCTFU1(MPIDATA("ICN"),"ARRAY")
  1.  .S ITEM=0
  1.  .F  S ITEM=$O(ARRAY(ITEM)) Q:'ITEM  D
  1.  ..S NODE=ARRAY(ITEM)
  1.  ..S STAT=$$STATNUM^RGFIU($P(NODE,"^"))
  1.  ..Q:'STAT
  1.  ..S MPIDATA("TF",STAT,"INSTIEN")=$P(NODE,"^",1)
  1.  ..S MPIDATA("TF",STAT,"LASTDATE")=$P(NODE,"^",2)
  1.  ..S MPIDATA("TF",STAT,"EVENT")=$P(NODE,"^",3)
  1.  Q