Routine: XUMFR

XUMFR ;OIFO-OAK/RAM - pre/post update subroutines;04/15/02 ;10/12/05  12:12

 ;;8.0;KERNEL;**335,383**;Jul 10, 1995

NULL ; -- do nothing

PRE ; -- pre update

 N ARRAY

 K ^TMP("XUMF PRE",$J)

 D DATA(.ARRAY)

 M ^TMP("XUMF PRE",$J)=ARRAY

POST ; -- post update

 N ARRAY,I,X,FLAG

 D DATA(.ARRAY)

 S (FLAG,I)=0

 F  S I=$O(ARRAY(I)) Q:'I  D  Q:FLAG

 .I ARRAY(I)'=^TMP("XUMF PRE",$J,I) S FLAG=1 Q

 I FLAG D

 .S I=0

 .F  S I=$O(ARRAY(I)) Q:'I  D

 ..S X(I+100)=ARRAY(I) K ARRAY(I)

 .M X=^TMP("XUMF PRE",$J)

 .D XM(.X,$G(KEY))

 K ^TMP("XUMF PRE",$J)

DATA(ARRAY) ; -- array(sequence)=fieldLabel_": "_value

 N SEG,SEQ,FLD,FILE,IENS,FIELD,VALUE,LKUP,IDX,ZDTYP

 S SEG="",SEQ=0

 F  S SEG=$O(^TMP("XUMF MFS",$J,"PARAM","SEG",SEG)) Q:SEG=""  D

 .F  S SEQ=$O(^TMP("XUMF MFS",$J,"PARAM","SEG",SEG,"SEQ",SEQ)) Q:'SEQ  D

..;

 ..S FLD=$O(^TMP("XUMF MFS",$J,"PARAM","SEG",SEG,"SEQ",SEQ,0))

..;

 ..I 'FLD D

 ...S FILE=^TMP("XUMF MFS",$J,"PARAM","SEG",SEG,"SEQ",SEQ,"FILE")

 ...S IENS=$G(^TMP("XUMF MFS",$J,"PARAM","IENS",SEG,SEQ))

 ...S FIELD=^TMP("XUMF MFS",$J,"PARAM","SEG",SEG,"SEQ",SEQ,"FIELD")

 ...S LKUP=$G(^TMP("XUMF MFS",$J,"PARAM","SEG",SEG,"SEQ",SEQ,"LKUP"))

 ...I LKUP S FIELD=FIELD_":"_LKUP

 ...S VALUE=$$GET1^DIQ(FILE,IENS,FIELD)

 ...S ARRAY(SEQ)=$$FIELD^XUMF(FILE,$P(FIELD,":"),"LABEL")_": "_VALUE

 ..I FLD D

 ...S ZDTYP=$G(^TMP("XUMF MFS",$J,"PARAM","SEG",SEG,"SEQ",SEQ,FLD))

 ...S LKUP=$P(ZDTYP,U,2)

 ...I LKUP S FLD=FLD_":"_LKUP

 ...S VALUE=$$GET1^DIQ(IFN,IEN_",",FLD)

 ...S ARRAY(SEQ)=$$FIELD^XUMF(IFN,$P(FLD,":"),"LABEL")_": "_VALUE

XM(X,XUMFKEY) ; -- MailMan notification

 N GROUP,XMDUZ

 S HLCS=$G(HLCS) S:HLCS="" HLCS="~"

 S XUMFKEY=" "_$P($G(XUMFKEY),HLCS)

 S GROUP=$$GET1^DIQ(4.001,IEN_",",.06)

 S:GROUP'="" GROUP="G."_GROUP

 S X(.1)="HL7 message ID: "_$G(HL("MID")),X(.2)=""

 ;S X(.3)="PRE UPDATE VALUES:",X(.4)=""

 S X(99.1)="",X(99.2)="POST UPDATE VALUES:",X(99.3)=""

 S XMSUB="MFS UPDATE - "_$$FILE^XUMF(IFN,"NAME")_XUMFKEY

 S XMY("G.XUMF SERVER")="",XMDUZ=.5

 S:GROUP'="" XMY(GROUP)=""

 S XMTEXT="X("

 D ^XMD

MD5 ;MD5 Hash value

 D EN^XUMF5I(IEN)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUMFR   2245     printed  Feb 18, 2025@23:37:32                                                                                                                                                                                                       Page 2

XUMFR     ;OIFO-OAK/RAM - pre/post update subroutines;04/15/02 ;10/12/05  12:12

 +1       ;;8.0;KERNEL;**335,383**;Jul 10, 1995

 +2       ;

 +3        QUIT

 +4       ;

NULL      ; -- do nothing

 +1       ;

 +2        QUIT

 +3       ;

PRE       ; -- pre update

 +1       ;

 +2        NEW ARRAY

 +3       ;

 +4        KILL ^TMP("XUMF PRE",$JOB)

 +5       ;

 +6        DO DATA(.ARRAY)

 +7       ;

 +8        MERGE ^TMP("XUMF PRE",$JOB)=ARRAY

 +9       ;

 +10       QUIT

 +11      ;

