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

INHUT2.m

Go to the documentation of this file. 
  1. INHUT2 ; cmi/flag/maw - 16 Oct 98 15:11 GIS utilities ; [ 05/09/2002 11:06 AM ]
  1.  ;;3.01;BHL IHS Interfaces with GIS;**1**;JUN 01, 2002
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  ;
  1.  Q
  1.  ;
  1. ISNAMSPC(X) ;is the value properly name spaces according to current
  1.  ;GIS specifications
  1.  N NAMSPC,PATMAT,RON,ROF
  1.  I " HL HL7 DGM TEST "[(" "_$P(X," ")_" ") Q 1
  1.  S RON=$P(DIJC("RON")," ",2),ROF=$P(DIJC("ROF")," ",2)
  1.  S @("RON="_RON),@("ROF="_ROF)
  1.  ;Modified for IHS
  1.  W RON_"Invalid Name-space!"_ROF S Y=.01 Q 0
  1.  ;D MESS^UTWRD(RON_"Invalid Name-space!"_ROF) S Y=.01 Q 0
  1.  ;
  1. ISNS(X) ;is the input value properly name spaced
  1.  ;input:
  1.  ;  X --> input value of the .01 field
  1.  ; "Grandfather" existing Transactions and Destinations
  1.  ;cmi/flag/maw modified for namespace type
  1.  N INAME,INDAD S INDAD=0
  1.  F I=1:1 S INAME=$T(EXCLUDE+I) Q:INAME'[";;"  D  Q:INDAD
  1.  .I $P(INAME,";;",2)=X S INDAD=1
  1.  Q:INDAD 1
  1.  Q:$P(X," ")="" 0
  1.  ;Q $O(^INRHNS("B",$P(X," "),""))
  1.  I $O(^INRHNS("B",$P(X," "),""))="" Q 0
  1.  I $O(^INRHNS("B",$P(X," ",3),""))="" Q 0
  1.  I $O(^INRHNS("ADS",$P(X," ",2),""))="" Q 0
  1.  Q 1
  1.  ;
  1. EXCLUDE ;List of existing entries to exclude from namespace requirement
  1.  ;;ANATOMIC PATHOLOGY
  1.  ;;MASTER FILE NOTIFICATION
  1.  ;;IV ORDER
  1.  ;;LAB ORDER
  1.  ;;PATIENT APPOINTMENT
  1.  ;;PRESCRIPTION
  1.  ;;RAD ORDER
  1.  ;;RADIOLOGY PROCEDURE
  1.  ;;INCOMING ACK
  1.  ;
  1. MHC(X) ;Return number embedded in string value of MHCMIS .01 field
  1.  ;1-Called from ISNS to validate entry to Int. Destination File.
  1.  ;2-Called from MHCMIS transmitter (INHVMTR) to identify correct dest.
  1.  ;3-Called from Input Transform of MHCMIS SITE PARAMTER FILE
  1.  ; INPUT: X=String value of .01 field
  1.  ; RETURN: Number embedded in the string
  1.  ;Allow the basic MHCMIS entry for Int. Dest. File.
  1.  ;Basic MHCMIS entry corrosponds to IEN 1 of MHCMIS SITE PARM FILE
  1.  I X="MHCMIS" Q 1
  1.  ;Force other MHCMIS entries to include a number
  1.  S OK=$TR(X,"ABCDEFGHIJKLMNOPQRSTUVWXYZ()/ ","")
  1.  Q OK
  1.  ;
  1. MSG ;message display for Interface Name Space control
  1.  N HON,HOF,INI,DWLRF,DWLB,DY
  1.  S HON=$P(DIJC("H")," ",2),HOF=$P(DIJC("L")," ",2)
  1.  S @("HON="_HON),@("HOF="_HOF)
  1.  S INI="",DY=$Y-1,DWLRF="INS",DWLB="2^"_DY_"^10^78",DWL="SWZF"
  1.  S @DWLRF@(1)=" Valid Name-spaces:"
  1.  F I=2:1 S INI=$O(^INRHNS("B",INI)) Q:INI=""  D
  1.  .S @DWLRF@(I)="     "_HOF_INI_HON,@DWLRF@(I,0)=""
  1.  D ^DWL W HOF
  1.  Q
  1.  ;
  1. UNIQUE(X) ;See if ID is being used already
  1.  ; Input:
  1.  ; X --> input value of Unique ID
  1.  ; Returns 0-ID does not exist
  1.  ;         1-ID exists
  1.  Q '$D(^INRHT("ID",X,DA))
  1. UNQ(DA) ;Set unique ID Called from DD 4000,.01
  1.  ; DA - IEN
  1.  N INCNT,INID,%VOL,X,DR,DIE,INLAST
  1.  N DG,DB,DIL,DLB,DIE17,DGO,DOW,DNM,DQ,DIEZ,D0,D1,D2,D3,D4,D5,D6,D7,X
  1.  I $P(^INRHT(DA,0),U,4)="" D
  1.  .S %VOL=$G(^%ZOSF("VOL")),%VOL=$E(%VOL,$L(%VOL))
  1.  .S:%VOL="" %VOL="?"
  1.  .S INLAST=%VOL_999
  1.  .S INID=$O(^INRHT("ID",INLAST),-1),INCNT=+$E(INID,2,4)+1
  1.  .S INCNT=%VOL_$$PAD(INCNT,3,0)
  1.  .S DR=".04///^S X=INCNT",DIE="^INRHT("
  1.  .D ^DIE
  1.  Q
  1. CONV ;Conversion routine to add unique id's
  1.  N DA
  1.  S DA=0 F  S DA=$O(^INRHT(DA)) Q:'DA  S $P(^INRHT(DA,0),U,4)=""
  1.  S DA=0 F  S DA=$O(^INRHT(DA)) Q:'DA  D UNQ(DA)
  1.  Q
  1. PAD(X,Y,Z) ;Pad front with whatever you want to pad with
  1.  ; input: X - String you are padding
  1.  ;        Y - Pad to this size
  1.  ;        Z - What to PAD it with
  1.  N INHPAD
  1.  S INHPAD="",$P(INHPAD,Z,Y+1)="",X=$E(X,1,Y)
  1.  Q $E(INHPAD,1,Y-$L(X))_X
  1. FMHELP(DP,D) ;Fileman help utility
  1.  ; DP - File/Sub file Number
  1.  ; D - Field Number
  1.  N DZ,DQ,DV,DG,%,%X,Z,X,DIE2,DL,Y,DIC,DIE,DU
  1.  S (DIC,DIE)=$G(^DIC(DP,0,"GL")),DIC(0)="E"
  1.  S (X,DZ)="?",DQ=1,DQ(1)=$G(^DD(DP,D,0))
  1.  ; If not a multiple
  1.  I '$P(DQ(1),U,2) S DV=$P(DQ(1),U,2)
  1.  S DU=$P(DQ(1),U,3)
  1.  D Q^DIE2
  1.  Q
  1. PARSEG(INSRCTL,INSEGNM) ; Parse a segment
  1.  ; INPUT:
  1.  ;   INSRCTL (required):
  1.  ;      Array containing the raw segment data to be parsed
  1.  ;      located under the HL7 namespaced node represented by
  1.  ;      the second parameter.
  1.  ;       ex. INSRCTL("MSH")=...
  1.  ;   INSEGNM HL7 segment name (required):
  1.  ;      Valid HL7 segment name to be used to identifiy which
  1.  ;      node of the input array will be parsed.
  1.  ;       ex. PARSEG^INHUT2(.INSRCTL,"MSH")
  1.  ;      where INSRCTL("MSH")="MSH^\|~&^^^^..."
  1.  ;
  1.  ; OUTPUTS:
  1.  ;   INSRCTL("Segment Name"_"Field number"): Field value found in segment
  1.  ;      NOTE: This output is raw HL7 format, not FileMan/CHCS format.
  1.  ;
  1.  Q:'$L($G(INSEGNM))
  1.  Q:'$D(INSRCTL(INSEGNM))
  1.  N INDELIM,INCOMP,INSUBCOM,INREP,INOFFSET,INSEG
  1.  S INDELIM=$G(INSCTRL("INDELIM")),INCOMP=$G(INSRCTL("INCOMP"))
  1.  S INSUBCOM=$G(INSRCTL("INSUBCOM")),INREP=$G(INSRCTL("INREP"))
  1.  ;If delimiters are not defined get them
  1.  I INDELIM=""!(INCOMP="")!(INSUBCOM="")!(INREP="") D  ;
  1.  . I $D(INSRCTL("MSH")) S INDELIM=$E(INSRCTL("MSH"),4),INCOMP=$E(INSRCTL("MSH"),5),INSUBCOM=$E(INSRCTL("MSH"),6),INREP=$E(INSRCTL("MSH"),7)
  1.  . E  S INDELIM=$$FIELD^INHUT,INCOMP=$$COMP^INHUT,INSUBCOM=$$SUBCOMP^INHUT,INREP=$$REP^INHUT
  1.  . S INSRCTL("INDELIM")=INDELIM,INSRCTL("INCOMP")=INCOMP,INSRCTL("INSUBCOM")=INSUBCOM,INSRCTL("INREP")=INREP
  1.  Q:INDELIM=""!(INCOMP="")
  1.  ;If MSH, field numbering is a tiny bit different.
  1.  S INOFFSET=$S(INSEGNM="MSH":2,1:1),INFIELDS=$L(INSRCTL(INSEGNM),INDELIM)
  1.  M INSEG=INSRCTL(INSEGNM)
  1.  F INFLD=INOFFSET:1:INFIELDS S INSRCTL(INSEGNM_INFLD)=$$PIECE^INHU(.INSEG,INDELIM,.INFLD)
  1.  D:$D(INSRCTL(INSEGNM))>9  ;
  1.  .  F I=1:1 Q:'$D(INSRCTL(INSEGNM,I))  D
  1.  . . S INFIELDS=$L(INSRCTL(INSEGNM,I),INDELIM)+INFLD
  1.  . . F INFLD=INFLD:1:INFIELDS S INSRCTL(INSEGNM_INFLD)=$$PIECE^INHU(.INSEG,INDELIM,.INFLD)
  1.  M INSRCTL(INSEGNM)=INSEG
  1.  Q
  1. GETSEG(UIF,INSEGNM,INSTANCE) ; Get segment from UIF
  1.  ; Called by S INSRCTL("MSH")=$$GETSEG^INHUT(12345,"MSH")
  1.  ;
  1.  ; INPUTS:
  1.  ;  UIF (required): The IEN of the UIF from which to extract the segment.
  1.  ;  INSEGNM (required): 
  1.  ;    The valid HL7 segment name to be used to identify 
  1.  ;    which node of the UIF is requested. 
  1.  ;  INSTANCE (optional, default=1)
  1.  ;   The instance of the segment desired.
  1.  ;
  1.  ; OUTPUT:
  1.  ;  0 If segment not found,
  1.  ;  1 if segment found in message,
  1.  ;
  1.  ;  INSRECTL(INSEGNM)
  1.  ;    Returns the Segment requested.  (With overflow) in the INSRCTL array.
  1.  ;
  1.  Q:$G(UIF)="" 0 Q:$G(INSEGNM)="" 0
  1.  N INLINE,INDATA,INCR,INCNT
  1.  K INSRCTL(INSEGNM)
  1.  S INLINE=0,INCNT=0 S:'$G(INSTANCE) INSTANCE=1
  1.  F  D GETLINE^INHOU(UIF,.INLINE,.INDATA,0,.INCR) Q:'$D(INDATA)  D
  1.  .  I $E(INDATA,1,3)=INSEGNM S INCNT=INCNT+1 M:INCNT=INSTANCE INSRCTL(INSEGNM)=INDATA Q
  1.  Q (0<$D(INSRCTL(INSEGNM)))
  1. BPSTAT(INBKGNM,INSRVR) ;-determine status of GIS background process, given name
  1.  ;Input:  INBKGNM - name of background process to determine status
  1.  ;        INSRVR  - server number (not currently supported)
  1.  ;Output:  Status message string of given background process name
  1.  ;        piece 1 =>  status  (1 - running ; 0 - not running)
  1.  ;        piece 2 =>  status message
  1.  ;        piece 3 =>  last run update  ($H format)
  1.  ;        piece 4 =>  last time a message was processed ($H format)
  1.  ;        piece 5 =>  ien of background process
  1.  ;
  1.  N INBKGIEN,INBKGST,INBGKSTR
  1.  I $G(INBKGNM)="" Q "0^Process name not specified"
  1.  S INBKGIEN=$O(^INTHPC("B",INBKGNM,0))
  1.  I 'INBKGIEN Q "0^Unknown Process"
  1.  I '$P($G(^INTHPC(INBKGIEN,0)),U,2) Q "0^Process inactive^^^"_INBKGIEN
  1.  S INBKGST=$$VER^INHB(INBKGIEN)
  1.  S INBKGSTR=$S(INBKGST=1:"1^Running",INBKGST=-1:"0^Signaled to Terminate",1:"0^Not Running")
  1.  S INBKGSTR=INBKGSTR_U_$P($G(^INRHB("RUN",INBKGIEN)),U,1)_U_$P($G(^INRHB("RUN",INBKGIEN)),U,3)_U_INBKGIEN
  1.  Q INBKGSTR
  1.  ;