XUMFR ;OIFO-OAK/RAM - pre/post update subroutines;04/15/02 ;10/12/05 12:12
;;8.0;KERNEL;**335,383**;Jul 10, 1995
;
Q
;
NULL ; -- do nothing
;
Q
;
PRE ; -- pre update
;
N ARRAY
;
K ^TMP("XUMF PRE",$J)
;
D DATA(.ARRAY)
;
M ^TMP("XUMF PRE",$J)=ARRAY
;
Q
;
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)
;
Q
;
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
;
Q
;
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
;
Q
;
MD5 ;MD5 Hash value
D EN^XUMF5I(IEN)
Q
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
