XUMFXP.m

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)

 ;

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      ;