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

INHUT1.m

Go to the documentation of this file. 
  1. INHUT1 ; FRW,DGH ; 10 Jun 99 14:37; HL7 utilities 
  1.  ;;3.01;BHL IHS Interfaces with GIS;**16**;JUL 01, 2001
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  ;
  1.  ;NO LINETAGS IN THIS ROUTINE ARE SUPPORTED FOR EXECUTION BY ANY
  1.  ;SOFTWARE OUTSIDE THE GIS PACKAGE (IN*)
  1.  ;
  1. CE(INTCE,FILE,CODE,INDELIMS,INENC,INDIR) ;Entry point
  1.  ;INPUT:
  1.  ; INTCE - Coded element in format ien or ien;file
  1.  ; FILE  - File number in format NN or global ref in format ^GL(
  1.  ; CODE  - Coding system
  1.  ; INDELIMS - Delimeter values 
  1.  ; INENC - 0 don't encode, 1 Encode
  1.  ; INDIR - O Outbound, I Inbound 
  1.  ;OUTPUT:
  1.  ;  ien\value\coding system
  1.  ;  note: the actual delimiter may not be "\"
  1.  ;
  1.  Q:'INTCE ""
  1.  N DLM,CE,MAP,GL,GLO,OUT,X,Y,%
  1.  S DLM=$S($L($G(INSUBDEL)):INSUBDEL,1:$$COMP^INHUT),CODE=$G(CODE)
  1.  ;if INTCE format ien;file or ien;file;coding, over-ride other PARAMETERS
  1.  I INTCE[";" S FILE=$P(INTCE,";",2) S:$L(INTCE,";")=3 CODE=$P(INTCE,";",3) S INTCE=$P(INTCE,";")
  1.  ;if FILE is in "^GL(" format, set GL=FILE, convert FILE to number
  1.  I $E(FILE,1,1)="^" S GL=FILE,GLO=FILE_"0)",GLO=$G(@GLO),FILE=+$P(GLO,U,2)
  1.  ;if FILE and CODE are null, quit. If CODE exists, pass as 3rd piece
  1.  I FILE="",CODE="" Q +INTCE
  1.  Q:FILE="" +INTCE_DLM_DLM_CODE
  1.  ;Verify that FILE is valid. If not, quit
  1.  I '$D(^DIC(FILE)),CODE="" Q +INTCE
  1.  Q:'$D(^DIC(FILE)) +INTCE_DLM_DLM_CODE
  1.  ;remaining code will only be executed if FILE is input and valid
  1.  ;NOTE - This will only get the first map function for the file, 
  1.  ;       even if there are multiple map funcitons for the file.
  1.  S MAP=$O(^INVD(4090.2,"D",FILE,""))
  1.  ;If CODE provided as input, it takes precedence. 
  1.  ;otherwise determine coding system, if identified
  1.  I CODE="",MAP'="" S CODE=$P(^INVD(4090.2,MAP,0),U,7)
  1.  ;
  1.  ;If FILE entered as file number, determine GL here
  1.  I '$D(GL) S GL=^DIC(FILE,0,"GL")
  1.  S GL=GL_+INTCE_",0)"
  1.  ;If encoded character conversion required
  1.  S:$G(INENC) CODE=$$SUBESC^INHUT7(CODE,.INDELIMS,.INDIR)
  1.  Q:'$D(@GL) +INTCE_$S('$L(CODE):"",1:DLM_DLM_CODE)
  1.  ;NEED TO NAVIGATE FARTHER IF .01 FIELD IS A POINTER
  1.  S CE=@GL,CE=$TR($P(CE,U),DLM)
  1.  ;If encoded character conversion required
  1.  S:$G(INENC) CE=$$SUBESC^INHUT7(CE,.INDELIMS,.INDIR)
  1.  S OUT=+INTCE_DLM_CE
  1.  ;
  1.  S:CODE'="" OUT=OUT_DLM_CODE
  1.  ;
  1.  Q OUT
  1.  ;
  1. CM(INTCE,FILE,CODE,INDELIMS,INENC,INDIR) ;Entry point to transform to composite data type
  1.  ;INPUT:   same as CE module
  1.  ;OUTPUT:
  1.  ;  internal value (i.e. .001 field) \ external value (i.e. .01 field)
  1.  ;
  1.  N % S %=$$CE(INTCE,$G(FILE),"",.INDELIMS,.INENC,.INDIR) Q:'$L(%) ""
  1.  S %=$P(%,INSUBDEL,1,2)
  1.  Q %
  1.  ;
  1. CN(INTCE,FILE,CODE,INDELIMS,INENC,INDIR) ;Entry point to transform to composite data type
  1.  ;INPUT:   same as CE module
  1.  ;OUTPUT:
  1.  ;  internal value (i.e. .001 field) \ formatted person name
  1.  ;
  1.  N %
  1.  S %=$$CE(INTCE,$G(FILE),$G(CODE),.INDELIMS,.INENC,.INDIR) Q:'$L(%) ""
  1.  S $P(%,INSUBDEL,2)=$$PN($P(%,INSUBDEL,2))
  1.  Q %
  1.  ;
  1. PN(N,INDELIMS,INENC,INDIR) ;Transform person name to HL7 formatted person name
  1.  ;INPUT:
  1.  ; N - name in format LAST,FIRST MI
  1.  ; INDELIMS - Delimeter values
  1.  ; INENC - 0 Don't encode, 1 Encode
  1.  ; INDIR - O Outbound
  1.  ;OUTPUT:
  1.  ; function - name in format LAST\FIRST\MI
  1.  ;
  1.  Q:'$L(N) ""
  1.  N N0,N1,N2
  1.  S N0=$P(N,","),N1=$P($P(N,",",2)," ",2,99),N2=$P($P(N,",",2)," ")
  1.  ;If encoded character conversion required
  1.  I $G(INENC) D
  1.  .S N0=$$SUBESC^INHUT7(N0,.INDELIMS,.INDIR)
  1.  .S N1=$$SUBESC^INHUT7(N1,.INDELIMS,.INDIR)
  1.  .S N2=$$SUBESC^INHUT7(N2,.INDELIMS,.INDIR)
  1.  S N=N0_INSUBDEL_N2
  1.  S N=N_INSUBDEL_$P(N1," ",1)_INSUBDEL_$P(N1," ",2)_INSUBDEL_INSUBDEL
  1.  Q N
  1.  ;
  1. HLPN(X,INSUBDEL,INDELIMS,INENC,INDIR)   ;Transform HL7 formatted person name to person name
  1.  ;INPUT:
  1.  ; X - name in format LAST\FIRST\MI\SUFFIX (req)
  1.  ; INSUBDEL - HL7 component delimiter (req)
  1.  ; INDELIMS - Delimeter values
  1.  ; INENC - 0 Don't encode, 1 Encode
  1.  ; INDIR - I Inbound 
  1.  ;OUTPUT:
  1.  ;  function - name in format LAST,FIRST MI SU
  1.  ;
  1.  Q:'$L(X) ""
  1.  S X=$TR(X,".","")
  1.  S X=$P(X,INSUBDEL)_","_$P(X,INSUBDEL,2)_$S($P(X,INSUBDEL,3)]"":" "_$P(X,INSUBDEL,3),1:"")_$S($P(X,INSUBDEL,4)]"":" "_$P(X,INSUBDEL,4),1:"")_$S($P(X,INSUBDEL,5)]"":" "_$P(X,INSUBDEL,5),1:"")
  1.  S:$G(INENC) X=$$SUBESC^INHUT7(X,.INDELIMS,.INDIR)
  1.  Q X
  1.  ;
  1. DT(X) ;Transform date format to HL7 date format
  1.  ;INPUT:
  1.  ;   X  - date/time in any fileman or external format
  1.  ;OUPUT:
  1.  ;   function - date in HL7 format
  1.  ;
  1.  Q:'$L(X) "" N Y,%DT S %DT="ST" D ^%DT Q:Y<0 ""
  1.  S X=$E(Y,1,3)+1700_$E(Y,4,7)
  1.  Q X
  1.  ;
  1. TS(X) ;Transform date to HL7 time stamp format
  1.  ;INPUT:
  1.  ;   X  - date/time in any fileman or external format
  1.  ;OUPUT:
  1.  ;   function - date/time in HL7 format
  1.  ;
  1.  Q $$TS^INHUT10(X)
  1.  ;
  1. FDT(X,TS) ;Transform date format to HL7 date format
  1.  ;INPUT:
  1.  ;   X  - date/time in any fileman or external format
  1.  ;   TS - control variable
  1.  ;OUPUT:
  1.  ;   function - date in HL7 format
  1.  ;
  1.  Q:'$L(X) "" S TS=$G(TS)
  1.  N Y,%DT S %DT="ST" D ^%DT Q:Y<0 ""
  1.  Q:TS'["T" $E(Y,1,3)+1700_$E(Y,4,7)
  1.  ;Ignores +/- Zulu offsets and time zone differences
  1.  S X=$P(Y,".",2) S:X=24 X=""
  1.  S X=$E(Y,1,3)+1700_$E(Y,4,7)_$E(X_"000000",1,6)
  1.  Q X
  1.  ;
  1. HDT(X,INTS,INVA) ;Transform HL7 date format to internal fileman format
  1.  ;INPUT:
  1.  ;   X  - HL7 date/time
  1.  ;           format- ( YYYYMMDDHHMM[SS[.SSSS]][+/-ZZZZ] \ precision )
  1.  ;   INTS - control variable 
  1.  ;          used as %DT if data is validated
  1.  ;              T - time allowed ; S - seconds allowed
  1.  ;   INVA - validate data (1 - yes ; 0 - no (def))
  1.  ;OUPUT:
  1.  ;   function - date in internal fileman format
  1.  ;   X - date in internal fileman format (pass by reference)
  1.  ;   INVA - valid data (1 valid ; 0 - invalid))
  1.  ;
  1.  Q $$HDT^INHUT10(X,$G(INTS),$G(INVA))
  1.  ;
  1. CL(X,INDELIMS,INENC,INDIR) ;Transform to coded location
  1.  ;INPUT:
  1.  ; INDELIMS - Delimeter values 
  1.  ; INENC - 0 don't encode 1 encode
  1.  ; INDIR - O Outbound, I Inbound 
  1.  ;
  1.  Q:'$L(X) ""
  1.  N INCL1,INCL2
  1.  S INCL1=+X,INCL2=$P(X,";",2)
  1.  ;If no division get Division (#3.5) from Hosp Loc file (#40.8)
  1.  S:'INCL2 INCL2=$P($G(^SC(+INCL1,0)),U,15)
  1.  ;Transform location and division to coded elements
  1.  S INCL2=$$CE(INCL2_";40.8","","",.INDELIMS,.INENC,.INDIR),INCL1=$$CE(INCL1_";44","","",.INDELIMS,.INENC,.INDIR)
  1.  ;Check for division only
  1.  I '$L(INCL1),$L(INCL2) S INCL1=INSUBDEL_INSUBDEL
  1.  Q INCL1_INSUBDEL_INCL2
  1.  ;
  1. CC(X,INDELIMS,INENC,INDIR) ;Transform to charge code
  1.  ; INDELIMS - Delimeter values 
  1.  ; INENC - 0 don't encode 1 encode
  1.  ; INDIR - O Outbound, I Inbound 
  1.  ;
  1.  Q:'$L(X) ""
  1.  ;Transform MEPRS to coded element
  1.  N INCL1,INCL2
  1.  S INCL1=$$CE(+X_";8119","","",.INDELIMS,.INENC,.INDIR)
  1.  S INCL2=$P(X,";",2)
  1.  ;encoded character
  1.  I $G(INENC) S INCL2=$$SUBESC^INHUT7(INCL2,.INDELIMS,.INDIR)
  1.  Q INCL2_$S($L(INCL1):INSUBDEL,1:"")_INCL1
  1.  ;
  1. CRB(X,INDELIMS,INENC,INDIR) ;Transform to code room-bed location
  1.  ;
  1.  Q:'$L($TR(X,";")) ""
  1.  N D,B,W,WI
  1.  S B=$P(X,";",1),WI=$P(X,";",2),(D,W)=""
  1.  ;
  1.  ;If ward indicated then transform to CE and get MTF Code
  1.  I WI D
  1.  .;Transform to CE data type
  1.  .;demote component separator to subcomponent separator
  1.  .S W=$$CE(WI,44,.CODE,.INDELIMS,1,"O")
  1.  .S W=$TR(W,INSUBDEL,INSUBCOM)
  1.  .;Get Division  ->  MTF  ->  MTF Code
  1.  .S D=+$P($G(^SC(WI,0)),U,15),D=+$P($G(^DG(40.8,D,0)),U,2),D=$P($G(^DIC(4,D,8000)),U,1)
  1.  I $G(INENC) D
  1.  .S D=$$SUBESC^INHUT7(D,.INDELIMS,.INDIR)
  1.  .S B=$$SUBESC^INHUT7(B,.INDELIMS,.INDIR)
  1.  ;
  1.  Q W_INSUBDEL_B_INSUBDEL_INSUBDEL_D
  1.  ;