XUMFXP ;ISS/RAM - Master File Parameters ; 10/11/02 2:50pm
;;8.0;KERNEL;**299**;Jul 10, 1995
;
;
;
MAIN(IFN,IEN,TYPE,PARAM,ERROR) ; -- parameters for master file server
;
;INPUT
; IFN Internal File Number (required)
;
; IEN Internal Entry Number (required)
;
; single entry (pass by value) example: IEN=1
;
; multiple entries (pass by reference) IEN(1)=""
; IEN(2)=""
;
; ALL national entries (pass by value) IEN="ALL"
;
; NEW entry (pass by value) IEN="NEW"
;
; TYPE Message TYPE (required)
;
; 0 = MFN - unsolicited update
; 1 = MFQ - query particular record and file
; 3 = MFQ - query particular record in array
; 5 = MFQ - query group records file
; 7 = MFQ - query group records array
; 11 = MFR - query response particular rec file
; 13 = MFR - query response particular rec array
; 15 = MFR - query response group records file
; 17 = MFR - query response group records array
;
;
;INPUT/OUTPUT
;
; PARAM("PROTOCOL") IEN Protocol (#101) file
; PARAM("LLNK") HLL("LINKS",n) 'protocol^logical link'
; PARAM("CDSYS") Coding System - if mult cod sys for
; table - use XUMFIDX x-ref for CDSYS
;
; QRD -- Query definition segment
; -------------------------------
; PARAM("QDT") Query Date/Time
; PARAM("QFC") Query Format Code
; PARAM("QP") Query Priority
; PARAM("QID") Query ID
; PARAM("DRT") Deferred Response Type
; PARAM("DRDT") Deferred Response Date/Time
; PARAM("QLR") Quantity Limited Request
; PARAM("WHO") Who Subject Filter
; PARAM("WHAT") What Subject Filter
; PARAM("WDDC") What Department Data Code
; PARAM("WDCVQ") What Data Code Value Qual
; PARAM("QRL") Query Results Level
;
; MFI -- Master File Identification
; ---------------------------------
; PARAM("MFI") Master File Identifier
; PARAM("MFAI") Master File Application Identifier
; if MFAI contains TEMP do not store
; values in FileMan but parse into
; ^TEMP("XUMF ARRAY",$J, global
; PARAM("FLEC") File-Level Event Code
; PARAM("ENDT") Entered Data/Time
; PARAM("MFIEDT") Effective Date/Time
; PARAM("RLC") Response Level Code
;
; MFE -- Master File Entry
; ------------------------
; PARAM("RLEC") Record-Level Event Code
; PARAM("MFNCID") MFN Control ID
; PARAM("MFEEDT") Effective Date/Time
; PARAM("PKV") Primary Key Value
;
; segment(s) parameters
; -------------------------
; PARAM("SEQ",SEQ,FLD#)=hl7_dataType
; If the FIELD is a pointer add ":" + extended reference
; lookup field (if other than .01) after HL7 data type.
;
; Files involving sub-records and/or extended reference
; -----------------------------------------------------
; PARAM("SEQ",SEQ,"FILE") See FM documentation
; PARAM("SEQ",SEQ,"IENS") $$GET1^DIQ() for value
; PARAM("SEQ",SEQ,"FIELD") of FILE, IENS, & FIELD.
;
; PARAM("SEQ",SEQ,"DTYP") HL7 data type
; PRAAM("SEQ",SEQ,"LKUP") extended reference lookup field
;
; and another node is required for sub-file IENS for group
; ^TMP("XUMF MFS",$J,"PARAM",IEN,"IENS",SEQ)=IENS
;
; NOTE: OUTPUT in ^TMP("XUMF MFS",$J,"PARAM")
;
; Example: MFE PKV is ^TMP("XUMF MFS",$J,"PARAM",IEN,"PKV")
;
;
N QUERY,UPDATE,ALL,MFR,MFQ,HLFS,HLCS,GROUP,ARRAY,ROOT,NEW,I,J,CDSYS
N PROTOCOL,MFK
;
K ^TMP("XUMF MFS",$J)
M ^TMP("XUMF MFS",$J,"PARAM")=PARAM
;
S IEN=$G(IEN),IFN=$G(IFN)
S TYPE=+$G(TYPE),ERROR=$G(ERROR)
S UPDATE=$S(TYPE#2:0,1:1)
S QUERY='UPDATE
S GROUP=$S(UPDATE:0,TYPE[5:1,TYPE[7:1,1:0)
S ARRAY=$S(UPDATE:0,TYPE[3:1,TYPE[7:1,1:0)
S ALL=$S(IEN="ALL":1,1:0)
S NEW=$S(IEN="NEW":1,1:0)
S MFR=$S(UPDATE:0,TYPE>10:1,1:0)
S MFQ=$S(UPDATE:0,'MFR:1,1:0)
S MFK=$S(TYPE=10:1,1:0)
;
Q:MFK
;
S PROTOCOL=$G(PARAM("PROTOCOL"))
;
I 'IFN S ERROR="1^invalid IFN" Q
;
; -- get root of file
S ROOT=$$ROOT^DILFD(IFN,,1)
;
; -- if IEN array input, merge with param
I 'ALL,'IEN,$O(IEN(0)) M ^TMP("XUMF MFS",$J,"PARAM","IEN")=IEN
;
; -- if CDSYS and ALL get entries
S CDSYS=$G(^TMP("XUMF MFS",$J,"PARAM","CDSYS"))
I ALL,CDSYS'="" D
.S I=0 F S I=$O(@ROOT@("XUMFIDX",CDSYS,I)) Q:'I D
..S J=$O(@ROOT@("XUMFIDX",CDSYS,I,0))
..S ^TMP("XUMF MFS",$J,"PARAM","IEN",J)=I
;
; -- get ALL file 'national' entries
I ALL,'$D(^TMP("XUMF MFS",$J,"PARAM","IEN")),CDSYS="" D
.S I=0 F S I=$O(@ROOT@("AVUID",I)) Q:'I D
..S J=$O(@ROOT@("AVUID",I,0))
..S ^TMP("XUMF MFS",$J,"PARAM","IEN",J)=I
;
; -- get ALL file
I ALL,'$D(^TMP("XUMF MFS",$J,"PARAM","IEN")),CDSYS="" D
.S I=0 F S I=$O(@ROOT@(I)) Q:'I D
..S ^TMP("XUMF MFS",$J,"PARAM","IEN",I)=""
;
I '$D(^DIC(4.001,+IFN)) S ERROR="1^file not supported" Q
;
D MAIN^XUMFXP1
;
K PARAM
;
Q
;
;
DTYP(VALUE,TYP,HLCS,TOHL7,TIMEZONE) ;data type conversion
;INPUT
; VALUE value
; TYP HL7 data type
; TOHL7 1=to HL7, 0=to FileMan
;OUTPUT
; $$ formatted data
;
N TEXT,CS
S TYP=$G(TYP),VALUE=$G(VALUE)
S TOHL7=$G(TOHL7),TIMEZONE=$G(TIMEZONE)
Q:TYP="" VALUE Q:VALUE="" VALUE
S TEXT=$P(TYP,U,2),TYP=$P(TYP,U)
I TYP="ST"!(TYP="ID") Q VALUE
I TYP="DT",TOHL7 D Q $$HLDATE^HLFNC(VALUE)
.N X,Y S X=VALUE D ^%DT S VALUE=+Y
I TYP="DT",$E(VALUE,1,4)="0000" Q $$NOW^XLFDT
I TYP="DT" Q $$HL7TFM^XLFDT(+VALUE,TIMEZONE)
I TYP="ZST" D Q VALUE
.N IEN5 S IEN5=+$O(^DIC(5,"C",VALUE,""))
.S:IEN5 VALUE=$P($G(^DIC(5,IEN5,0)),"^")
I 'TOHL7 Q $P(VALUE,HLCS)
Q VALUE_$TR(TEXT,"~",HLCS)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUMFXP 6535 printed Nov 22, 2024@17:21:19 Page 2
XUMFXP ;ISS/RAM - Master File Parameters ; 10/11/02 2:50pm
+1 ;;8.0;KERNEL;**299**;Jul 10, 1995
+2 ;
+3 ;
+4 ;
MAIN(IFN,IEN,TYPE,PARAM,ERROR) ; -- parameters for master file server
+1 ;
+2 ;INPUT
+3 ; IFN Internal File Number (required)
+4 ;
+5 ; IEN Internal Entry Number (required)
+6 ;
+7 ; single entry (pass by value) example: IEN=1
+8 ;
+9 ; multiple entries (pass by reference) IEN(1)=""
+10 ; IEN(2)=""
+11 ;
+12 ; ALL national entries (pass by value) IEN="ALL"
+13 ;
+14 ; NEW entry (pass by value) IEN="NEW"
+15 ;
+16 ; TYPE Message TYPE (required)
+17 ;
+18 ; 0 = MFN - unsolicited update
+19 ; 1 = MFQ - query particular record and file
+20 ; 3 = MFQ - query particular record in array
+21 ; 5 = MFQ - query group records file
+22 ; 7 = MFQ - query group records array
+23 ; 11 = MFR - query response particular rec file
+24 ; 13 = MFR - query response particular rec array
+25 ; 15 = MFR - query response group records file
+26 ; 17 = MFR - query response group records array
+27 ;
+28 ;
+29 ;INPUT/OUTPUT
+30 ;
+31 ; PARAM("PROTOCOL") IEN Protocol (#101) file
+32 ; PARAM("LLNK") HLL("LINKS",n) 'protocol^logical link'
+33 ; PARAM("CDSYS") Coding System - if mult cod sys for
+34 ; table - use XUMFIDX x-ref for CDSYS
+35 ;
+36 ; QRD -- Query definition segment
+37 ; -------------------------------
+38 ; PARAM("QDT") Query Date/Time
+39 ; PARAM("QFC") Query Format Code
+40 ; PARAM("QP") Query Priority
+41 ; PARAM("QID") Query ID
+42 ; PARAM("DRT") Deferred Response Type
+43 ; PARAM("DRDT") Deferred Response Date/Time
+44 ; PARAM("QLR") Quantity Limited Request
+45 ; PARAM("WHO") Who Subject Filter
+46 ; PARAM("WHAT") What Subject Filter
+47 ; PARAM("WDDC") What Department Data Code
+48 ; PARAM("WDCVQ") What Data Code Value Qual
+49 ; PARAM("QRL") Query Results Level
+50 ;
+51 ; MFI -- Master File Identification
+52 ; ---------------------------------
+53 ; PARAM("MFI") Master File Identifier
+54 ; PARAM("MFAI") Master File Application Identifier
+55 ; if MFAI contains TEMP do not store
+56 ; values in FileMan but parse into
+57 ; ^TEMP("XUMF ARRAY",$J, global
+58 ; PARAM("FLEC") File-Level Event Code
+59 ; PARAM("ENDT") Entered Data/Time
+60 ; PARAM("MFIEDT") Effective Date/Time
+61 ; PARAM("RLC") Response Level Code
+62 ;
+63 ; MFE -- Master File Entry
+64 ; ------------------------
+65 ; PARAM("RLEC") Record-Level Event Code
+66 ; PARAM("MFNCID") MFN Control ID
+67 ; PARAM("MFEEDT") Effective Date/Time
+68 ; PARAM("PKV") Primary Key Value
+69 ;
+70 ; segment(s) parameters
+71 ; -------------------------
+72 ; PARAM("SEQ",SEQ,FLD#)=hl7_dataType
+73 ; If the FIELD is a pointer add ":" + extended reference
+74 ; lookup field (if other than .01) after HL7 data type.
+75 ;
+76 ; Files involving sub-records and/or extended reference
+77 ; -----------------------------------------------------
+78 ; PARAM("SEQ",SEQ,"FILE") See FM documentation
+79 ; PARAM("SEQ",SEQ,"IENS") $$GET1^DIQ() for value
+80 ; PARAM("SEQ",SEQ,"FIELD") of FILE, IENS, & FIELD.
+81 ;
+82 ; PARAM("SEQ",SEQ,"DTYP") HL7 data type
+83 ; PRAAM("SEQ",SEQ,"LKUP") extended reference lookup field
+84 ;
+85 ; and another node is required for sub-file IENS for group
+86 ; ^TMP("XUMF MFS",$J,"PARAM",IEN,"IENS",SEQ)=IENS
+87 ;
+88 ; NOTE: OUTPUT in ^TMP("XUMF MFS",$J,"PARAM")
+89 ;
+90 ; Example: MFE PKV is ^TMP("XUMF MFS",$J,"PARAM",IEN,"PKV")
+91 ;
+92 ;
+93 NEW QUERY,UPDATE,ALL,MFR,MFQ,HLFS,HLCS,GROUP,ARRAY,ROOT,NEW,I,J,CDSYS
+94 NEW PROTOCOL,MFK
+95 ;
+96 KILL ^TMP("XUMF MFS",$JOB)
+97 MERGE ^TMP("XUMF MFS",$JOB,"PARAM")=PARAM
+98 ;
+99 SET IEN=$GET(IEN)
SET IFN=$GET(IFN)
+100 SET TYPE=+$GET(TYPE)
SET ERROR=$GET(ERROR)
+101 SET UPDATE=$SELECT(TYPE#2:0,1:1)
+102 SET QUERY='UPDATE
+103 SET GROUP=$SELECT(UPDATE:0,TYPE[5:1,TYPE[7:1,1:0)
+104 SET ARRAY=$SELECT(UPDATE:0,TYPE[3:1,TYPE[7:1,1:0)
+105 SET ALL=$SELECT(IEN="ALL":1,1:0)
+106 SET NEW=$SELECT(IEN="NEW":1,1:0)
+107 SET MFR=$SELECT(UPDATE:0,TYPE>10:1,1:0)
+108 SET MFQ=$SELECT(UPDATE:0,'MFR:1,1:0)
+109 SET MFK=$SELECT(TYPE=10:1,1:0)
+110 ;
+111 if MFK
QUIT
+112 ;
+113 SET PROTOCOL=$GET(PARAM("PROTOCOL"))
+114 ;
+115 IF 'IFN
SET ERROR="1^invalid IFN"
QUIT
+116 ;
+117 ; -- get root of file
+118 SET ROOT=$$ROOT^DILFD(IFN,,1)
+119 ;
+120 ; -- if IEN array input, merge with param
+121 IF 'ALL
IF 'IEN
IF $ORDER(IEN(0))
MERGE ^TMP("XUMF MFS",$JOB,"PARAM","IEN")=IEN
+122 ;
+123 ; -- if CDSYS and ALL get entries
+124 SET CDSYS=$GET(^TMP("XUMF MFS",$JOB,"PARAM","CDSYS"))
+125 IF ALL
IF CDSYS'=""
Begin DoDot:1
+126 SET I=0
FOR
SET I=$ORDER(@ROOT@("XUMFIDX",CDSYS,I))
if 'I
QUIT
Begin DoDot:2
+127 SET J=$ORDER(@ROOT@("XUMFIDX",CDSYS,I,0))
+128 SET ^TMP("XUMF MFS",$JOB,"PARAM","IEN",J)=I
End DoDot:2
End DoDot:1
+129 ;
+130 ; -- get ALL file 'national' entries
+131 IF ALL
IF '$DATA(^TMP("XUMF MFS",$JOB,"PARAM","IEN"))
IF CDSYS=""
Begin DoDot:1
+132 SET I=0
FOR
SET I=$ORDER(@ROOT@("AVUID",I))
if 'I
QUIT
Begin DoDot:2
+133 SET J=$ORDER(@ROOT@("AVUID",I,0))
+134 SET ^TMP("XUMF MFS",$JOB,"PARAM","IEN",J)=I
End DoDot:2
End DoDot:1
+135 ;
+136 ; -- get ALL file
+137 IF ALL
IF '$DATA(^TMP("XUMF MFS",$JOB,"PARAM","IEN"))
IF CDSYS=""
Begin DoDot:1
+138 SET I=0
FOR
SET I=$ORDER(@ROOT@(I))
if 'I
QUIT
Begin DoDot:2
+139 SET ^TMP("XUMF MFS",$JOB,"PARAM","IEN",I)=""
End DoDot:2
End DoDot:1
+140 ;
+141 IF '$DATA(^DIC(4.001,+IFN))
SET ERROR="1^file not supported"
QUIT
+142 ;
+143 DO MAIN^XUMFXP1
+144 ;
+145 KILL PARAM
+146 ;
+147 QUIT
+148 ;
+149 ;
DTYP(VALUE,TYP,HLCS,TOHL7,TIMEZONE) ;data type conversion
+1 ;INPUT
+2 ; VALUE value
+3 ; TYP HL7 data type
+4 ; TOHL7 1=to HL7, 0=to FileMan
+5 ;OUTPUT
+6 ; $$ formatted data
+7 ;
+8 NEW TEXT,CS
+9 SET TYP=$GET(TYP)
SET VALUE=$GET(VALUE)
+10 SET TOHL7=$GET(TOHL7)
SET TIMEZONE=$GET(TIMEZONE)
+11 if TYP=""
QUIT VALUE
if VALUE=""
QUIT VALUE
+12 SET TEXT=$PIECE(TYP,U,2)
SET TYP=$PIECE(TYP,U)
+13 IF TYP="ST"!(TYP="ID")
QUIT VALUE
+14 IF TYP="DT"
IF TOHL7
Begin DoDot:1
+15 NEW X,Y
SET X=VALUE
DO ^%DT
SET VALUE=+Y
End DoDot:1
QUIT $$HLDATE^HLFNC(VALUE)
+16 IF TYP="DT"
IF $EXTRACT(VALUE,1,4)="0000"
QUIT $$NOW^XLFDT
+17 IF TYP="DT"
QUIT $$HL7TFM^XLFDT(+VALUE,TIMEZONE)
+18 IF TYP="ZST"
Begin DoDot:1
+19 NEW IEN5
SET IEN5=+$ORDER(^DIC(5,"C",VALUE,""))
+20 if IEN5
SET VALUE=$PIECE($GET(^DIC(5,IEN5,0)),"^")
End DoDot:1
QUIT VALUE
+21 IF 'TOHL7
QUIT $PIECE(VALUE,HLCS)
+22 QUIT VALUE_$TRANSLATE(TEXT,"~",HLCS)
+23 ;
