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