PSS1P210 ;PAW - Patch 210 Post Install Routine;4/25/2017
;;1.0;PHARMACY DATA MANAGEMENT;**210**;9/30/97;Build 9
;
;This post-installation routine will identify and report free text in the NAME field
;(#.01) of the ADMINISTRATION SCHEDULE file (#51.1) when the TYPE OF SCHEDULE field (#5)
;is set to D (Day of the Week).
Q
;
EN ; Begin post-installation routine
I $G(DUZ)="" W !,"Your DUZ is not defined. It must be defined to run this routine." Q
N NAMSP,PATCH,JOBN,ZTSK,ZTRTN,ZTIO,ZTDTH,ZTDESC,Y,ZTQUEUED,ZTREQ,ZTSAVE,CNT,SBJM
S NAMSP="PSS1P210"
S JOBN="PSS*1.0*210 Post-Installation"
S PATCH="PSS*1.0*210"
S Y=$$NOW^XLFDT S ZTDTH=$$FMTH^XLFDT(Y)
D BMES^XPDUTL("=============================================================")
D MES^XPDUTL("Queuing background job for "_JOBN_"...")
D MES^XPDUTL("Start time: "_$$HTE^XLFDT(ZTDTH))
D MES^XPDUTL("A MailMan message will be sent to the installer upon Post")
D MES^XPDUTL("Install Completion.")
D MES^XPDUTL("==============================================================")
;
S ZTRTN="ENQN^"_NAMSP,ZTIO=""
S (SBJM,ZTDESC)="Background job for "_JOBN
S ZTSAVE("JOBN")="",ZTSAVE("ZTDTH")="",ZTSAVE("DUZ")="",ZTSAVE("SBJM")=""
D ^%ZTLOAD
D:$D(ZTSK)
. D MES^XPDUTL("*** Task #"_ZTSK_" Queued! ***")
. D BMES^XPDUTL("")
. S ZTSAVE("ZTSK")=""
D BMES^XPDUTL("")
K XPDQUES
Q
;
ENQN ; Loop through file 51.1 and look for Day of the Week Schedule Types with Free Text
N CNT,PSSCREAT,PSSDASH,PSSEXPR,PSSTIME,PSSXTIME,PSSTIMCT,PSSIEN
N PSSSTART,PSSX,PSSZX,PSSZ1,PSSZ2,PSSZ3,PSSZ4
D NOW^%DTC S PSSSTART=$E(%,1,12),PSSCREAT=$E(%,1,7),PSSEXPR=$$FMADD^XLFDT(PSSCREAT,60,0,0,0)
K ^TMP("PSS1P210R",$J)
S CNT=8
S PSSIEN=0
F S PSSIEN=$O(^PS(51.1,PSSIEN)) Q:PSSIEN="" D
. I $P($G(^PS(51.1,PSSIEN,0)),U,5)'="D" Q
. S PSSX=$P(^PS(51.1,PSSIEN,0),U)
. S PSSZX=PSSX S PSSX=$P(PSSX,"@")
. S PSSZ2=1,PSSZ4="-" I PSSX'["-",PSSX?.E1P.E F PSSZ1=1:1:$L(PSSX) I $E(PSSX,PSSZ1)?1P S PSSZ4=$E(PSSX,PSSZ1) Q
. F PSSZ1=1:1:$L(PSSX,PSSZ4) Q:'PSSZ2 S PSSZ2=0 I $L($P(PSSX,PSSZ4,PSSZ1))>1 F PSSZ3="MONDAYS","TUESDAYS","WEDNESDAYS","THURSDAYS","FRIDAYS","SATURDAYS","SUNDAYS" I $P(PSSZ3,$P(PSSX,PSSZ4,PSSZ1))="" S PSSZ2=1 Q
. I PSSZ2=0 K PSSX
. S PSSXTIME=$P(PSSZX,"@",2),PSSDASH=$L(PSSXTIME,"-")
. F PSSTIMCT=1:1:PSSDASH S PSSTIME=$P(PSSXTIME,"-",PSSTIMCT)
. I $L(PSSTIME)>4 K PSSX
. I '$D(PSSX) S ^TMP("PSS1P210R",$J,CNT)=PSSZX,CNT=CNT+1
D STOP
Q
;
STOP K DA,DIE,DR,NUM,CPS,CPSX,DFN,ORSTA,ORSTOP,UDIV,UIEN,UIEN1,%
D XMAIL1
D XMAIL2
Q
;
XMAIL1 ; Post-installation Notification for Installer
K PSG,XMY S XMDUZ=.5,XMSUB="PATCH PSS*1.0*210 INSTALLATION COMPLETE",XMTEXT="PSG(",XMY(DUZ)="" D NOW^%DTC S Y=% X ^DD("DD")
S PSG(1,0)=" -- INSTALLER --"
S PSG(2,0)=" The post-install for PSS*1.0*210 completed "_Y_"."
D ^XMD
Q
;
XMAIL2 ; Post-installation Notification for Users
N PSSDUZ,PSSX
S XMSUB="PSS*1.0*210 Pharmacy Expired Order Status Change"
S XMDUZ=.5
S XMSUB="PSS*1*210 Post-Install ADMINISTRATION SCHEDULE Report"
I $D(^XUSEC("PSA ORDERS")) S PSSDUZ=0 F S PSSDUZ=$O(^XUSEC("PSA ORDERS",PSSDUZ)) Q:'PSSDUZ S XMY(PSSDUZ)=""
I $D(^XUSEC("PSAMGR")) S PSSDUZ=0 F S PSSDUZ=$O(^XUSEC("PSAMGR",PSSDUZ)) Q:'PSSDUZ S XMY(PSSDUZ)=""
I $D(^XUSEC("PSDMGR")) S PSSDUZ=0 F S PSSDUZ=$O(^XUSEC("PSDMGR",PSSDUZ)) Q:'PSSDUZ S XMY(PSSDUZ)=""
S PSSDUZ=0 F S PSSDUZ=$O(^XUSEC("PSNMGR",PSSDUZ)) Q:PSSDUZ'>0 S XMY(PSSDUZ)=""
S ^TMP("PSS1P210R",$J,1)=" Patch PSS*1.0*210 post-installation routine has identified"
S ^TMP("PSS1P210R",$J,2)=" "_(CNT-8)_" Day of the Week ADMINISTRATION SCHEDULES with free"
S ^TMP("PSS1P210R",$J,3)=" text in the NAME field. Please review."
S ^TMP("PSS1P210R",$J,4)=" "
S ^TMP("PSS1P210R",$J,5)="Schedule Name"
S ^TMP("PSS1P210R",$J,6)="======== ===="
S ^TMP("PSS1P210R",$J,7)=" "
S XMY(DUZ)=""
I CNT=8 S ^TMP("PSS1P210R",$J,8)="No discrepancy found, nothing to update..."
S XMTEXT="^TMP(""PSS1P210R"",$J," N DIFROM D ^XMD
K CNT,XMSUB,XMDUZ,XMY,XMTEXT,^TMP("PSS1P210R",$J)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSS1P210 4086 printed Sep 23, 2025@20:05:04 Page 2
PSS1P210 ;PAW - Patch 210 Post Install Routine;4/25/2017
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**210**;9/30/97;Build 9
+2 ;
+3 ;This post-installation routine will identify and report free text in the NAME field
+4 ;(#.01) of the ADMINISTRATION SCHEDULE file (#51.1) when the TYPE OF SCHEDULE field (#5)
+5 ;is set to D (Day of the Week).
+6 QUIT
+7 ;
EN ; Begin post-installation routine
+1 IF $GET(DUZ)=""
WRITE !,"Your DUZ is not defined. It must be defined to run this routine."
QUIT
+2 NEW NAMSP,PATCH,JOBN,ZTSK,ZTRTN,ZTIO,ZTDTH,ZTDESC,Y,ZTQUEUED,ZTREQ,ZTSAVE,CNT,SBJM
+3 SET NAMSP="PSS1P210"
+4 SET JOBN="PSS*1.0*210 Post-Installation"
+5 SET PATCH="PSS*1.0*210"
+6 SET Y=$$NOW^XLFDT
SET ZTDTH=$$FMTH^XLFDT(Y)
+7 DO BMES^XPDUTL("=============================================================")
+8 DO MES^XPDUTL("Queuing background job for "_JOBN_"...")
+9 DO MES^XPDUTL("Start time: "_$$HTE^XLFDT(ZTDTH))
+10 DO MES^XPDUTL("A MailMan message will be sent to the installer upon Post")
+11 DO MES^XPDUTL("Install Completion.")
+12 DO MES^XPDUTL("==============================================================")
+13 ;
+14 SET ZTRTN="ENQN^"_NAMSP
SET ZTIO=""
+15 SET (SBJM,ZTDESC)="Background job for "_JOBN
+16 SET ZTSAVE("JOBN")=""
SET ZTSAVE("ZTDTH")=""
SET ZTSAVE("DUZ")=""
SET ZTSAVE("SBJM")=""
+17 DO ^%ZTLOAD
+18 if $DATA(ZTSK)
Begin DoDot:1
+19 DO MES^XPDUTL("*** Task #"_ZTSK_" Queued! ***")
+20 DO BMES^XPDUTL("")
+21 SET ZTSAVE("ZTSK")=""
End DoDot:1
+22 DO BMES^XPDUTL("")
+23 KILL XPDQUES
+24 QUIT
+25 ;
ENQN ; Loop through file 51.1 and look for Day of the Week Schedule Types with Free Text
+1 NEW CNT,PSSCREAT,PSSDASH,PSSEXPR,PSSTIME,PSSXTIME,PSSTIMCT,PSSIEN
+2 NEW PSSSTART,PSSX,PSSZX,PSSZ1,PSSZ2,PSSZ3,PSSZ4
+3 DO NOW^%DTC
SET PSSSTART=$EXTRACT(%,1,12)
SET PSSCREAT=$EXTRACT(%,1,7)
SET PSSEXPR=$$FMADD^XLFDT(PSSCREAT,60,0,0,0)
+4 KILL ^TMP("PSS1P210R",$JOB)
+5 SET CNT=8
+6 SET PSSIEN=0
+7 FOR
SET PSSIEN=$ORDER(^PS(51.1,PSSIEN))
if PSSIEN=""
QUIT
Begin DoDot:1
+8 IF $PIECE($GET(^PS(51.1,PSSIEN,0)),U,5)'="D"
QUIT
+9 SET PSSX=$PIECE(^PS(51.1,PSSIEN,0),U)
+10 SET PSSZX=PSSX
SET PSSX=$PIECE(PSSX,"@")
+11 SET PSSZ2=1
SET PSSZ4="-"
IF PSSX'["-"
IF PSSX?.E1P.E
FOR PSSZ1=1:1:$LENGTH(PSSX)
IF $EXTRACT(PSSX,PSSZ1)?1P
SET PSSZ4=$EXTRACT(PSSX,PSSZ1)
QUIT
+12 FOR PSSZ1=1:1:$LENGTH(PSSX,PSSZ4)
if 'PSSZ2
QUIT
SET PSSZ2=0
IF $LENGTH($PIECE(PSSX,PSSZ4,PSSZ1))>1
FOR PSSZ3="MONDAYS","TUESDAYS","WEDNESDAYS","THURSDAYS","FRIDAYS","SATURDAYS","SUNDAYS"
IF $PIECE(PSSZ3,$PIECE(PSSX,PSSZ4,PSSZ1))=""
SET PSSZ2=1
QUIT
+13 IF PSSZ2=0
KILL PSSX
+14 SET PSSXTIME=$PIECE(PSSZX,"@",2)
SET PSSDASH=$LENGTH(PSSXTIME,"-")
+15 FOR PSSTIMCT=1:1:PSSDASH
SET PSSTIME=$PIECE(PSSXTIME,"-",PSSTIMCT)
+16 IF $LENGTH(PSSTIME)>4
KILL PSSX
+17 IF '$DATA(PSSX)
SET ^TMP("PSS1P210R",$JOB,CNT)=PSSZX
SET CNT=CNT+1
End DoDot:1
+18 DO STOP
+19 QUIT
+20 ;
STOP KILL DA,DIE,DR,NUM,CPS,CPSX,DFN,ORSTA,ORSTOP,UDIV,UIEN,UIEN1,%
+1 DO XMAIL1
+2 DO XMAIL2
+3 QUIT
+4 ;
XMAIL1 ; Post-installation Notification for Installer
+1 KILL PSG,XMY
SET XMDUZ=.5
SET XMSUB="PATCH PSS*1.0*210 INSTALLATION COMPLETE"
SET XMTEXT="PSG("
SET XMY(DUZ)=""
DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
+2 SET PSG(1,0)=" -- INSTALLER --"
+3 SET PSG(2,0)=" The post-install for PSS*1.0*210 completed "_Y_"."
+4 DO ^XMD
+5 QUIT
+6 ;
XMAIL2 ; Post-installation Notification for Users
+1 NEW PSSDUZ,PSSX
+2 SET XMSUB="PSS*1.0*210 Pharmacy Expired Order Status Change"
+3 SET XMDUZ=.5
+4 SET XMSUB="PSS*1*210 Post-Install ADMINISTRATION SCHEDULE Report"
+5 IF $DATA(^XUSEC("PSA ORDERS"))
SET PSSDUZ=0
FOR
SET PSSDUZ=$ORDER(^XUSEC("PSA ORDERS",PSSDUZ))
if 'PSSDUZ
QUIT
SET XMY(PSSDUZ)=""
+6 IF $DATA(^XUSEC("PSAMGR"))
SET PSSDUZ=0
FOR
SET PSSDUZ=$ORDER(^XUSEC("PSAMGR",PSSDUZ))
if 'PSSDUZ
QUIT
SET XMY(PSSDUZ)=""
+7 IF $DATA(^XUSEC("PSDMGR"))
SET PSSDUZ=0
FOR
SET PSSDUZ=$ORDER(^XUSEC("PSDMGR",PSSDUZ))
if 'PSSDUZ
QUIT
SET XMY(PSSDUZ)=""
+8 SET PSSDUZ=0
FOR
SET PSSDUZ=$ORDER(^XUSEC("PSNMGR",PSSDUZ))
if PSSDUZ'>0
QUIT
SET XMY(PSSDUZ)=""
+9 SET ^TMP("PSS1P210R",$JOB,1)=" Patch PSS*1.0*210 post-installation routine has identified"
+10 SET ^TMP("PSS1P210R",$JOB,2)=" "_(CNT-8)_" Day of the Week ADMINISTRATION SCHEDULES with free"
+11 SET ^TMP("PSS1P210R",$JOB,3)=" text in the NAME field. Please review."
+12 SET ^TMP("PSS1P210R",$JOB,4)=" "
+13 SET ^TMP("PSS1P210R",$JOB,5)="Schedule Name"
+14 SET ^TMP("PSS1P210R",$JOB,6)="======== ===="
+15 SET ^TMP("PSS1P210R",$JOB,7)=" "
+16 SET XMY(DUZ)=""
+17 IF CNT=8
SET ^TMP("PSS1P210R",$JOB,8)="No discrepancy found, nothing to update..."
+18 SET XMTEXT="^TMP(""PSS1P210R"",$J,"
NEW DIFROM
DO ^XMD
+19 KILL CNT,XMSUB,XMDUZ,XMY,XMTEXT,^TMP("PSS1P210R",$JOB)
+20 QUIT
+21 ;
