XUMFXR ;ISS/RAM - MFS param pre/post update;04/15/02
;;8.0;KERNEL;**299**;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
;
S SEG="",SEQ=0
F S SEQ=$O(^TMP("XUMF MFS",$J,"PARAM","SEQ",SEQ)) Q:'SEQ D
.;
.S FLD=$O(^TMP("XUMF MFS",$J,"PARAM","SEQ",SEQ,0))
.;
.I 'FLD D
..S FILE=^TMP("XUMF MFS",$J,"PARAM","SEQ",SEQ,"FILE")
..S IENS=$G(^TMP("XUMF MFS",$J,"PARAM","IENS",SEQ))
..S FIELD=^TMP("XUMF MFS",$J,"PARAM","SEQ",SEQ,"FIELD")
..S LKUP=$G(^TMP("XUMF MFS",$J,"PARAM","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","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
;
MFP ; -- get Master File Parameters from server
;
N X
;
S EXIT=1
S IEN=$$FIND1^DIC(1,,"BX",$P(KEY,HLCS))
;
D MAIN^XUMF299
;
S X(1)="Query sent to MFS to get "_$P(KEY,HLCS)_" parameters"
D XM1(.X)
;
Q
;
XM(X,XUMFKEY) ; -- MailMan notification
;
N GROUP
;
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="XUMF MFS UPDATE - "_$$FILE^XUMF(IFN,"NAME")_XUMFKEY
S XMY("G.XUMF SERVER")="",XMDUZ=.5
S:GROUP'="" XMY(GROUP)=""
S XMTEXT="X("
;
D ^XMD
;
XM1(X) ; -- MailMan notification
;
N GROUP
;
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 XMSUB="XUMF MFE - "_$$FILE^XUMF(IFN,"NAME")
S XMY("G.XUMF SERVER")="",XMDUZ=.5
S:GROUP'="" XMY(GROUP)=""
S XMTEXT="X("
;
D ^XMD
;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUMFXR 2569 printed Dec 13, 2024@02:11:14 Page 2
XUMFXR ;ISS/RAM - MFS param pre/post update;04/15/02
+1 ;;8.0;KERNEL;**299**;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
+3 ;
+4 SET SEG=""
SET SEQ=0
+5 FOR
SET SEQ=$ORDER(^TMP("XUMF MFS",$JOB,"PARAM","SEQ",SEQ))
if 'SEQ
QUIT
Begin DoDot:1
+6 ;
+7 SET FLD=$ORDER(^TMP("XUMF MFS",$JOB,"PARAM","SEQ",SEQ,0))
+8 ;
+9 IF 'FLD
Begin DoDot:2
+10 SET FILE=^TMP("XUMF MFS",$JOB,"PARAM","SEQ",SEQ,"FILE")
+11 SET IENS=$GET(^TMP("XUMF MFS",$JOB,"PARAM","IENS",SEQ))
+12 SET FIELD=^TMP("XUMF MFS",$JOB,"PARAM","SEQ",SEQ,"FIELD")
+13 SET LKUP=$GET(^TMP("XUMF MFS",$JOB,"PARAM","SEQ",SEQ,"LKUP"))
+14 IF LKUP
SET FIELD=FIELD_":"_LKUP
+15 SET VALUE=$$GET1^DIQ(FILE,IENS,FIELD)
+16 SET ARRAY(SEQ)=$$FIELD^XUMF(FILE,$PIECE(FIELD,":"),"LABEL")_": "_VALUE
End DoDot:2
+17 IF FLD
Begin DoDot:2
+18 SET ZDTYP=$GET(^TMP("XUMF MFS",$JOB,"PARAM","SEQ",SEQ,FLD))
+19 SET LKUP=$PIECE(ZDTYP,U,2)
+20 IF LKUP
SET FLD=FLD_":"_LKUP
+21 SET VALUE=$$GET1^DIQ(IFN,IEN_",",FLD)
+22 SET ARRAY(SEQ)=$$FIELD^XUMF(IFN,$PIECE(FLD,":"),"LABEL")_": "_VALUE
End DoDot:2
End DoDot:1
+23 ;
+24 QUIT
+25 ;
MFP ; -- get Master File Parameters from server
+1 ;
+2 NEW X
+3 ;
+4 SET EXIT=1
+5 SET IEN=$$FIND1^DIC(1,,"BX",$PIECE(KEY,HLCS))
+6 ;
+7 DO MAIN^XUMF299
+8 ;
+9 SET X(1)="Query sent to MFS to get "_$PIECE(KEY,HLCS)_" parameters"
+10 DO XM1(.X)
+11 ;
+12 QUIT
+13 ;
XM(X,XUMFKEY) ; -- MailMan notification
+1 ;
+2 NEW GROUP
+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 SET X(.3)="PRE UPDATE VALUES:"
SET X(.4)=""
+11 SET X(99.1)=""
SET X(99.2)="POST UPDATE VALUES:"
SET X(99.3)=""
+12 SET XMSUB="XUMF 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 ;
XM1(X) ; -- MailMan notification
+1 ;
+2 NEW GROUP
+3 ;
+4 SET GROUP=$$GET1^DIQ(4.001,IEN_",",.06)
+5 if GROUP'=""
SET GROUP="G."_GROUP
+6 SET X(.1)="HL7 message ID: "_$GET(HL("MID"))
SET X(.2)=""
+7 SET XMSUB="XUMF MFE - "_$$FILE^XUMF(IFN,"NAME")
+8 SET XMY("G.XUMF SERVER")=""
SET XMDUZ=.5
+9 if GROUP'=""
SET XMY(GROUP)=""
+10 SET XMTEXT="X("
+11 ;
+12 DO ^XMD
+13 ;
+14 QUIT
+15 ;
