PSO616PI.m

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 ---PSO616PI   1786     printed  Apr 09, 2024@21:28:28                                                                                                                                                                                                    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