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

RMPR213P.m

Go to the documentation of this file. 
  1. RMPR213P ;HDSO/JSG - RMPR*3.0*213 Post-install routine; Mar 2, 2023@16:00
  1.  ;;3.0;PROSTHETICS;**213**; 30 Oct 98;Build 12
  1.  ;
  1.  ;;Reference to $$ICDDX^ICDEX supported by ICR #5747
  1.  ;;Reference to ^GMR(123,30.1) supported by ICR# 3067
  1.  ;
  1.  Q
  1.  ;
  1. EN ;
  1.  ;This post-install routine for RMPR*3.0*213 will:
  1.  ;
  1.  ;1. Scan for any records with "-1" in the ICD field (#1.6) of
  1.  ;   the PROSTHETIC SUSPENSE file (#668).
  1.  ;
  1.  ;2. When a record with "-1" is found, the PROVISIONAL DIAGNOSIS
  1.  ;   field (#1.5) is retrieved and the ICD10 code is extracted.
  1.  ;
  1.  ;3. Then retrieves the CONSULT pointer (#20)
  1.  ;
  1.  ;4. Using the CONSULT pointer, the PROVISIONAL DIAGNOSIS CODE (#30.2)
  1.  ;   is retrieved from the REQUEST CONSULTATION FILE (#123)
  1.  ;   
  1.  ;5. The extracted code is used to call $$ICDDX^ICDEX to return
  1.  ;   the correct ICD10 pointer (IEN) for the code.
  1.  ;
  1.  ;6. The IEN is then inserted into the ICD field (#1.6).
  1.  ; 
  1.  ;7. The unmodified record is stored in ^XTMP for potential
  1.  ;   recovery by executing BACKOUT^RMPR213P in programmer mode.
  1.  ;
  1.  ;8. This routine is not deleted after install since it is tasked.
  1.  ;   A future patch will delete the routine.
  1.  ;
  1.  D BMES^XPDUTL($$LJ^XLFSTR("RMPR*3.0*213 Post-Install Routine will scan the PROSTHETIC SUSPENSE",80))
  1.  D BMES^XPDUTL($$LJ^XLFSTR("file for corrupt ICD fields and correct them.",80))
  1.  D BMES^XPDUTL($$LJ^XLFSTR("You will receive a MailMan message when it completes.",80))
  1.  N RMPRDUZ,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSAVE
  1.  S ZTRTN="START^RMPR213P"
  1.  S ZTDESC="RMPR*3.0*213 Post-Install Routine"
  1.  S ZTIO="",ZTDTH=$H
  1.  S RMPRDUZ=DUZ
  1.  S ZTSAVE("RMPRDUZ")=""
  1.  D ^%ZTLOAD
  1.  D BMES^XPDUTL($$LJ^XLFSTR("RMPR*3.0*213 Post-Install Routine has been tasked.",80))
  1.  D BMES^XPDUTL($$LJ^XLFSTR("Task Number: "_$G(ZTSK),80))
  1.  D BMES^XPDUTL($$LJ^XLFSTR("You will receive a MailMan message when it completes.",80))
  1.  Q
  1.  ;
  1. START ;
  1.  ;
  1.  S ^XTMP("RMPR*3.0*213 POST INSTALL",0)=$$FMADD^XLFDT(DT,90)_"^"_DT_"^RMPR*3.0*213 POST INSTALL"
  1.  ;
  1.  N RMMAILSQ,RMPRNF,RMPRNC
  1.  S RMMAILSQ=0,(RMPRNF,RMPRNC)=0
  1.  D ICD,RMPR,MAIL
  1.  S:$D(ZTQUEUED) ZTREQ="@"
  1.  Q
  1.  ;
  1. ICD ;
  1.  S ^XTMP("RMPR*3.0*213 POST INSTALL",1)=" "
  1.  S ^XTMP("RMPR*3.0*213 POST INSTALL",2)="The incorrect ICD entries in the PROSTHETIC SUSPENSE file (#668)"
  1.  S ^XTMP("RMPR*3.0*213 POST INSTALL",3)="have been corrected to contain an ICD10 IEN rather than ""-1""."
  1.  S ^XTMP("RMPR*3.0*213 POST INSTALL",4)=" "
  1.  Q
  1.  ;
  1. RMPR ;Correct records in the PROSTHETIC SUSPENSE file (#668).
  1.  N RMNX,RMICD,RMICDP,RMSTR,RM8ORIG,RM0ORIG,RMCON,RMPRDRXW
  1.  S RMNX=0
  1.  F  S RMNX=$O(^RMPR(668,RMNX)) Q:RMNX<1  D               ;QUIT IF:
  1.  . Q:'$D(^RMPR(668,RMNX,8))  S RM8ORIG=^(8)              ;no 8 node
  1.  . Q:$P(RM8ORIG,"^",3)'="-1"                             ;3rd piece not -1
  1.  . S RMPRNF=RMPRNF+1
  1.  . Q:'$D(^RMPR(668,RMNX,0))  S RM0ORIG=^(0)              ;no 0 node
  1.  . S RMCON=$P(RM0ORIG,"^",15) Q:RMCON=""                 ;no CONSULT
  1.  . S RMPRDRXW=$P(RM0ORIG,U,16) S:RMPRDRXW'>0 RMPRDRXW=DT ;date Rx written
  1.  . Q:'$$FIND1^DIC(123,,"A",RMCON)                        ;no CONSULT record
  1.  . S RMICD=$$GET1^DIQ(123,RMCON,30.1),RMICD=$P(RMICD,U)
  1.  . Q:RMICD=""                                            ;no consult DIAGNOSIS record
  1.  . S RMICDP=$P($$ICDDX^ICDEX(RMICD,RMPRDRXW),"^")        ;get the IEN for the correct code
  1.  . Q:RMICDP<0                                            ;invalid code
  1.  . S ^XTMP("RMPR*3.0*213 POST INSTALL",0,668,RMNX,8)=RM8ORIG ;preserve the old node value
  1.  . S $P(RM8ORIG,"^",3)=RMICDP,RMPRNC=RMPRNC+1
  1.  . S ^RMPR(668,RMNX,8)=RM8ORIG
  1.  S ^XTMP("RMPR*3.0*213 POST INSTALL",RMMAILSQ+5)="RMPR*3.0*213 Post Install Routine Summary Report"
  1.  S ^XTMP("RMPR*3.0*213 POST INSTALL",RMMAILSQ+6)="Number of records found needing correction: "_RMPRNF
  1.  S ^XTMP("RMPR*3.0*213 POST INSTALL",RMMAILSQ+7)="               Number of records corrected: "_RMPRNC
  1.  S ^XTMP("RMPR*3.0*213 POST INSTALL",RMMAILSQ+8)=" "
  1.  S ^XTMP("RMPR*3.0*213 POST INSTALL",RMMAILSQ+9)="******************************************************************"
  1.  S ^XTMP("RMPR*3.0*213 POST INSTALL",RMMAILSQ+10)="*  The original records with the appropriate subscripts are      *"
  1.  S ^XTMP("RMPR*3.0*213 POST INSTALL",RMMAILSQ+11)="*  saved for 90 days at ^XTMP(""RMPR*3.0*213 POST INSTALL"",0).    *"
  1.  S ^XTMP("RMPR*3.0*213 POST INSTALL",RMMAILSQ+12)="******************************************************************"
  1.  S ^XTMP("RMPR*3.0*213 POST INSTALL",RMMAILSQ+13)=" "
  1.  I RMPRNC=0 S ^XTMP("RMPR*3.0*213 POST INSTALL",RMMAILSQ+14)="No entries were found which needed correction."
  1.  Q
  1.  ;
  1. MAIL ;send MailMan message to installer and users with the RMPRMANAGER key.
  1.  N RMPRREC,RMPRTEXT,RMPRMY,RMPRSUB,RMPRMIN,RMPRDUZ
  1.  I '$D(RMPRDUZ) S RMPRDUZ=DUZ
  1.  S RMPRTEXT="^XTMP(""RMPR*3.0*213 POST INSTALL"")"
  1.  S RMPRREC=""
  1.  F  S RMPRREC=$O(^XUSEC("RMPRMANAGER",RMPRREC)) Q:RMPRREC=""  S RMPRMY(RMPRREC)=""
  1.  S RMPRMY(RMPRDUZ)=""
  1.  S RMPRSUB="RMPR*3.0*213 Post-Install Summary Information"
  1.  S RMPRMIN("FROM")="RMPR*3.0*213 Post-Install"
  1.  D SENDMSG^XMXAPI(RMPRDUZ,RMPRSUB,RMPRTEXT,.RMPRMY,.RMPRMIN,"","")
  1.  Q
  1.  ;
  1.  ;
  1. BACKOUT ;This section is invoked from the programmer's prompt if patch back out is required.
  1.  N DIR,Y
  1.  S DIR("A",1)="This action will back out the file modifications that were performed"
  1.  S DIR("A",2)="after the install of RMPR*3.0*213."
  1.  S DIR("A")="Are you sure you wish to proceed",DIR("B")="NO",DIR(0)="Y"
  1.  D ^DIR
  1.  Q:Y<1
  1.  ;
  1.  S ^XTMP("RMPR*3.0*213 BACK OUT",0)=$$FMADD^XLFDT(DT,90)_"^"_DT_"^RMPR*3.0*213 BACK OUT"
  1.  S ^XTMP("RMPR*3.0*213 BACK OUT",1)=" "
  1.  S ^XTMP("RMPR*3.0*213 BACK OUT",2)="Patch RMPR*3.0*213 was backed out by "_$$GET1^DIQ(200,DUZ,.01)_"."
  1.  S ^XTMP("RMPR*3.0*213 BACK OUT",3)=" "
  1.  ;
  1.  N RMMAILSQ,RMPRZ,RMPRDUZ
  1.  S RMMAILSQ=3,RMPRDUZ=DUZ
  1.  W !!,"Please wait until the back out completes."
  1.  W !,"Working."
  1.  D ICDBACK,MAILBACK
  1.  Q
  1.  ;
  1. ICDBACK ;
  1.  N RMPRX,RMPRSTR,RMPRZ,RMPRDUZ
  1.  S RMPRZ=0,RMPRSTR="",(RMPRNF,RMPRNC)=0
  1.  F  S RMPRZ=$O(^XTMP("RMPR*3.0*213 POST INSTALL",0,668,RMPRZ)) Q:RMPRZ=""  S RMPRX=0 D
  1.  . F  S RMPRX=$O(^XTMP("RMPR*3.0*213 POST INSTALL",0,668,RMPRZ,RMPRX)) Q:RMPRX=""  D
  1.  .. S ^XTMP("RMPR*3.0*213 BACK OUT",0,668,RMPRZ,RMPRX)=^RMPR(668,RMPRZ,RMPRX)
  1.  .. S ^RMPR(668,RMPRZ,RMPRX)=^XTMP("RMPR*3.0*213 POST INSTALL",0,668,RMPRZ,RMPRX)
  1.  .. S RMPRNF=RMPRNF+1,RMPRNC=RMPRNC+1
  1.  ;
  1.  S ^XTMP("RMPR*3.0*213 BACK OUT",RMMAILSQ+1)="RMPR*3.0*213 Rollback Summary Report"
  1.  S ^XTMP("RMPR*3.0*213 BACK OUT",RMMAILSQ+2)="Number of records found to rollback: "_RMPRNF
  1.  S ^XTMP("RMPR*3.0*213 BACK OUT",RMMAILSQ+3)="       Number of records backed out: "_RMPRNC
  1.  S ^XTMP("RMPR*3.0*213 BACK OUT",RMMAILSQ+4)=" "
  1.  S ^XTMP("RMPR*3.0*213 BACK OUT",RMMAILSQ+5)="***************************************************************"
  1.  S ^XTMP("RMPR*3.0*213 BACK OUT",RMMAILSQ+6)="*  The corrected records with the appropriate subscripts are  *"
  1.  S ^XTMP("RMPR*3.0*213 BACK OUT",RMMAILSQ+7)="*  saved for 90 days at ^XTMP(""RMPR*3.0*213 BACK OUT"",0).     *"
  1.  S ^XTMP("RMPR*3.0*213 BACK OUT",RMMAILSQ+8)="***************************************************************"
  1.  S ^XTMP("RMPR*3.0*213 BACK OUT",RMMAILSQ+9)=" "
  1.  Q
  1.  ;
  1. MAILBACK ;
  1.  N RMPRREC,RMPRTEXT,RMPRMY,RMPRSUB,RMPRMIN,RMPRMZ,DIR
  1.  S ^XTMP("RMPR*3.0*213 BACK OUT",RMMAILSQ+10)="The text of this message will be stored in the global"
  1.  S ^XTMP("RMPR*3.0*213 BACK OUT",RMMAILSQ+11)="^XTMP(""RMPR*3.0*213 BACK OUT"" for 90 days."
  1.  S RMPRTEXT="^XTMP(""RMPR*3.0*213 BACK OUT"")"
  1.  S RMPRREC=""
  1.  F  S RMPRREC=$O(^XUSEC("RMPRMANAGER",RMPRREC)) Q:RMPRREC=""  S RMPRMY(RMPRREC)=""
  1.  S RMPRMY(RMPRDUZ)=""
  1.  S RMPRSUB="RMPR*3.0*213 Back Out Information"
  1.  S RMPRMIN("FROM")="RMPR*3.0*213 BACK OUT"
  1.  D SENDMSG^XMXAPI(RMPRDUZ,RMPRSUB,RMPRTEXT,.RMPRMY,.RMPRMIN,.RMPRMZ,"")
  1.  S DIR("A",1)="MailMan message #"_RMPRMZ_" has been sent to you as well as"
  1.  S DIR("A",2)="holders of the RMPRMANAGER security key."
  1.  S DIR("A")="Press any key to continue"
  1.  S DIR(0)="E" D ^DIR
  1.  Q
  1.  ;