PXRMP6IM ; SLC/PKR - Inits for PXRM*2.0*6 ;11/08/2007
;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
;========================
ENVCHK ;Environment check.
I '$$PATCH^XPDUTL("YS*5.01*85") D Q
. W !,"The required patch YS*5.01*85 is not installed, therefore PXRM*2.0*6 cannot"
. W !,"be installed."
. S XPDABORT=1
N NLINES
D HMHPTRS^PXRMP6IM(.NLINES,0)
I NLINES>0 D
. W !,"There are MH findings that cannot be converted; reminders, terms, and"
. W !,"dialogs using these findings will not work properly."
. W !!,"A message giving the details has been sent to the reminders mail group."
. N ANS
. S ANS=$$ASKYN^PXRMEUT("Y","Continue the installation")
. I ANS=0 S XPDABORT=1
;Don't ask about disabling options and protocols since we are taking
;care of them automatically.
S XPDDIQ("XPZ1")=0
;Make the default for inhibiting logins NO.
S XPDDIQ("XPI1","B")="NO"
Q
;
;========================
HMHPTRS(NLINES,REPOINT) ;Handle MH pointers. Check for 601 tests that are
;obsolete and change existing MH pointers in definitions, terms,
;and dialogs to point the new global 601.71.
N DNAME,DTYPE,EM,FI,IEN,IENS,MHNAME,MSG,NEWPTR,NEWSC,NNCONV
N OLDPTR,OLDSC,RNAME
N STATUS,TEMP,TERMNAME,TEXT,TNAME,YS,YSCODE,YSDATA
K ^TMP($J,"MH"),^TMP("PXRMXMZ",$J)
;Check definitions.
S (IEN,NLINES,NNCONV)=0
F S IEN=+$O(^PXD(811.9,IEN)) Q:IEN=0 D
. I '$D(^PXD(811.9,IEN,20,"E","YTT(601,")) Q
. S TEMP=^PXD(811.9,IEN,0)
. S RNAME=$P(TEMP,U,1)
. I REPOINT D
.. S TEXT="Changing MH pointers in reminder definition "_RNAME_" IEN="_IEN
.. D BMES^XPDUTL(.TEXT)
. S STATUS=$S($P(TEMP,U,6)=1:"INACTIVE",1:"ACTIVE")
. S ^TMP($J,"MH",RNAME)=STATUS
. S OLDPTR=""
. F S OLDPTR=$O(^PXD(811.9,IEN,20,"E","YTT(601,",OLDPTR)) Q:OLDPTR="" D
.. S FI=0
.. F S FI=$O(^PXD(811.9,IEN,20,"E","YTT(601,",OLDPTR,FI)) Q:FI="" D
... K YS,YSDATA
... S YS("YS601")=OLDPTR
...;DBIA #5043
... D CONVERT^YTQPXRM6(.YSDATA,.YS)
... S NEWPTR=$P(YSDATA(2),U,1)
... I YSDATA(1)="[ERROR]" D
.... S NEWPTR=109
.... S MHNAME=$$GET1^DIQ(601,OLDPTR,.01,"","","")
.... S NNCONV=NNCONV+1
.... S ^TMP($J,"MH",RNAME,"FINDING",FI)=MHNAME
... I REPOINT D
.... S TEXT="Converting finding number "_FI
.... D MES^XPDUTL(.TEXT)
.... S IENS=FI_","_IEN_","
.... D UPDATE(811.902,IENS,.01,NEWPTR)
....;Convert the scale.
.... S OLDSC=$P(^PXD(811.9,IEN,20,FI,0),U,12)
....;DBIA #5042
.... S NEWSC=$S(OLDSC'="":$$OLDNEW^YTQPXRM3(NEWPTR,OLDSC),1:"")
.... S $P(^PXD(811.9,IEN,20,FI,0),U,12)=NEWSC
;Format the message.
I NNCONV>0 D
. S NLINES=0,RNAME=""
. F S RNAME=$O(^TMP($J,"MH",RNAME)) Q:RNAME="" D
.. I '$D(^TMP($J,"MH",RNAME,"FINDING")) Q
.. S TEXT="Reminder "_RNAME_", status "_^TMP($J,"MH",RNAME)_", has the following MH findings which cannot be converted:"
.. S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=TEXT
.. S FI=""
.. F S FI=$O(^TMP($J,"MH",RNAME,"FINDING",FI)) Q:FI="" D
... S TEXT=" Finding number "_FI_", MH instrument "_^TMP($J,"MH",RNAME,"FINDING",FI)
... S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=TEXT
.. S TEXT="This reminder will not function properly until it is repaired."
.. S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=TEXT
.. S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=" "
;
;Check terms.
K ^TMP($J,"MH")
S (IEN,NNCONV)=0
F S IEN=+$O(^PXRMD(811.5,IEN)) Q:IEN=0 D
. I '$D(^PXRMD(811.5,IEN,20,"E","YTT(601,")) Q
. S TEMP=^PXRMD(811.5,IEN,0)
. S TERMNAME=$P(TEMP,U,1)
. I REPOINT D
.. S TEXT="Changing MH pointers in reminder term "_TERMNAME_" IEN="_IEN
.. D BMES^XPDUTL(.TEXT)
. S STATUS=$S($P(TEMP,U,6)=1:"INACTIVE",1:"ACTIVE")
. S ^TMP($J,"MH",TERMNAME)=STATUS
. S OLDPTR=""
. F S OLDPTR=$O(^PXRMD(811.5,IEN,20,"E","YTT(601,",OLDPTR)) Q:OLDPTR="" D
.. S FI=0
.. F S FI=$O(^PXRMD(811.5,IEN,20,"E","YTT(601,",OLDPTR,FI)) Q:FI="" D
... K YS,YSDATA
... S YS("YS601")=OLDPTR
... D CONVERT^YTQPXRM6(.YSDATA,.YS)
... S NEWPTR=$P(YSDATA(2),U,1)
... I YSDATA(1)="[ERROR]" D
.... S NEWPTR=109
.... S MHNAME=$$GET1^DIQ(601,OLDPTR,.01,"","","")
.... S NNCONV=NNCONV+1
.... S ^TMP($J,"MH",TERMNAME,"FINDING",FI)=MHNAME
... I REPOINT D
.... S TEXT="Converting finding number "_FI
.... D MES^XPDUTL(.TEXT)
.... S IENS=FI_","_IEN_","
.... D UPDATE(811.52,IENS,.01,NEWPTR)
....;Convert the scale.
.... S OLDSC=$P(^PXRMD(811.5,IEN,20,FI,0),U,12)
....;DBIA #5042
.... S NEWSC=$S(OLDSC'="":$$OLDNEW^YTQPXRM3(NEWPTR,OLDSC),1:"")
.... S $P(^PXRMD(811.5,IEN,20,FI,0),U,12)=NEWSC
;Format the message.
I NNCONV>0 D
. S TERMNAME=""
. F S TERMNAME=$O(^TMP($J,"MH",TERMNAME)) Q:TERMNAME="" D
.. I '$D(^TMP($J,"MH",TERMNAME,"FINDING")) Q
.. S TEXT="Term "_TERMNAME_", status "_^TMP($J,"MH",TERMNAME)_", has the following MH findings which cannot be converted:"
.. S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=TEXT
.. S FI=""
.. F S FI=$O(^TMP($J,"MH",TERMNAME,"FINDING",FI)) Q:FI="" D
... S TEXT=" Finding number "_FI_", MH instrument "_^TMP($J,"MH",TERMNAME,"FINDING",FI)
... S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=TEXT
.. S TEXT="This term will not function properly until it is repaired."
.. S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=TEXT
.. S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=" "
;
;Check dialogs.
N PXRMINST
S PXRMINST=1
K ^TMP($J,"MH")
S (IEN,NNCONV)=0
F S IEN=+$O(^PXRMD(801.41,IEN)) Q:IEN=0 D
. I $P($G(^PXRMD(801.41,IEN,1)),U,5)'["YTT(601," Q
. S TEMP=^PXRMD(801.41,IEN,0)
. S DNAME=$P(TEMP,U,1)
. S DTYPE=$P(TEMP,U,4)
. S STATUS=$S($P(TEMP,U,3)=1:"DISABLE",1:"ACTIVE")
. S ^TMP($J,"MH",DNAME)=STATUS_U_DTYPE
. I REPOINT D
.. S TEXT="Changing MH pointers in reminder dialog "_DNAME_" IEN="_IEN
.. D BMES^XPDUTL(.TEXT)
. S OLDPTR=$P($P(^PXRMD(801.41,IEN,1),U,5),";")
. K YS,YSDATA
. S YS("YS601")=OLDPTR
. D CONVERT^YTQPXRM6(.YSDATA,.YS)
. S NEWPTR=$P(YSDATA(2),U,1)
. I (YSDATA(1)="[ERROR]")!(NEWPTR="dropped") D
.. S NEWPTR=109
.. S MHNAME=$$GET1^DIQ(601,OLDPTR,.01,"","","")
.. S NNCONV=NNCONV+1
.. S ^TMP($J,"MH",DNAME,"FINDING",1)=MHNAME
. I REPOINT D
.. S IENS=IEN_","
.. D UPDATE(801.41,IENS,15,NEWPTR)
;Format the message.
I NNCONV>0 D
. S DNAME=""
. F S DNAME=$O(^TMP($J,"MH",DNAME)) Q:DNAME="" D
.. I '$D(^TMP($J,"MH",DNAME,"FINDING")) Q
.. S STATUS=$P(^TMP($J,"MH",DNAME),U,1)
.. S DTYPE=$P(^TMP($J,"MH",DNAME),U,2)
.. S DTYPE=$$EXTERNAL^DILFD(801.41,4,"",DTYPE,.EM)
.. S TEXT="Dialog entry "_DNAME_", type "_DTYPE_", status "_STATUS_", has the following MH findings which cannot be converted:"
.. S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=TEXT
.. S FI=""
.. F S FI=$O(^TMP($J,"MH",DNAME,"FINDING",FI)) Q:FI="" D
... S TEXT=" Finding number "_FI_", MH instrument "_^TMP($J,"MH",DNAME,"FINDING",FI)
... S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=TEXT
.. S TEXT="This dialog will not function properly until it is repaired."
.. S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=TEXT
.. S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=" "
. S TEXT="For instructions on what to do with these entries see the PXRM*2*6"
. S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=TEXT
. S TEXT="Installation Guide."
. S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=TEXT
. S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=" "
I NLINES=0 Q
K ^TMP($J,"MH")
D SEND^PXRMMSG("MH findings that cannot be converted")
K ^TMP("PXRMXMZ",$J)
Q
;
;========================
UPDATE(FILENUM,IENS,FIELD,IEN) ;Update an MH finding.
N FDA,MSG
S FDA(FILENUM,IENS,FIELD)="MH.`"_IEN
D UPDATE^DIE("E","FDA","","MSG")
I $D(MSG) D
. N TEXT
. D ACOPY^PXRMUTIL("MSG","TEXT()")
. D BMES^XPDUTL("The MH update failed, UPDATE^DIE returned the following error message:")
. D MES^XPDUTL(.TEXT)
. D MES^XPDUTL("Examine the above error message for the reason.")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMP6IM 7913 printed Dec 13, 2024@01:48:11 Page 2
PXRMP6IM ; SLC/PKR - Inits for PXRM*2.0*6 ;11/08/2007
+1 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
+2 ;========================
ENVCHK ;Environment check.
+1 IF '$$PATCH^XPDUTL("YS*5.01*85")
Begin DoDot:1
+2 WRITE !,"The required patch YS*5.01*85 is not installed, therefore PXRM*2.0*6 cannot"
+3 WRITE !,"be installed."
+4 SET XPDABORT=1
End DoDot:1
QUIT
+5 NEW NLINES
+6 DO HMHPTRS^PXRMP6IM(.NLINES,0)
+7 IF NLINES>0
Begin DoDot:1
+8 WRITE !,"There are MH findings that cannot be converted; reminders, terms, and"
+9 WRITE !,"dialogs using these findings will not work properly."
+10 WRITE !!,"A message giving the details has been sent to the reminders mail group."
+11 NEW ANS
+12 SET ANS=$$ASKYN^PXRMEUT("Y","Continue the installation")
+13 IF ANS=0
SET XPDABORT=1
End DoDot:1
+14 ;Don't ask about disabling options and protocols since we are taking
+15 ;care of them automatically.
+16 SET XPDDIQ("XPZ1")=0
+17 ;Make the default for inhibiting logins NO.
+18 SET XPDDIQ("XPI1","B")="NO"
+19 QUIT
+20 ;
+21 ;========================
HMHPTRS(NLINES,REPOINT) ;Handle MH pointers. Check for 601 tests that are
+1 ;obsolete and change existing MH pointers in definitions, terms,
+2 ;and dialogs to point the new global 601.71.
+3 NEW DNAME,DTYPE,EM,FI,IEN,IENS,MHNAME,MSG,NEWPTR,NEWSC,NNCONV
+4 NEW OLDPTR,OLDSC,RNAME
+5 NEW STATUS,TEMP,TERMNAME,TEXT,TNAME,YS,YSCODE,YSDATA
+6 KILL ^TMP($JOB,"MH"),^TMP("PXRMXMZ",$JOB)
+7 ;Check definitions.
+8 SET (IEN,NLINES,NNCONV)=0
+9 FOR
SET IEN=+$ORDER(^PXD(811.9,IEN))
if IEN=0
QUIT
Begin DoDot:1
+10 IF '$DATA(^PXD(811.9,IEN,20,"E","YTT(601,"))
QUIT
+11 SET TEMP=^PXD(811.9,IEN,0)
+12 SET RNAME=$PIECE(TEMP,U,1)
+13 IF REPOINT
Begin DoDot:2
+14 SET TEXT="Changing MH pointers in reminder definition "_RNAME_" IEN="_IEN
+15 DO BMES^XPDUTL(.TEXT)
End DoDot:2
+16 SET STATUS=$SELECT($PIECE(TEMP,U,6)=1:"INACTIVE",1:"ACTIVE")
+17 SET ^TMP($JOB,"MH",RNAME)=STATUS
+18 SET OLDPTR=""
+19 FOR
SET OLDPTR=$ORDER(^PXD(811.9,IEN,20,"E","YTT(601,",OLDPTR))
if OLDPTR=""
QUIT
Begin DoDot:2
+20 SET FI=0
+21 FOR
SET FI=$ORDER(^PXD(811.9,IEN,20,"E","YTT(601,",OLDPTR,FI))
if FI=""
QUIT
Begin DoDot:3
+22 KILL YS,YSDATA
+23 SET YS("YS601")=OLDPTR
+24 ;DBIA #5043
+25 DO CONVERT^YTQPXRM6(.YSDATA,.YS)
+26 SET NEWPTR=$PIECE(YSDATA(2),U,1)
+27 IF YSDATA(1)="[ERROR]"
Begin DoDot:4
+28 SET NEWPTR=109
+29 SET MHNAME=$$GET1^DIQ(601,OLDPTR,.01,"","","")
+30 SET NNCONV=NNCONV+1
+31 SET ^TMP($JOB,"MH",RNAME,"FINDING",FI)=MHNAME
End DoDot:4
+32 IF REPOINT
Begin DoDot:4
+33 SET TEXT="Converting finding number "_FI
+34 DO MES^XPDUTL(.TEXT)
+35 SET IENS=FI_","_IEN_","
+36 DO UPDATE(811.902,IENS,.01,NEWPTR)
+37 ;Convert the scale.
+38 SET OLDSC=$PIECE(^PXD(811.9,IEN,20,FI,0),U,12)
+39 ;DBIA #5042
+40 SET NEWSC=$SELECT(OLDSC'="":$$OLDNEW^YTQPXRM3(NEWPTR,OLDSC),1:"")
+41 SET $PIECE(^PXD(811.9,IEN,20,FI,0),U,12)=NEWSC
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+42 ;Format the message.
+43 IF NNCONV>0
Begin DoDot:1
+44 SET NLINES=0
SET RNAME=""
+45 FOR
SET RNAME=$ORDER(^TMP($JOB,"MH",RNAME))
if RNAME=""
QUIT
Begin DoDot:2
+46 IF '$DATA(^TMP($JOB,"MH",RNAME,"FINDING"))
QUIT
+47 SET TEXT="Reminder "_RNAME_", status "_^TMP($JOB,"MH",RNAME)_", has the following MH findings which cannot be converted:"
+48 SET NLINES=NLINES+1
SET ^TMP("PXRMXMZ",$JOB,NLINES,0)=TEXT
+49 SET FI=""
+50 FOR
SET FI=$ORDER(^TMP($JOB,"MH",RNAME,"FINDING",FI))
if FI=""
QUIT
Begin DoDot:3
+51 SET TEXT=" Finding number "_FI_", MH instrument "_^TMP($JOB,"MH",RNAME,"FINDING",FI)
+52 SET NLINES=NLINES+1
SET ^TMP("PXRMXMZ",$JOB,NLINES,0)=TEXT
End DoDot:3
+53 SET TEXT="This reminder will not function properly until it is repaired."
+54 SET NLINES=NLINES+1
SET ^TMP("PXRMXMZ",$JOB,NLINES,0)=TEXT
+55 SET NLINES=NLINES+1
SET ^TMP("PXRMXMZ",$JOB,NLINES,0)=" "
End DoDot:2
End DoDot:1
+56 ;
+57 ;Check terms.
+58 KILL ^TMP($JOB,"MH")
+59 SET (IEN,NNCONV)=0
+60 FOR
SET IEN=+$ORDER(^PXRMD(811.5,IEN))
if IEN=0
QUIT
Begin DoDot:1
+61 IF '$DATA(^PXRMD(811.5,IEN,20,"E","YTT(601,"))
QUIT
+62 SET TEMP=^PXRMD(811.5,IEN,0)
+63 SET TERMNAME=$PIECE(TEMP,U,1)
+64 IF REPOINT
Begin DoDot:2
+65 SET TEXT="Changing MH pointers in reminder term "_TERMNAME_" IEN="_IEN
+66 DO BMES^XPDUTL(.TEXT)
End DoDot:2
+67 SET STATUS=$SELECT($PIECE(TEMP,U,6)=1:"INACTIVE",1:"ACTIVE")
+68 SET ^TMP($JOB,"MH",TERMNAME)=STATUS
+69 SET OLDPTR=""
+70 FOR
SET OLDPTR=$ORDER(^PXRMD(811.5,IEN,20,"E","YTT(601,",OLDPTR))
if OLDPTR=""
QUIT
Begin DoDot:2
+71 SET FI=0
+72 FOR
SET FI=$ORDER(^PXRMD(811.5,IEN,20,"E","YTT(601,",OLDPTR,FI))
if FI=""
QUIT
Begin DoDot:3
+73 KILL YS,YSDATA
+74 SET YS("YS601")=OLDPTR
+75 DO CONVERT^YTQPXRM6(.YSDATA,.YS)
+76 SET NEWPTR=$PIECE(YSDATA(2),U,1)
+77 IF YSDATA(1)="[ERROR]"
Begin DoDot:4
+78 SET NEWPTR=109
+79 SET MHNAME=$$GET1^DIQ(601,OLDPTR,.01,"","","")
+80 SET NNCONV=NNCONV+1
+81 SET ^TMP($JOB,"MH",TERMNAME,"FINDING",FI)=MHNAME
End DoDot:4
+82 IF REPOINT
Begin DoDot:4
+83 SET TEXT="Converting finding number "_FI
+84 DO MES^XPDUTL(.TEXT)
+85 SET IENS=FI_","_IEN_","
+86 DO UPDATE(811.52,IENS,.01,NEWPTR)
+87 ;Convert the scale.
+88 SET OLDSC=$PIECE(^PXRMD(811.5,IEN,20,FI,0),U,12)
+89 ;DBIA #5042
+90 SET NEWSC=$SELECT(OLDSC'="":$$OLDNEW^YTQPXRM3(NEWPTR,OLDSC),1:"")
+91 SET $PIECE(^PXRMD(811.5,IEN,20,FI,0),U,12)=NEWSC
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+92 ;Format the message.
+93 IF NNCONV>0
Begin DoDot:1
+94 SET TERMNAME=""
+95 FOR
SET TERMNAME=$ORDER(^TMP($JOB,"MH",TERMNAME))
if TERMNAME=""
QUIT
Begin DoDot:2
+96 IF '$DATA(^TMP($JOB,"MH",TERMNAME,"FINDING"))
QUIT
+97 SET TEXT="Term "_TERMNAME_", status "_^TMP($JOB,"MH",TERMNAME)_", has the following MH findings which cannot be converted:"
+98 SET NLINES=NLINES+1
SET ^TMP("PXRMXMZ",$JOB,NLINES,0)=TEXT
+99 SET FI=""
+100 FOR
SET FI=$ORDER(^TMP($JOB,"MH",TERMNAME,"FINDING",FI))
if FI=""
QUIT
Begin DoDot:3
+101 SET TEXT=" Finding number "_FI_", MH instrument "_^TMP($JOB,"MH",TERMNAME,"FINDING",FI)
+102 SET NLINES=NLINES+1
SET ^TMP("PXRMXMZ",$JOB,NLINES,0)=TEXT
End DoDot:3
+103 SET TEXT="This term will not function properly until it is repaired."
+104 SET NLINES=NLINES+1
SET ^TMP("PXRMXMZ",$JOB,NLINES,0)=TEXT
+105 SET NLINES=NLINES+1
SET ^TMP("PXRMXMZ",$JOB,NLINES,0)=" "
End DoDot:2
End DoDot:1
+106 ;
+107 ;Check dialogs.
+108 NEW PXRMINST
+109 SET PXRMINST=1
+110 KILL ^TMP($JOB,"MH")
+111 SET (IEN,NNCONV)=0
+112 FOR
SET IEN=+$ORDER(^PXRMD(801.41,IEN))
if IEN=0
QUIT
Begin DoDot:1
+113 IF $PIECE($GET(^PXRMD(801.41,IEN,1)),U,5)'["YTT(601,"
QUIT
+114 SET TEMP=^PXRMD(801.41,IEN,0)
+115 SET DNAME=$PIECE(TEMP,U,1)
+116 SET DTYPE=$PIECE(TEMP,U,4)
+117 SET STATUS=$SELECT($PIECE(TEMP,U,3)=1:"DISABLE",1:"ACTIVE")
+118 SET ^TMP($JOB,"MH",DNAME)=STATUS_U_DTYPE
+119 IF REPOINT
Begin DoDot:2
+120 SET TEXT="Changing MH pointers in reminder dialog "_DNAME_" IEN="_IEN
+121 DO BMES^XPDUTL(.TEXT)
End DoDot:2
+122 SET OLDPTR=$PIECE($PIECE(^PXRMD(801.41,IEN,1),U,5),";")
+123 KILL YS,YSDATA
+124 SET YS("YS601")=OLDPTR
+125 DO CONVERT^YTQPXRM6(.YSDATA,.YS)
+126 SET NEWPTR=$PIECE(YSDATA(2),U,1)
+127 IF (YSDATA(1)="[ERROR]")!(NEWPTR="dropped")
Begin DoDot:2
+128 SET NEWPTR=109
+129 SET MHNAME=$$GET1^DIQ(601,OLDPTR,.01,"","","")
+130 SET NNCONV=NNCONV+1
+131 SET ^TMP($JOB,"MH",DNAME,"FINDING",1)=MHNAME
End DoDot:2
+132 IF REPOINT
Begin DoDot:2
+133 SET IENS=IEN_","
+134 DO UPDATE(801.41,IENS,15,NEWPTR)
End DoDot:2
End DoDot:1
+135 ;Format the message.
+136 IF NNCONV>0
Begin DoDot:1
+137 SET DNAME=""
+138 FOR
SET DNAME=$ORDER(^TMP($JOB,"MH",DNAME))
if DNAME=""
QUIT
Begin DoDot:2
+139 IF '$DATA(^TMP($JOB,"MH",DNAME,"FINDING"))
QUIT
+140 SET STATUS=$PIECE(^TMP($JOB,"MH",DNAME),U,1)
+141 SET DTYPE=$PIECE(^TMP($JOB,"MH",DNAME),U,2)
+142 SET DTYPE=$$EXTERNAL^DILFD(801.41,4,"",DTYPE,.EM)
+143 SET TEXT="Dialog entry "_DNAME_", type "_DTYPE_", status "_STATUS_", has the following MH findings which cannot be converted:"
+144 SET NLINES=NLINES+1
SET ^TMP("PXRMXMZ",$JOB,NLINES,0)=TEXT
+145 SET FI=""
+146 FOR
SET FI=$ORDER(^TMP($JOB,"MH",DNAME,"FINDING",FI))
if FI=""
QUIT
Begin DoDot:3
+147 SET TEXT=" Finding number "_FI_", MH instrument "_^TMP($JOB,"MH",DNAME,"FINDING",FI)
+148 SET NLINES=NLINES+1
SET ^TMP("PXRMXMZ",$JOB,NLINES,0)=TEXT
End DoDot:3
+149 SET TEXT="This dialog will not function properly until it is repaired."
+150 SET NLINES=NLINES+1
SET ^TMP("PXRMXMZ",$JOB,NLINES,0)=TEXT
+151 SET NLINES=NLINES+1
SET ^TMP("PXRMXMZ",$JOB,NLINES,0)=" "
End DoDot:2
+152 SET TEXT="For instructions on what to do with these entries see the PXRM*2*6"
+153 SET NLINES=NLINES+1
SET ^TMP("PXRMXMZ",$JOB,NLINES,0)=TEXT
+154 SET TEXT="Installation Guide."
+155 SET NLINES=NLINES+1
SET ^TMP("PXRMXMZ",$JOB,NLINES,0)=TEXT
+156 SET NLINES=NLINES+1
SET ^TMP("PXRMXMZ",$JOB,NLINES,0)=" "
End DoDot:1
+157 IF NLINES=0
QUIT
+158 KILL ^TMP($JOB,"MH")
+159 DO SEND^PXRMMSG("MH findings that cannot be converted")
+160 KILL ^TMP("PXRMXMZ",$JOB)
+161 QUIT
+162 ;
+163 ;========================
UPDATE(FILENUM,IENS,FIELD,IEN) ;Update an MH finding.
+1 NEW FDA,MSG
+2 SET FDA(FILENUM,IENS,FIELD)="MH.`"_IEN
+3 DO UPDATE^DIE("E","FDA","","MSG")
+4 IF $DATA(MSG)
Begin DoDot:1
+5 NEW TEXT
+6 DO ACOPY^PXRMUTIL("MSG","TEXT()")
+7 DO BMES^XPDUTL("The MH update failed, UPDATE^DIE returned the following error message:")
+8 DO MES^XPDUTL(.TEXT)
+9 DO MES^XPDUTL("Examine the above error message for the reason.")
End DoDot:1
+10 QUIT
+11 ;
