Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXRMP6IM

PXRMP6IM.m

Go to the documentation of this file. 
  1. PXRMP6IM ; SLC/PKR - Inits for PXRM*2.0*6 ;11/08/2007
  1.  ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
  1.  ;========================
  1. ENVCHK ;Environment check.
  1.  ;I '$$PATCH^XPDUTL("YS*5.01*85") D  Q
  1.  ;. W !,"The required patch YS*5.01*85 is not installed, therefore PXRM*2.0*6 cannot"
  1.  ;. W !,"be installed."
  1.  ;. S XPDABORT=1
  1.  ;N NLINES
  1.  ;D HMHPTRS^PXRMP6IM(.NLINES,0)
  1.  ;I NLINES>0 D
  1.  ;. W !,"There are MH findings that cannot be converted; reminders, terms, and"
  1.  ;. W !,"dialogs using these findings will not work properly."
  1.  ;. W !!,"A message giving the details has been sent to the reminders mail group."
  1.  ;. N ANS
  1.  ;. S ANS=$$ASKYN^PXRMEUT("Y","Continue the installation")
  1.  ;. I ANS=0 S XPDABORT=1
  1.  ;Don't ask about disabling options and protocols since we are taking
  1.  ;care of them automatically.
  1.  S XPDDIQ("XPZ1")=0
  1.  ;Make the default for inhibiting logins NO.
  1.  S XPDDIQ("XPI1","B")="NO"
  1.  Q
  1.  ;
  1.  ;========================
  1. HMHPTRS(NLINES,REPOINT) ;Handle MH pointers. Check for 601 tests that are
  1.  ;obsolete and change existing MH pointers in definitions, terms,
  1.  ;and dialogs to point the new global 601.71.
  1.  N DNAME,DTYPE,EM,FI,IEN,IENS,MHNAME,MSG,NEWPTR,NEWSC,NNCONV
  1.  N OLDPTR,OLDSC,RNAME
  1.  N STATUS,TEMP,TERMNAME,TEXT,TNAME,YS,YSCODE,YSDATA
  1.  K ^TMP($J,"MH"),^TMP("PXRMXMZ",$J)
  1.  ;Check definitions.
  1.  S (IEN,NLINES,NNCONV)=0
  1.  F  S IEN=+$O(^PXD(811.9,IEN)) Q:IEN=0  D
  1.  . I '$D(^PXD(811.9,IEN,20,"E","YTT(601,")) Q
  1.  . S TEMP=^PXD(811.9,IEN,0)
  1.  . S RNAME=$P(TEMP,U,1)
  1.  . I REPOINT D
  1.  .. S TEXT="Changing MH pointers in reminder definition "_RNAME_" IEN="_IEN
  1.  .. D BMES^XPDUTL(.TEXT)
  1.  . S STATUS=$S($P(TEMP,U,6)=1:"INACTIVE",1:"ACTIVE")
  1.  . S ^TMP($J,"MH",RNAME)=STATUS
  1.  . S OLDPTR=""
  1.  . F  S OLDPTR=$O(^PXD(811.9,IEN,20,"E","YTT(601,",OLDPTR)) Q:OLDPTR=""  D
  1.  .. S FI=0
  1.  .. F  S FI=$O(^PXD(811.9,IEN,20,"E","YTT(601,",OLDPTR,FI)) Q:FI=""  D
  1.  ... K YS,YSDATA
  1.  ... S YS("YS601")=OLDPTR
  1.  ...;DBIA #5043
  1.  ... D CONVERT^YTQPXRM6(.YSDATA,.YS)
  1.  ... S NEWPTR=$P(YSDATA(2),U,1)
  1.  ... I YSDATA(1)="[ERROR]" D
  1.  .... S NEWPTR=109
  1.  .... S MHNAME=$$GET1^DIQ(601,OLDPTR,.01,"","","")
  1.  .... S NNCONV=NNCONV+1
  1.  .... S ^TMP($J,"MH",RNAME,"FINDING",FI)=MHNAME
  1.  ... I REPOINT D
  1.  .... S TEXT="Converting finding number "_FI
  1.  .... D MES^XPDUTL(.TEXT)
  1.  .... S IENS=FI_","_IEN_","
  1.  .... D UPDATE(811.902,IENS,.01,NEWPTR)
  1.  ....;Convert the scale.
  1.  .... S OLDSC=$P(^PXD(811.9,IEN,20,FI,0),U,12)
  1.  ....;DBIA #5042
  1.  .... S NEWSC=$S(OLDSC'="":$$OLDNEW^YTQPXRM3(NEWPTR,OLDSC),1:"")
  1.  .... S $P(^PXD(811.9,IEN,20,FI,0),U,12)=NEWSC
  1.  ;Format the message.
  1.  I NNCONV>0 D
  1.  . S NLINES=0,RNAME=""
  1.  . F  S RNAME=$O(^TMP($J,"MH",RNAME)) Q:RNAME=""  D
  1.  .. I '$D(^TMP($J,"MH",RNAME,"FINDING")) Q
  1.  .. S TEXT="Reminder "_RNAME_", status "_^TMP($J,"MH",RNAME)_", has the following MH findings which cannot be converted:"
  1.  .. S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=TEXT
  1.  .. S FI=""
  1.  .. F  S FI=$O(^TMP($J,"MH",RNAME,"FINDING",FI)) Q:FI=""  D
  1.  ... S TEXT="  Finding number "_FI_", MH instrument "_^TMP($J,"MH",RNAME,"FINDING",FI)
  1.  ... S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=TEXT
  1.  .. S TEXT="This reminder will not function properly until it is repaired."
  1.  .. S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=TEXT
  1.  .. S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=" "
  1.  ;
  1.  ;Check terms.
  1.  K ^TMP($J,"MH")
  1.  S (IEN,NNCONV)=0
  1.  F  S IEN=+$O(^PXRMD(811.5,IEN)) Q:IEN=0  D
  1.  . I '$D(^PXRMD(811.5,IEN,20,"E","YTT(601,")) Q
  1.  . S TEMP=^PXRMD(811.5,IEN,0)
  1.  . S TERMNAME=$P(TEMP,U,1)
  1.  . I REPOINT D
  1.  .. S TEXT="Changing MH pointers in reminder term "_TERMNAME_" IEN="_IEN
  1.  .. D BMES^XPDUTL(.TEXT)
  1.  . S STATUS=$S($P(TEMP,U,6)=1:"INACTIVE",1:"ACTIVE")
  1.  . S ^TMP($J,"MH",TERMNAME)=STATUS
  1.  . S OLDPTR=""
  1.  . F  S OLDPTR=$O(^PXRMD(811.5,IEN,20,"E","YTT(601,",OLDPTR)) Q:OLDPTR=""  D
  1.  .. S FI=0
  1.  .. F  S FI=$O(^PXRMD(811.5,IEN,20,"E","YTT(601,",OLDPTR,FI)) Q:FI=""  D
  1.  ... K YS,YSDATA
  1.  ... S YS("YS601")=OLDPTR
  1.  ... D CONVERT^YTQPXRM6(.YSDATA,.YS)
  1.  ... S NEWPTR=$P(YSDATA(2),U,1)
  1.  ... I YSDATA(1)="[ERROR]" D
  1.  .... S NEWPTR=109
  1.  .... S MHNAME=$$GET1^DIQ(601,OLDPTR,.01,"","","")
  1.  .... S NNCONV=NNCONV+1
  1.  .... S ^TMP($J,"MH",TERMNAME,"FINDING",FI)=MHNAME
  1.  ... I REPOINT D
  1.  .... S TEXT="Converting finding number "_FI
  1.  .... D MES^XPDUTL(.TEXT)
  1.  .... S IENS=FI_","_IEN_","
  1.  .... D UPDATE(811.52,IENS,.01,NEWPTR)
  1.  ....;Convert the scale.
  1.  .... S OLDSC=$P(^PXRMD(811.5,IEN,20,FI,0),U,12)
  1.  ....;DBIA #5042
  1.  .... S NEWSC=$S(OLDSC'="":$$OLDNEW^YTQPXRM3(NEWPTR,OLDSC),1:"")
  1.  .... S $P(^PXRMD(811.5,IEN,20,FI,0),U,12)=NEWSC
  1.  ;Format the message.
  1.  I NNCONV>0 D
  1.  . S TERMNAME=""
  1.  . F  S TERMNAME=$O(^TMP($J,"MH",TERMNAME)) Q:TERMNAME=""  D
  1.  .. I '$D(^TMP($J,"MH",TERMNAME,"FINDING")) Q
  1.  .. S TEXT="Term "_TERMNAME_", status "_^TMP($J,"MH",TERMNAME)_", has the following MH findings which cannot be converted:"
  1.  .. S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=TEXT
  1.  .. S FI=""
  1.  .. F  S FI=$O(^TMP($J,"MH",TERMNAME,"FINDING",FI)) Q:FI=""  D
  1.  ... S TEXT="  Finding number "_FI_", MH instrument "_^TMP($J,"MH",TERMNAME,"FINDING",FI)
  1.  ... S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=TEXT
  1.  .. S TEXT="This term will not function properly until it is repaired."
  1.  .. S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=TEXT
  1.  .. S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=" "
  1.  ;
  1.  ;Check dialogs.
  1.  N PXRMINST
  1.  S PXRMINST=1
  1.  K ^TMP($J,"MH")
  1.  S (IEN,NNCONV)=0
  1.  F  S IEN=+$O(^PXRMD(801.41,IEN)) Q:IEN=0  D
  1.  . I $P($G(^PXRMD(801.41,IEN,1)),U,5)'["YTT(601," Q
  1.  . S TEMP=^PXRMD(801.41,IEN,0)
  1.  . S DNAME=$P(TEMP,U,1)
  1.  . S DTYPE=$P(TEMP,U,4)
  1.  . S STATUS=$S($P(TEMP,U,3)=1:"DISABLE",1:"ACTIVE")
  1.  . S ^TMP($J,"MH",DNAME)=STATUS_U_DTYPE
  1.  . I REPOINT D
  1.  .. S TEXT="Changing MH pointers in reminder dialog "_DNAME_" IEN="_IEN
  1.  .. D BMES^XPDUTL(.TEXT)
  1.  . S OLDPTR=$P($P(^PXRMD(801.41,IEN,1),U,5),";")
  1.  . K YS,YSDATA
  1.  . S YS("YS601")=OLDPTR
  1.  . D CONVERT^YTQPXRM6(.YSDATA,.YS)
  1.  . S NEWPTR=$P(YSDATA(2),U,1)
  1.  . I (YSDATA(1)="[ERROR]")!(NEWPTR="dropped") D
  1.  .. S NEWPTR=109
  1.  .. S MHNAME=$$GET1^DIQ(601,OLDPTR,.01,"","","")
  1.  .. S NNCONV=NNCONV+1
  1.  .. S ^TMP($J,"MH",DNAME,"FINDING",1)=MHNAME
  1.  . I REPOINT D
  1.  .. S IENS=IEN_","
  1.  .. D UPDATE(801.41,IENS,15,NEWPTR)
  1.  ;Format the message.
  1.  I NNCONV>0 D
  1.  . S DNAME=""
  1.  . F  S DNAME=$O(^TMP($J,"MH",DNAME)) Q:DNAME=""  D
  1.  .. I '$D(^TMP($J,"MH",DNAME,"FINDING")) Q
  1.  .. S STATUS=$P(^TMP($J,"MH",DNAME),U,1)
  1.  .. S DTYPE=$P(^TMP($J,"MH",DNAME),U,2)
  1.  .. S DTYPE=$$EXTERNAL^DILFD(801.41,4,"",DTYPE,.EM)
  1.  .. S TEXT="Dialog entry "_DNAME_", type "_DTYPE_", status "_STATUS_", has the following MH findings which cannot be converted:"
  1.  .. S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=TEXT
  1.  .. S FI=""
  1.  .. F  S FI=$O(^TMP($J,"MH",DNAME,"FINDING",FI)) Q:FI=""  D
  1.  ... S TEXT="  Finding number "_FI_", MH instrument "_^TMP($J,"MH",DNAME,"FINDING",FI)
  1.  ... S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=TEXT
  1.  .. S TEXT="This dialog will not function properly until it is repaired."
  1.  .. S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=TEXT
  1.  .. S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=" "
  1.  . S TEXT="For instructions on what to do with these entries see the PXRM*2*6"
  1.  . S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=TEXT
  1.  . S TEXT="Installation Guide."
  1.  . S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=TEXT
  1.  . S NLINES=NLINES+1,^TMP("PXRMXMZ",$J,NLINES,0)=" "
  1.  I NLINES=0 Q
  1.  K ^TMP($J,"MH")
  1.  D SEND^PXRMMSG("MH findings that cannot be converted")
  1.  K ^TMP("PXRMXMZ",$J)
  1.  Q
  1.  ;
  1.  ;========================
  1. UPDATE(FILENUM,IENS,FIELD,IEN)   ;Update an MH finding.
  1.  N FDA,MSG
  1.  S FDA(FILENUM,IENS,FIELD)="MH.`"_IEN
  1.  D UPDATE^DIE("E","FDA","","MSG")
  1.  I $D(MSG) D
  1.  . N TEXT
  1.  . D ACOPY^PXRMUTIL("MSG","TEXT()")
  1.  . D BMES^XPDUTL("The MH update failed, UPDATE^DIE returned the following error message:")
  1.  . D MES^XPDUTL(.TEXT)
  1.  . D MES^XPDUTL("Examine the above error message for the reason.")
  1.  Q
  1.  ;