- 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 Feb 18, 2025@23:37:21 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 ;