POST      ; -- post update

 +1       ;

 +2        NEW ARRAY,I,X,FLAG

 +3       ;

 +4        DO DATA(.ARRAY)

 +5       ;

 +6        SET (FLAG,I)=0

 +7        FOR

               SET I=$ORDER(ARRAY(I))

               if 'I

                   QUIT

               Begin DoDot:1

 +8                IF ARRAY(I)'=^TMP("XUMF PRE",$JOB,I)

                       SET FLAG=1

                       QUIT

               End DoDot:1

               if FLAG

                   QUIT

 +9       ;

 +10       IF FLAG

               Begin DoDot:1

 +11               SET I=0

 +12               FOR

                       SET I=$ORDER(ARRAY(I))

                       if 'I

                           QUIT

                       Begin DoDot:2

 +13                       SET X(I+100)=ARRAY(I)

                           KILL ARRAY(I)

                       End DoDot:2

 +14               MERGE X=^TMP("XUMF PRE",$JOB)

 +15               DO XM(.X,$GET(KEY))

               End DoDot:1

 +16      ;

 +17       KILL ^TMP("XUMF PRE",$JOB)

 +18      ;

 +19       QUIT

 +20      ;

DATA(ARRAY) ; -- array(sequence)=fieldLabel_": "_value

 +1       ;

 +2        NEW SEG,SEQ,FLD,FILE,IENS,FIELD,VALUE,LKUP,IDX,ZDTYP

 +3       ;

 +4        SET SEG=""

           SET SEQ=0

 +5        FOR

               SET SEG=$ORDER(^TMP("XUMF MFS",$JOB,"PARAM","SEG",SEG))

               if SEG=""

                   QUIT

               Begin DoDot:1

 +6                FOR

                       SET SEQ=$ORDER(^TMP("XUMF MFS",$JOB,"PARAM","SEG",SEG,"SEQ",SEQ))

                       if 'SEQ

                           QUIT

                       Begin DoDot:2

 +7       ;

 +8                        SET FLD=$ORDER(^TMP("XUMF MFS",$JOB,"PARAM","SEG",SEG,"SEQ",SEQ,0))

 +9       ;

 +10                       IF 'FLD

                               Begin DoDot:3

 +11                               SET FILE=^TMP("XUMF MFS",$JOB,"PARAM","SEG",SEG,"SEQ",SEQ,"FILE")

 +12                               SET IENS=$GET(^TMP("XUMF MFS",$JOB,"PARAM","IENS",SEG,SEQ))

 +13                               SET FIELD=^TMP("XUMF MFS",$JOB,"PARAM","SEG",SEG,"SEQ",SEQ,"FIELD")

 +14                               SET LKUP=$GET(^TMP("XUMF MFS",$JOB,"PARAM","SEG",SEG,"SEQ",SEQ,"LKUP"))

 +15                               IF LKUP

                                       SET FIELD=FIELD_":"_LKUP

 +16                               SET VALUE=$$GET1^DIQ(FILE,IENS,FIELD)

 +17                               SET ARRAY(SEQ)=$$FIELD^XUMF(FILE,$PIECE(FIELD,":"),"LABEL")_": "_VALUE

                               End DoDot:3

 +18                       IF FLD

                               Begin DoDot:3

 +19                               SET ZDTYP=$GET(^TMP("XUMF MFS",$JOB,"PARAM","SEG",SEG,"SEQ",SEQ,FLD))

 +20                               SET LKUP=$PIECE(ZDTYP,U,2)

 +21                               IF LKUP

                                       SET FLD=FLD_":"_LKUP

 +22                               SET VALUE=$$GET1^DIQ(IFN,IEN_",",FLD)

 +23                               SET ARRAY(SEQ)=$$FIELD^XUMF(IFN,$PIECE(FLD,":"),"LABEL")_": "_VALUE

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +24      ;

 +25       QUIT

 +26      ;

XM(X,XUMFKEY) ; -- MailMan notification

 +1       ;

 +2        NEW GROUP,XMDUZ

 +3       ;

 +4        SET HLCS=$GET(HLCS)

           if HLCS=""

               SET HLCS="~"

 +5        SET XUMFKEY=" "_$PIECE($GET(XUMFKEY),HLCS)

 +6       ;

 +7        SET GROUP=$$GET1^DIQ(4.001,IEN_",",.06)

 +8        if GROUP'=""

               SET GROUP="G."_GROUP

 +9        SET X(.1)="HL7 message ID: "_$GET(HL("MID"))

           SET X(.2)=""

 +10      ;S X(.3)="PRE UPDATE VALUES:",X(.4)=""

 +11       SET X(99.1)=""

           SET X(99.2)="POST UPDATE VALUES:"

           SET X(99.3)=""

 +12       SET XMSUB="MFS UPDATE - "_$$FILE^XUMF(IFN,"NAME")_XUMFKEY

 +13       SET XMY("G.XUMF SERVER")=""

           SET XMDUZ=.5

 +14       if GROUP'=""

               SET XMY(GROUP)=""

 +15       SET XMTEXT="X("

 +16      ;

 +17       DO ^XMD

 +18      ;

 +19       QUIT

 +20      ;

MD5       ;MD5 Hash value

 +1        DO EN^XUMF5I(IEN)

 +2        QUIT

XUMFR.m