Routine: XUMFP

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

F4 ; -- institution file

 D ^XUMFP4

F4P1 ; -- facility type file

 D ^XUMFPFT

F5P12 ; -- postal code file

 D ^XUMFP512

F5P13 ; -- county code file

 D ^XUMFP513

 ;  *** insert subroutine here for additional files ***

TAG ;D ^ROUTINE

;Q

ZL7 ; generic

 D ^XUMFPMFS

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  Apr 09, 2024@21:11:49                                                                                                                                                                                                       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      ;

XUMFP.m