- 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 Mar 13, 2025@21:28:15 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
