PSO616PI ;PER/ME-Post-install routine for Patch PSO*7.0*616 ; 04 Jul 2020 2:00 PM
;;7.0;OUTPATIENT PHARMACY;**616**;DEC 1997;Build 3
;
Q
POST ; Entry point
D BMES^XPDUTL(" Starting post-install for PSO*7*616")
N FOUND,PSOLINE,X1,X2,FOUND
S PSOLINE=0 K ^TMP("PSO616PI",$J),^XTMP("PSO616PI",$J)
D SETTXT("This report documents missing file #52 [PRESCRIPTION] Label multiple header")
D SETTXT("records. Any instance of a Label multiple that has been created without the")
D SETTXT("appropriate Label multiple header record will automatically be corrected to")
D SETTXT("have the appropriate Label multiple header record.")
D SETTXT("===============================================================================")
D SETTXT("")
D SETTXT("Prescription# File #52 IEN")
D SETTXT("------------- ------------")
;
S (X1,FOUND)=0
F S X1=$O(^PSRX(X1)) Q:'X1 D
.I $D(^PSRX(X1,"L",1)),'$D(^PSRX(X1,"L",0)) D
..S FOUND=FOUND+1
..S X2=$O(^PSRX(X1,"L","Z"),-1)
..S ^PSRX(X1,"L",0)="^52.032DA^"_X2_"^"_X2
..D SETTXT($P(^PSRX(X1,0),U,1)_$J(X1,26+$L(X1)-$L($P(^PSRX(X1,0),U,1))))
;
D SETTXT("")
I 'FOUND D SETTXT("No Prescriptions were found with a missing Label multiple header.")
;
D MAIL
;
D BMES^XPDUTL(" Mailman message sent.")
D BMES^XPDUTL(" Finished post-install for PSO*7*616.")
;
END ; Exit point
K ^TMP("PSO616PI",$J),^XTMP("PSO616PI",$J)
Q
;
SETTXT(TXT) ; Setting Plain Text
S PSOLINE=$G(PSOLINE)+1,^XTMP("PSO616PI",$J,PSOLINE)=TXT
Q
;
MAIL ; Sends Mailman message
N II,XMX,XMSUB,XMDUZ,XMTEXT,XMY
S II=0 F S II=$O(^XUSEC("PSNMGR",II)) Q:'II S XMY(II)=""
S XMY(DUZ)="",XMSUB="PSO*7*616 - Autocorrection Utility"
S XMDUZ=.5,XMTEXT="^XTMP(""PSO616PI"",$J," N DIFROM D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSO616PI 1786 printed Dec 13, 2024@02:23:22 Page 2
PSO616PI ;PER/ME-Post-install routine for Patch PSO*7.0*616 ; 04 Jul 2020 2:00 PM
+1 ;;7.0;OUTPATIENT PHARMACY;**616**;DEC 1997;Build 3
+2 ;
+3 QUIT
POST ; Entry point
+1 DO BMES^XPDUTL(" Starting post-install for PSO*7*616")
+2 NEW FOUND,PSOLINE,X1,X2,FOUND
+3 SET PSOLINE=0
KILL ^TMP("PSO616PI",$JOB),^XTMP("PSO616PI",$JOB)
+4 DO SETTXT("This report documents missing file #52 [PRESCRIPTION] Label multiple header")
+5 DO SETTXT("records. Any instance of a Label multiple that has been created without the")
+6 DO SETTXT("appropriate Label multiple header record will automatically be corrected to")
+7 DO SETTXT("have the appropriate Label multiple header record.")
+8 DO SETTXT("===============================================================================")
+9 DO SETTXT("")
+10 DO SETTXT("Prescription# File #52 IEN")
+11 DO SETTXT("------------- ------------")
+12 ;
+13 SET (X1,FOUND)=0
+14 FOR
SET X1=$ORDER(^PSRX(X1))
if 'X1
QUIT
Begin DoDot:1
+15 IF $DATA(^PSRX(X1,"L",1))
IF '$DATA(^PSRX(X1,"L",0))
Begin DoDot:2
+16 SET FOUND=FOUND+1
+17 SET X2=$ORDER(^PSRX(X1,"L","Z"),-1)
+18 SET ^PSRX(X1,"L",0)="^52.032DA^"_X2_"^"_X2
+19 DO SETTXT($PIECE(^PSRX(X1,0),U,1)_$JUSTIFY(X1,26+$LENGTH(X1)-$LENGTH($PIECE(^PSRX(X1,0),U,1))))
End DoDot:2
End DoDot:1
+20 ;
+21 DO SETTXT("")
+22 IF 'FOUND
DO SETTXT("No Prescriptions were found with a missing Label multiple header.")
+23 ;
+24 DO MAIL
+25 ;
+26 DO BMES^XPDUTL(" Mailman message sent.")
+27 DO BMES^XPDUTL(" Finished post-install for PSO*7*616.")
+28 ;
END ; Exit point
+1 KILL ^TMP("PSO616PI",$JOB),^XTMP("PSO616PI",$JOB)
+2 QUIT
+3 ;
SETTXT(TXT) ; Setting Plain Text
+1 SET PSOLINE=$GET(PSOLINE)+1
SET ^XTMP("PSO616PI",$JOB,PSOLINE)=TXT
+2 QUIT
+3 ;
MAIL ; Sends Mailman message
+1 NEW II,XMX,XMSUB,XMDUZ,XMTEXT,XMY
+2 SET II=0
FOR
SET II=$ORDER(^XUSEC("PSNMGR",II))
if 'II
QUIT
SET XMY(II)=""
+3 SET XMY(DUZ)=""
SET XMSUB="PSO*7*616 - Autocorrection Utility"
+4 SET XMDUZ=.5
SET XMTEXT="^XTMP(""PSO616PI"",$J,"
NEW DIFROM
DO ^XMD
+5 QUIT
