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

PSO744PI.m

Go to the documentation of this file. 
  1. PSO744PI ;HDSO/LAL-Post-install routine for Patch PSO*7.0*744 ; 12 Mar 2024  2:00 PM
  1.  ;;7.0;OUTPATIENT PHARMACY;**744**;DEC 1997;Build 3
  1.  ;
  1.  Q  ;Must be run from the POST tag
  1.  ;
  1.  ;
  1.  ;  This post-install routine does the following:
  1.  ;
  1.  ;  1. Scans the records in File #52 [PRESCRIPTION] and looks for any Activity Log nodes
  1.  ;     i.e. ^PSRX(RXIEN,"A",N,0), that do not have a Activity Log Header node i.e. ^PSRX(RXIEN,"A",0).
  1.  ;
  1.  ;  2. If any records are are found, the Activity Log Header node will be created and it will 
  1.  ;     match the number of entries in the Activity Log.
  1.  ;
  1.  ;  3. It will also send an email to users with the PSNMGR key with details of the corrected RXs.
  1.  ;
  1.  ;  4. If no records are found that match the criteria, a message will display stating this.
  1.  ;
  1.  ;
  1. POST ; Main entry point
  1.  D BMES^XPDUTL(" ")
  1.  D BMES^XPDUTL("  Starting post-install for PSO*7.0*744")
  1.  D MES^XPDUTL("  This report documents any RXs missing the Activity Log Header")
  1.  D MES^XPDUTL("  node in File #52 [PRESCRIPTION].")
  1.  D MES^XPDUTL("  Any instance of an RX without the Activity Log Header node")
  1.  D MES^XPDUTL("  will automatically be corrected.")
  1.  ;
  1.  N PSODUZ,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSAVE,ZTQUEUED,ZTREQ,ZTSK
  1.  S ZTRTN="START^PSO744PI"
  1.  S ZTDESC="PSO*7.0*744 Post-Install Routine"
  1.  S ZTIO="",ZTDTH=$H
  1.  S PSODUZ=DUZ
  1.  S ZTSAVE("PSODUZ")=""
  1.  D ^%ZTLOAD
  1.  ;
  1.  D BMES^XPDUTL(" ")
  1.  D BMES^XPDUTL("  The PSO*7.0*744 Post-Install Routine has been tasked.")
  1.  D MES^XPDUTL("  Task Number: "_$G(ZTSK))
  1.  D MES^XPDUTL("  You will receive a MailMan message when it completes.")
  1.  D BMES^XPDUTL("  ")
  1.  Q
  1.  ;
  1. START ; Start the correction process
  1.  N PSOSUB,PSOFROM,PSOTEXT
  1.  ;
  1.  S ^XTMP("PSO*7.0*744 POST INSTALL",0)=$$FMADD^XLFDT(DT,90)_"^"_DT_"^PSO*7.0*744 POST INSTALL"
  1.  D ACTLOG,MAIL
  1.  S:$D(ZTQUEUED) ZTREQ="@"
  1.  Q
  1.  ;
  1. ACTLOG ; Fix records in the File #52 [PRESCRIPTION]
  1.  ; INC28706897 - ATP+4^PSO52API error for RXs missing the Activity Log Header node.
  1.  ; Search File #52 [PRESCRIPTION] to find RXs missing the Activity Log Header node and correct.
  1.  N FOUND,PSOLINE,RXIEN,COUNT,FOUND,X1
  1.  S PSOLINE=0 K ^TMP("PSO744PI",$J),^XTMP("PSO744PI",$J)
  1.  ;
  1.  D SETTXT("================ PSO*7.0*744 Summary Report ================")
  1.  D SETTXT("Below is the list of RXs that were missing the Activity Log")
  1.  D SETTXT("Header node that have been corrected.")
  1.  D SETTXT("============================================================")
  1.  D SETTXT("")
  1.  D SETTXT("RX#             File #52 IEN    Log#   Expiration DT/Cancel DT")
  1.  D SETTXT("------------    ------------    ----   -------------------------")
  1.  ;
  1.  S (RXIEN,FOUND)=0
  1.  F  S RXIEN=$O(^PSRX(RXIEN)) Q:'RXIEN  D
  1.  . I $D(^PSRX(RXIEN,"A",1)),'$D(^PSRX(RXIEN,"A",0)) D
  1.  . . S FOUND=FOUND+1
  1.  . . S COUNT=$O(^PSRX(RXIEN,"A","Z"),-1)
  1.  . . S ^PSRX(RXIEN,"A",0)="^52.3DA^"_COUNT_"^"_COUNT
  1.  . . S X1=$$GET1^DIQ(52,RXIEN,.01),$E(X1,17)=RXIEN,$E(X1,33)=COUNT,$E(X1,40)=$$GET1^DIQ(52,RXIEN,26)_"/"_$$GET1^DIQ(52,RXIEN,26.1)
  1.  . . D SETTXT(X1)
  1.  ;
  1.  D SETTXT("")
  1.  I FOUND D SETTXT("Total RXs Corrected = "_FOUND)
  1.  I 'FOUND D SETTXT("No Prescriptions were found with a missing Activity Log Header node.")
  1.  ;
  1.  D BMES^XPDUTL("  Mailman message sent.")
  1.  D BMES^XPDUTL("  Finished post-install for PSO*7.0*744.")
  1.  Q
  1.  ;
  1. SETTXT(TXT) ; Setting Plain Text
  1.  S PSOLINE=$G(PSOLINE)+1,^XTMP("PSO744PI",$J,PSOLINE)=TXT
  1.  Q
  1.  ; 
  1. MAIL ; Sends Mailman message
  1.  S PSOSUB="PSO*7.0*744 Post-Install Summary Information"
  1.  S PSOFROM="PSO*7.0*744 Post-Install"
  1.  S PSOTEXT="^XTMP(""PSO744PI"",$J)"
  1.  D MAILMSG(PSOSUB,PSOFROM,PSOTEXT)
  1.  Q
  1. END ; Exit point
  1.  K ^TMP("PSO744PI",$J),^XTMP("PSO744PI",$J)
  1.  Q
  1.  ;
  1. MAILMSG(MSGSUBJ,MSGFROM,MSGTEXT) ; Build and send a MailMan message
  1.  N PSOREC,PSOMY,PSOMIN,PSOMZ
  1.  I '$D(PSODUZ) S PSODUZ=DUZ
  1.  S PSOMIN("FROM")=MSGFROM
  1.  S PSOREC=""
  1.  F  S PSOREC=$O(^XUSEC("PSNMGR",PSOREC)) Q:PSOREC=""  S PSOMY(PSOREC)=""
  1.  S PSOMY(PSODUZ)=""
  1.  D SENDMSG^XMXAPI(PSODUZ,MSGSUBJ,MSGTEXT,.PSOMY,.PSOMIN,.PSOMZ,"")
  1.  Q