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

RMPR214P.m

Go to the documentation of this file. 
  1. RMPR214P ;HDSO/RJH - RMPR*3.0*214 Post-install routine; Aug 9, 2023@16:00
  1.  ;;3.0;PROSTHETICS;**214**; 30 Oct 98;Build 3
  1.  ;
  1.  ;;Reference to $$ICDDX^ICDEX supported by ICR #5747
  1.  ;;Reference to ^GMR(123,30.1) supported by ICR# 3067
  1.  ;
  1.  Q  ; Must be run from a specific tag
  1.  ;
  1.  ; ----------------------------------------------------------------------------
  1.  ; This post-install routine, loosely based on RMPR213P, does the following:
  1.  ; 
  1.  ; 1. Scan the RECORD OF PROS APPLIANCE/REPAIR file (#660) to look for any
  1.  ;    records with "-1" in the SUSPENSE ICD field (#8.8)
  1.  ; 2. When found, the corresponding PROVISIONAL DIAGNOSIS field (#8.7), ICD10
  1.  ;    code and CONSULT (#8.9) pointer are retrieved
  1.  ; 3. Using the CONSULT pointer, the PROVISIONAL DIAGNOSIS CODE (#30.1) is
  1.  ;    from the REQUEST/CONSULTATION file (#123).
  1.  ; 4. That diagnosis code is then used to call $$ICDDX^ICDEX to return the 
  1.  ;    correct ICD10 pointer (IEN) for the code.
  1.  ; 5. The original record is stored in ^XTMP for potential recovery by
  1.  ;    executing the BACKOUT^RMPR214P logic in programmer mode.
  1.  ; 6. The corrected ICD10 code is then inserted back into the SUSPENSE ICD
  1.  ;    field in file 660.
  1.  ;
  1.  ; Note: The routine is not deleted after install since it is tasked and the
  1.  ;       BACKOUT functionality needs to remain available. A future patch can
  1.  ;       be used to delete the routine, if needed.
  1.  ;
  1.  ; ============================================================================
  1.  ; 
  1. EN ; Main entry point
  1.  D BMES^XPDUTL("")
  1.  D BMES^XPDUTL($$LJ^XLFSTR("The RMPR*3.0*214 Post-Install Routine will scan the RECORD OF PROS ",80))
  1.  D MES^XPDUTL($$LJ^XLFSTR("APPLIANCE/REPAIR file (#660) for erroneous ICD fields and if found,",80))
  1.  D MES^XPDUTL($$LJ^XLFSTR("attempt to correct them. ",80))
  1.  ;
  1.  N RMPRDUZ,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSAVE,ZTQUEUED,ZTREQ,ZTSK
  1.  S ZTRTN="START^RMPR214P"
  1.  S ZTDESC="RMPR*3.0*214 Post-Install Routine"
  1.  S ZTIO="",ZTDTH=$H
  1.  S RMPRDUZ=DUZ
  1.  S ZTSAVE("RMPRDUZ")=""
  1.  D ^%ZTLOAD
  1.  ;
  1.  D BMES^XPDUTL($$LJ^XLFSTR("The RMPR*3.0*214 Post-Install Routine has been tasked.",80))
  1.  D MES^XPDUTL($$LJ^XLFSTR("Task Number: "_$G(ZTSK),80))
  1.  D MES^XPDUTL($$LJ^XLFSTR("You will receive a MailMan message when it completes.",80))
  1.  D BMES^XPDUTL("")
  1.  Q
  1.  ;
  1. START ; Start the correction process
  1.  N RMPRSUB,RMPRFROM,RMPRTEXT
  1.  ;
  1.  S ^XTMP("RMPR*3.0*214 POST INSTALL",0)=$$FMADD^XLFDT(DT,90)_"^"_DT_"^RMPR*3.0*214 POST INSTALL"
  1.  D RMPR,MAIL
  1.  S:$D(ZTQUEUED) ZTREQ="@"
  1.  Q
  1.  ;
  1. RMPR ; Fix records in the RECORD OF PROS APPLIANCE/REPAIR file (#660)
  1.  N RMPR,RMPR10,RMSUSICD,RMFND,RMFIXED,RMRXDT,RMCNSLT,RMICD,RMICDIEN,RMNODE
  1.  S RMNODE="RMPR*3.0*214 POST INSTALL"
  1.  S (RMPR,RMFND,RMFIXED)=0
  1.  ;
  1.  F  S RMPR=$O(^RMPR(660,RMPR)) Q:'RMPR  D
  1.  . Q:'$D(^RMPR(660,RMPR,10))
  1.  . S RMPR10=$G(^RMPR(660,RMPR,10))
  1.  . S RMSUSICD=$P(RMPR10,"^",8)
  1.  . Q:RMSUSICD'="-1"
  1.  . ; If we're here, a bad record has been found
  1.  . S RMFND=RMFND+1
  1.  . S RMCNSLT=$P(RMPR10,"^",9) Q:RMCNSLT=""
  1.  . S RMRXDT=$P(RMPR10,"^",2) S:RMRXDT'>0 RMRXDT=DT
  1.  . Q:'$$FIND1^DIC(123,,"A",RMCNSLT)
  1.  . S RMICD=$$GET1^DIQ(123,RMCNSLT,30.1),RMICD=$P(RMICD,U,1)
  1.  . Q:RMICD=""
  1.  . S RMICDIEN=$P($$ICDDX^ICDEX(RMICD,RMRXDT),"^")
  1.  . Q:RMICDIEN<0
  1.  . ; Now save the original and then fix the bad record
  1.  . S ^XTMP(RMNODE,0,660,RMPR,10)=RMPR10
  1.  . S $P(^RMPR(660,RMPR,10),"^",8)=RMICDIEN
  1.  . S RMFIXED=RMFIXED+1
  1.  . Q
  1.  ;
  1.  S ^XTMP(RMNODE,1)=" "
  1.  S ^XTMP(RMNODE,2)="********** RMPR*3.0*214 Post-Install Routine Summary Report **********"
  1.  S ^XTMP(RMNODE,3)=" "
  1.  S ^XTMP(RMNODE,4)=" Records in the RECORD OF PROS APPLIANCE/REPAIR file (#660) file"
  1.  S ^XTMP(RMNODE,5)=" have been searched for an -1 error code in the SUSPENSE ICD field."
  1.  S ^XTMP(RMNODE,6)=" "
  1.  S ^XTMP(RMNODE,7)=" Number of erroneous records found: "_RMFND
  1.  S ^XTMP(RMNODE,8)="       Number of records corrected: "_RMFIXED
  1.  S ^XTMP(RMNODE,9)=" "
  1.  S ^XTMP(RMNODE,10)=" The original version of corrected records, if any, are stored for"
  1.  S ^XTMP(RMNODE,11)=" 90 days at ^XTMP(""RMPR*3.0*214 POST INSTALL"",0,660,recordID)."
  1.  S ^XTMP(RMNODE,12)=" "
  1.  S ^XTMP(RMNODE,13)="*************************** End of Report ****************************"
  1.  ;
  1.  Q
  1.  ;
  1. MAIL ; Send MailMan message to installer and users with the RMPRMANAGER key
  1.  S RMPRSUB="RMPR*3.0*214 Post-Install Summary Information"
  1.  S RMPRFROM="RMPR*3.0*214 Post-Install"
  1.  S RMPRTEXT="^XTMP(""RMPR*3.0*214 POST INSTALL"")"
  1.  D MAILMSG(RMPRSUB,RMPRFROM,RMPRTEXT)
  1.  Q
  1.  ;
  1.  ; ============================================================================
  1. BACKOUT ; Run this from the programmer's prompt if patch backout is required
  1.  W #
  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*214."
  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.  N RMBKNODE,RMPRDUZ,RMPRNF,RMPRNC,RMPRZ,RMPRREC,RMPRTEXT,RMPRMY,RMPRSUB,RMPRMIN
  1.  N RMPRMZ,RMPRFROM
  1.  ;
  1.  S RMBKNODE="RMPR*3.0*214 BACKOUT"
  1.  S RMPRDUZ=DUZ
  1.  S ^XTMP(RMBKNODE,0)=$$FMADD^XLFDT(DT,90)_"^"_DT_"^RMPR*3.0*214 BACKOUT"
  1.  ;
  1.  W !!,"Please wait until the backout completes."
  1.  W !,"Working..."
  1.  D ICDBACK,MAILBACK
  1.  ;
  1.  K DIR
  1.  N DIR
  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.  ;
  1. ICDBACK ; Restore the previous (erroneous) records back to #660, node 10
  1.  S (RMPRZ,RMPRNF,RMPRNC)=0
  1.  ;
  1.  F  S RMPRZ=$O(^XTMP("RMPR*3.0*214 POST INSTALL",0,660,RMPRZ)) Q:RMPRZ=""  D
  1.  . S ^XTMP(RMBKNODE,0,660,RMPRZ,10)=^RMPR(660,RMPRZ,10)
  1.  . S ^RMPR(660,RMPRZ,10)=^XTMP("RMPR*3.0*214 POST INSTALL",0,660,RMPRZ,10)
  1.  . S RMPRNF=RMPRNF+1,RMPRNC=RMPRNC+1
  1.  . Q
  1.  ;
  1.  S ^XTMP(RMBKNODE,1)=" "
  1.  S ^XTMP(RMBKNODE,2)="**************** RMPR*3.0*214 Rollback Summary Report ****************"
  1.  S ^XTMP(RMBKNODE,3)=" "
  1.  S ^XTMP(RMBKNODE,4)=" Backout was run by "_$$GET1^DIQ(200,DUZ,.01)_" on "_$$FMTE^XLFDT(DT)
  1.  S ^XTMP(RMBKNODE,5)=" "
  1.  S ^XTMP(RMBKNODE,6)=" Number of records found to rollback: "_RMPRNF
  1.  S ^XTMP(RMBKNODE,7)="        Number of records backed out: "_RMPRNC
  1.  S ^XTMP(RMBKNODE,8)=" "
  1.  S ^XTMP(RMBKNODE,9)=" The previously corrected records will be saved for 90 days at"
  1.  S ^XTMP(RMBKNODE,10)="  ^XTMP(""RMPR*3.0*214 BACKOUT"",0,660,recordID)."
  1.  S ^XTMP(RMBKNODE,11)=" "
  1.  S ^XTMP(RMBKNODE,12)=" The text of this message will also be stored for 90 days at"
  1.  S ^XTMP(RMBKNODE,13)="  ^XTMP(""RMPR*3.0*214 BACKOUT""."
  1.  S ^XTMP(RMBKNODE,14)=" "
  1.  S ^XTMP(RMBKNODE,15)="*************************** End of Report ****************************"
  1.  Q
  1.  ;
  1. MAILBACK ; Send MailMan message with backout info to appropriate group
  1.  S RMPRSUB="RMPR*3.0*214 Backout Information"
  1.  S RMPRFROM="RMPR*3.0*214 BACKOUT"
  1.  S RMPRTEXT="^XTMP(""RMPR*3.0*214 BACKOUT"")"
  1.  D MAILMSG(RMPRSUB,RMPRFROM,RMPRTEXT)
  1.  Q
  1.  ;
  1.  ; ----------------------------------------------------------------------------
  1. MAILMSG(MSGSUBJ,MSGFROM,MSGTEXT) ; Build and send a MailMan message
  1.  N RMPRREC,RMPRMY,RMPRMIN
  1.  I '$D(RMPRDUZ) S RMPRDUZ=DUZ
  1.  S RMPRMIN("FROM")=MSGFROM
  1.  S RMPRREC=""
  1.  F  S RMPRREC=$O(^XUSEC("RMPRMANAGER",RMPRREC)) Q:RMPRREC=""  S RMPRMY(RMPRREC)=""
  1.  S RMPRMY(RMPRDUZ)=""
  1.  D SENDMSG^XMXAPI(RMPRDUZ,MSGSUBJ,MSGTEXT,.RMPRMY,.RMPRMIN,.RMPRMZ,"")
  1.  Q