XUMFP ;CIOFO-SF/RAM,ALB/BRM - Master File C/S Parameters ; 10/11/02 2:50pm
;;8.0;KERNEL;**206,217,246,262,369**;Jul 10, 1995;Build 27
;
;
;
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("PRE") Pre-update record routine
; PARAM("POST") Post-update record routine
;
; 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
; 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
;
; [Z...] segment(s) parameters
; -------------------------
; PARAM("SEG",SEG)="" HL7 segment name
; PARAM("SEG",SEG,"SEQ",SEQ,FLD#) seg sequence number and field
; Note: Add HL7 data type + sub components (leave value/code blank)
; Example: Institution Facility Type = "CE^~FACILILITY TYPE~VA"
; If the FIELD is a pointer and you want the lookup to be other
; than the pointed to .01 set the 3rd piece = to the extended ref.
; I.e., Parent Facility in the Association mult of Institution
; points back to Institution, if we want to get facility using
; station number (#99) instead of name (.01) set the 3rd piece
; equal to ":99" giving us "CE^~FACILILITY TYPE~VA^:99".
;
; Files involving sub-records and/or extended reference
; -----------------------------------------------------
; PARAM("SEG",SEG,"SEQ",SEQ,"FILE") See FM documentation
; PARAM("SEG",SEG,"SEQ",SEQ,"IENS") $$GET1^DIQ() for value
; PARAM("SEG",SEG,"SEQ",SEQ,"FIELD") of FILE, IENS, & FIELD.
;
; PARAM("SEG",SEG,"SEQ",SEQ,"DTYP") HL7 data type (above)
;
;
; *** NOTE: OUTPUT in ^TMP("XUMF MFS",$J,"PARAM") ***
;
; Example: MFE PKV is ^TMP("XUMF MFS",$J,"PARAM",IEN,"PKV")
; SEG ^TMP("XUMF MFS",$J,"PARAM","SEG")
;
; and another node is required for sub-file IENS for group
; ^TMP("XUMF MFS",$J,"PARAM",IEN,"IENS",SEG,SEQ)=IENS
;
; Use XUMFP4 as a template/example routine
;
N QUERY,UPDATE,ALL,MFR,MFQ,HLFS,HLCS,GROUP,ARRAY,ROOT,NEW,I,J,CDSYS
N PROTOCOL
;
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 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@("XUMF","N",I)) Q:'I D
..S ^TMP("XUMF MFS",$J,"PARAM","IEN",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)=""
;
; *** insert code below ***
; insert file number in string below to add an additional file
I "^4^4.1^5.12^5.13^730^5^45.7^4.11^49^9.8^"'[(U_IFN_U) S ERROR="1^file not supported" Q
; *** end insert code ***
;
; note: also create a subroutine for each supported file with
; the file number as the line TAG (replace decimal point
; of file number with the letter 'P'). This subroutine
; calls an associated routine for the specific file.
; This file should use the XUMFP namespace.
;
I "^4^4.1^5.12^5.13^"[(U_IFN_U) D @("F"_$TR(IFN,".","P"))
I "^730^5^4.11^49^9.8^"[(U_IFN_U) D ZL7
;
K PARAM
;
Q
;
F4 ; -- institution file
;
D ^XUMFP4
;
Q
;
F4P1 ; -- facility type file
;
D ^XUMFPFT
;
Q
;
F5P12 ; -- postal code file
;
D ^XUMFP512
;
Q
;
F5P13 ; -- county code file
;
D ^XUMFP513
;
Q
;
; *** insert subroutine here for additional files ***
;
TAG ;D ^ROUTINE
;Q
;
;
ZL7 ; generic
;
D ^XUMFPMFS
;
Q
;
MFI(X) ; -- master file identifier function
;
;INPUT X master file indentifier (seq 1 MFI segment)
;OUTPUT $$ IFN - Internal File Number or '0' for error
;
Q:X="Z04" 4
Q:X="Z4T" 4.1
Q:$P(X,HLCS)="5P12" 5.12
Q:$P(X,HLCS)="5P13" 5.13
Q:X="ZNS" 730
Q:X="ZAG" 4.11
Q:X="Z05" 5
Q:X="Z49" 49
;
; *** add code here for new files ***
;
Q 0
;
DTYP(VALUE,TYP,HLCS,TOHL7) ;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),TOHL7=$G(TOHL7)
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" Q $$FMDATE^HLFNC(+VALUE)
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[HXUMFP 8147 printed Dec 13, 2024@02:10:55 Page 2
XUMFP ;CIOFO-SF/RAM,ALB/BRM - Master File C/S Parameters ; 10/11/02 2:50pm
+1 ;;8.0;KERNEL;**206,217,246,262,369**;Jul 10, 1995;Build 27
+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("PRE") Pre-update record routine
+34 ; PARAM("POST") Post-update record routine
+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 ; PARAM("FLEC") File-Level Event Code
+56 ; PARAM("ENDT") Entered Data/Time
+57 ; PARAM("MFIEDT") Effective Date/Time
+58 ; PARAM("RLC") Response Level Code
+59 ;
+60 ; MFE -- Master File Entry
+61 ; ------------------------
+62 ; PARAM("RLEC") Record-Level Event Code
+63 ; PARAM("MFNCID") MFN Control ID
+64 ; PARAM("MFEEDT") Effective Date/Time
+65 ; PARAM("PKV") Primary Key Value
+66 ;
+67 ; [Z...] segment(s) parameters
+68 ; -------------------------
+69 ; PARAM("SEG",SEG)="" HL7 segment name
+70 ; PARAM("SEG",SEG,"SEQ",SEQ,FLD#) seg sequence number and field
+71 ; Note: Add HL7 data type + sub components (leave value/code blank)
+72 ; Example: Institution Facility Type = "CE^~FACILILITY TYPE~VA"
+73 ; If the FIELD is a pointer and you want the lookup to be other
+74 ; than the pointed to .01 set the 3rd piece = to the extended ref.
+75 ; I.e., Parent Facility in the Association mult of Institution
+76 ; points back to Institution, if we want to get facility using
+77 ; station number (#99) instead of name (.01) set the 3rd piece
+78 ; equal to ":99" giving us "CE^~FACILILITY TYPE~VA^:99".
+79 ;
+80 ; Files involving sub-records and/or extended reference
+81 ; -----------------------------------------------------
+82 ; PARAM("SEG",SEG,"SEQ",SEQ,"FILE") See FM documentation
+83 ; PARAM("SEG",SEG,"SEQ",SEQ,"IENS") $$GET1^DIQ() for value
+84 ; PARAM("SEG",SEG,"SEQ",SEQ,"FIELD") of FILE, IENS, & FIELD.
+85 ;
+86 ; PARAM("SEG",SEG,"SEQ",SEQ,"DTYP") HL7 data type (above)
+87 ;
+88 ;
+89 ; *** NOTE: OUTPUT in ^TMP("XUMF MFS",$J,"PARAM") ***
+90 ;
+91 ; Example: MFE PKV is ^TMP("XUMF MFS",$J,"PARAM",IEN,"PKV")
+92 ; SEG ^TMP("XUMF MFS",$J,"PARAM","SEG")
+93 ;
+94 ; and another node is required for sub-file IENS for group
+95 ; ^TMP("XUMF MFS",$J,"PARAM",IEN,"IENS",SEG,SEQ)=IENS
+96 ;
+97 ; Use XUMFP4 as a template/example routine
+98 ;
+99 NEW QUERY,UPDATE,ALL,MFR,MFQ,HLFS,HLCS,GROUP,ARRAY,ROOT,NEW,I,J,CDSYS
+100 NEW PROTOCOL
+101 ;
+102 KILL ^TMP("XUMF MFS",$JOB)
+103 MERGE ^TMP("XUMF MFS",$JOB,"PARAM")=PARAM
+104 ;
+105 SET IEN=$GET(IEN)
SET IFN=$GET(IFN)
+106 SET TYPE=+$GET(TYPE)
SET ERROR=$GET(ERROR)
+107 SET UPDATE=$SELECT(TYPE#2:0,1:1)
+108 SET QUERY='UPDATE
+109 SET GROUP=$SELECT(UPDATE:0,TYPE[5:1,TYPE[7:1,1:0)
+110 SET ARRAY=$SELECT(UPDATE:0,TYPE[3:1,TYPE[7:1,1:0)
+111 SET ALL=$SELECT(IEN="ALL":1,1:0)
+112 SET NEW=$SELECT(IEN="NEW":1,1:0)
+113 SET MFR=$SELECT(UPDATE:0,TYPE>10:1,1:0)
+114 SET MFQ=$SELECT(UPDATE:0,'MFR:1,1:0)
+115 ;
+116 SET PROTOCOL=$GET(PARAM("PROTOCOL"))
+117 ;
+118 IF 'IFN
SET ERROR="1^invalid IFN"
QUIT
+119 ;
+120 ; -- get root of file
+121 SET ROOT=$$ROOT^DILFD(IFN,,1)
+122 ;
+123 ; -- if IEN array input, merge with param
+124 IF 'ALL
IF 'IEN
IF $ORDER(IEN(0))
MERGE ^TMP("XUMF MFS",$JOB,"PARAM","IEN")=IEN
+125 ;
+126 ; -- if CDSYS and ALL get entries
+127 SET CDSYS=$GET(^TMP("XUMF MFS",$JOB,"PARAM","CDSYS"))
+128 IF ALL
IF CDSYS'=""
Begin DoDot:1
+129 SET I=0
FOR
SET I=$ORDER(@ROOT@("XUMFIDX",CDSYS,I))
if 'I
QUIT
Begin DoDot:2
+130 SET J=$ORDER(@ROOT@("XUMFIDX",CDSYS,I,0))
+131 SET ^TMP("XUMF MFS",$JOB,"PARAM","IEN",J)=I
End DoDot:2
End DoDot:1
+132 ;
+133 ; -- get ALL file 'national' entries
+134 IF ALL
IF '$DATA(^TMP("XUMF MFS",$JOB,"PARAM","IEN"))
IF CDSYS=""
Begin DoDot:1
+135 SET I=0
FOR
SET I=$ORDER(@ROOT@("XUMF","N",I))
if 'I
QUIT
Begin DoDot:2
+136 SET ^TMP("XUMF MFS",$JOB,"PARAM","IEN",I)=""
End DoDot:2
End DoDot:1
+137 ;
+138 ; -- get ALL file
+139 IF ALL
IF '$DATA(^TMP("XUMF MFS",$JOB,"PARAM","IEN"))
IF CDSYS=""
Begin DoDot:1
+140 SET I=0
FOR
SET I=$ORDER(@ROOT@(I))
if 'I
QUIT
Begin DoDot:2
+141 SET ^TMP("XUMF MFS",$JOB,"PARAM","IEN",I)=""
End DoDot:2
End DoDot:1
+142 ;
+143 ; *** insert code below ***
+144 ; insert file number in string below to add an additional file
+145 IF "^4^4.1^5.12^5.13^730^5^45.7^4.11^49^9.8^"'[(U_IFN_U)
SET ERROR="1^file not supported"
QUIT
+146 ; *** end insert code ***
+147 ;
+148 ; note: also create a subroutine for each supported file with
+149 ; the file number as the line TAG (replace decimal point
+150 ; of file number with the letter 'P'). This subroutine
+151 ; calls an associated routine for the specific file.
+152 ; This file should use the XUMFP namespace.
+153 ;
+154 IF "^4^4.1^5.12^5.13^"[(U_IFN_U)
DO @("F"_$TRANSLATE(IFN,".","P"))
+155 IF "^730^5^4.11^49^9.8^"[(U_IFN_U)
DO ZL7
+156 ;
+157 KILL PARAM
+158 ;
+159 QUIT
+160 ;
F4 ; -- institution file
+1 ;
+2 DO ^XUMFP4
+3 ;
+4 QUIT
+5 ;
F4P1 ; -- facility type file
+1 ;
+2 DO ^XUMFPFT
+3 ;
+4 QUIT
+5 ;
F5P12 ; -- postal code file
+1 ;
+2 DO ^XUMFP512
+3 ;
+4 QUIT
+5 ;
F5P13 ; -- county code file
+1 ;
+2 DO ^XUMFP513
+3 ;
+4 QUIT
+5 ;
+6 ; *** insert subroutine here for additional files ***
+7 ;
TAG ;D ^ROUTINE
+1 ;Q
+2 ;
+3 ;
ZL7 ; generic
+1 ;
+2 DO ^XUMFPMFS
+3 ;
+4 QUIT
+5 ;
MFI(X) ; -- master file identifier function
+1 ;
+2 ;INPUT X master file indentifier (seq 1 MFI segment)
+3 ;OUTPUT $$ IFN - Internal File Number or '0' for error
+4 ;
+5 if X="Z04"
QUIT 4
+6 if X="Z4T"
QUIT 4.1
+7 if $PIECE(X,HLCS)="5P12"
QUIT 5.12
+8 if $PIECE(X,HLCS)="5P13"
QUIT 5.13
+9 if X="ZNS"
QUIT 730
+10 if X="ZAG"
QUIT 4.11
+11 if X="Z05"
QUIT 5
+12 if X="Z49"
QUIT 49
+13 ;
+14 ; *** add code here for new files ***
+15 ;
+16 QUIT 0
+17 ;
DTYP(VALUE,TYP,HLCS,TOHL7) ;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)
SET TOHL7=$GET(TOHL7)
+10 if TYP=""
QUIT VALUE
if VALUE=""
QUIT VALUE
+11 SET TEXT=$PIECE(TYP,U,2)
SET TYP=$PIECE(TYP,U)
+12 IF TYP="ST"!(TYP="ID")
QUIT VALUE
+13 IF TYP="DT"
IF TOHL7
Begin DoDot:1
+14 NEW X,Y
SET X=VALUE
DO ^%DT
SET VALUE=+Y
End DoDot:1
QUIT $$HLDATE^HLFNC(VALUE)
+15 IF TYP="DT"
QUIT $$FMDATE^HLFNC(+VALUE)
+16 IF TYP="ZST"
Begin DoDot:1
+17 NEW IEN5
SET IEN5=+$ORDER(^DIC(5,"C",VALUE,""))
+18 if IEN5
SET VALUE=$PIECE($GET(^DIC(5,IEN5,0)),"^")
End DoDot:1
QUIT VALUE
+19 IF 'TOHL7
QUIT $PIECE(VALUE,HLCS)
+20 QUIT VALUE_$TRANSLATE(TEXT,"~",HLCS)
+21 ;
