- 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
- ;
- 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 ;
