PSJ299PO ;BIR/LE-Post Install routine for patch PSJ*5*299 ;05/1/13
;;5.0;INPATIENT MEDICATIONS ;**299**;9/30/97;Build 11
;
QUE ;
N NAMSP,PATCH,JOBN,ZTSK,ZTRTN,ZTIO,ZTDTH,ZTDESC,Y,ZTQUEUED,ZTREQ,ZTSAVE,CNT,SBJM,RESTART,SMSG
S NAMSP="PSJ299PO"
S JOBN="PSJ*5*299 Post Install"
S PATCH="PSJ*5*299"
S Y=$$NOW^XLFDT S ZTDTH=$$FMTH^XLFDT(Y)
;
I '$G(RESTART) D
.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. This may take 2-3 hours.")
.D MES^XPDUTL("==============================================================")
E D
.W !,"============================================================="
.W !,"Queuing background job for "_JOBN_"..."
.W !,"A MailMan message will be sent to the installer upon Post"
.W !,"Install Completion. This may take 2-3 hours."
.W !,"=============================================================="
;
S ZTRTN="EN^"_NAMSP,ZTIO=""
S (SBJM,ZTDESC)="Background job for "_JOBN
S ZTSAVE("JOBN")="",ZTSAVE("ZTDTH")="",ZTSAVE("DUZ")="",ZTSAVE("SBJM")=""
D ^%ZTLOAD
D:$D(ZTSK)
. S SMSG="*** Task #"_ZTSK_" Queued! ***"
. I '$G(RESTART) D MES^XPDUTL(SMSG)
. E W !,SMSG
. I '$G(RESTART) D BMES^XPDUTL("")
. S ZTSAVE("ZTSK")=""
I '$G(RESTART) D BMES^XPDUTL("")
K XPDQUES
Q
;
EN ;Do Mail Message
N DFN,DA,STARTH,STOPH,SUBJ
S STARTH=$$HTE^XLFDT(ZTDTH)
K DIK S DIK="^PS(53.1,",DIK(1)="113^CIMO" D ENALL2^DIK,ENALL^DIK
S DFN=0 F S DFN=$O(^PS(55,DFN)) Q:'DFN S DA(1)=DFN D
.K DIK S DIK="^PS(55,"_DA(1)_",5,",DIK(1)="130^CIMOU" D ENALL2^DIK,ENALL^DIK
.K DIK S DIK="^PS(55,"_DA(1)_",5,",DIK(1)="130^CIMOCLU" D ENALL2^DIK,ENALL^DIK
.K DIK S DIK="^PS(55,"_DA(1)_","_"""IV"""_",",DIK(1)="136^CIMOI" D ENALL2^DIK,ENALL^DIK
.K DIK S DIK="^PS(55,"_DA(1)_","_"""IV"""_",",DIK(1)="136^CIMOCLI" D ENALL2^DIK,ENALL^DIK
K DIK
;
;Send message
S CNT=1
S Y=$$NOW^XLFDT S STOPH=$$FMTH^XLFDT(Y),STOPH=$$HTE^XLFDT(STOPH)
S SUBJ="PSJ*5*299 POST INSTALL Complete"
S MSG(CNT)="The IMO Clinic cross references have been re-indexed:",CNT=CNT+1
S MSG(CNT)=" ",CNT=CNT+1
S MSG(CNT)=" File 53.1 - CIMO",CNT=CNT+1
S MSG(CNT)=" File 55 - CIMOU and CIMOCLU for Unit Dose Sub-file.",CNT=CNT+1
S MSG(CNT)=" File 55 - CIMOI AND CIMOCLI for IV Sub-file.",CNT=CNT+1
S MSG(CNT)=" ",CNT=CNT+1
S MSG(CNT)="The background job "_ZTSK_" began "_STARTH_" and ",CNT=CNT+1
S MSG(CNT)="ended "_STOPH_".",CNT=CNT+1
D MAIL(.MSG,SUBJ)
Q
;
MAIL(MSG,SBJ) ; Send out some mail!
N DIFROM,XMDUZ,XMSUB,XMTEXT,XMY,I
S XMDUZ="INPT PHARMACY",XMSUB=SBJM,XMTEXT="MSG("
S XMY(DUZ)=""
D ^XMD
Q ""
;
RESTART ;restart post install if error occurs
I $G(DUZ)="" W !,"Your DUZ is not defined. It must be defined to run this routine." Q
S RESTART=1
D QUE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJ299PO 3005 printed Sep 23, 2025@19:41:54 Page 2
PSJ299PO ;BIR/LE-Post Install routine for patch PSJ*5*299 ;05/1/13
+1 ;;5.0;INPATIENT MEDICATIONS ;**299**;9/30/97;Build 11
+2 ;
QUE ;
+1 NEW NAMSP,PATCH,JOBN,ZTSK,ZTRTN,ZTIO,ZTDTH,ZTDESC,Y,ZTQUEUED,ZTREQ,ZTSAVE,CNT,SBJM,RESTART,SMSG
+2 SET NAMSP="PSJ299PO"
+3 SET JOBN="PSJ*5*299 Post Install"
+4 SET PATCH="PSJ*5*299"
+5 SET Y=$$NOW^XLFDT
SET ZTDTH=$$FMTH^XLFDT(Y)
+6 ;
+7 IF '$GET(RESTART)
Begin DoDot:1
+8 DO BMES^XPDUTL("=============================================================")
+9 DO MES^XPDUTL("Queuing background job for "_JOBN_"...")
+10 DO MES^XPDUTL("Start time: "_$$HTE^XLFDT(ZTDTH))
+11 DO MES^XPDUTL("A MailMan message will be sent to the installer upon Post")
+12 DO MES^XPDUTL("Install Completion. This may take 2-3 hours.")
+13 DO MES^XPDUTL("==============================================================")
End DoDot:1
+14 IF '$TEST
Begin DoDot:1
+15 WRITE !,"============================================================="
+16 WRITE !,"Queuing background job for "_JOBN_"..."
+17 WRITE !,"A MailMan message will be sent to the installer upon Post"
+18 WRITE !,"Install Completion. This may take 2-3 hours."
+19 WRITE !,"=============================================================="
End DoDot:1
+20 ;
+21 SET ZTRTN="EN^"_NAMSP
SET ZTIO=""
+22 SET (SBJM,ZTDESC)="Background job for "_JOBN
+23 SET ZTSAVE("JOBN")=""
SET ZTSAVE("ZTDTH")=""
SET ZTSAVE("DUZ")=""
SET ZTSAVE("SBJM")=""
+24 DO ^%ZTLOAD
+25 if $DATA(ZTSK)
Begin DoDot:1
+26 SET SMSG="*** Task #"_ZTSK_" Queued! ***"
+27 IF '$GET(RESTART)
DO MES^XPDUTL(SMSG)
+28 IF '$TEST
WRITE !,SMSG
+29 IF '$GET(RESTART)
DO BMES^XPDUTL("")
+30 SET ZTSAVE("ZTSK")=""
End DoDot:1
+31 IF '$GET(RESTART)
DO BMES^XPDUTL("")
+32 KILL XPDQUES
+33 QUIT
+34 ;
EN ;Do Mail Message
+1 NEW DFN,DA,STARTH,STOPH,SUBJ
+2 SET STARTH=$$HTE^XLFDT(ZTDTH)
+3 KILL DIK
SET DIK="^PS(53.1,"
SET DIK(1)="113^CIMO"
DO ENALL2^DIK
DO ENALL^DIK
+4 SET DFN=0
FOR
SET DFN=$ORDER(^PS(55,DFN))
if 'DFN
QUIT
SET DA(1)=DFN
Begin DoDot:1
+5 KILL DIK
SET DIK="^PS(55,"_DA(1)_",5,"
SET DIK(1)="130^CIMOU"
DO ENALL2^DIK
DO ENALL^DIK
+6 KILL DIK
SET DIK="^PS(55,"_DA(1)_",5,"
SET DIK(1)="130^CIMOCLU"
DO ENALL2^DIK
DO ENALL^DIK
+7 KILL DIK
SET DIK="^PS(55,"_DA(1)_","_"""IV"""_","
SET DIK(1)="136^CIMOI"
DO ENALL2^DIK
DO ENALL^DIK
+8 KILL DIK
SET DIK="^PS(55,"_DA(1)_","_"""IV"""_","
SET DIK(1)="136^CIMOCLI"
DO ENALL2^DIK
DO ENALL^DIK
End DoDot:1
+9 KILL DIK
+10 ;
+11 ;Send message
+12 SET CNT=1
+13 SET Y=$$NOW^XLFDT
SET STOPH=$$FMTH^XLFDT(Y)
SET STOPH=$$HTE^XLFDT(STOPH)
+14 SET SUBJ="PSJ*5*299 POST INSTALL Complete"
+15 SET MSG(CNT)="The IMO Clinic cross references have been re-indexed:"
SET CNT=CNT+1
+16 SET MSG(CNT)=" "
SET CNT=CNT+1
+17 SET MSG(CNT)=" File 53.1 - CIMO"
SET CNT=CNT+1
+18 SET MSG(CNT)=" File 55 - CIMOU and CIMOCLU for Unit Dose Sub-file."
SET CNT=CNT+1
+19 SET MSG(CNT)=" File 55 - CIMOI AND CIMOCLI for IV Sub-file."
SET CNT=CNT+1
+20 SET MSG(CNT)=" "
SET CNT=CNT+1
+21 SET MSG(CNT)="The background job "_ZTSK_" began "_STARTH_" and "
SET CNT=CNT+1
+22 SET MSG(CNT)="ended "_STOPH_"."
SET CNT=CNT+1
+23 DO MAIL(.MSG,SUBJ)
+24 QUIT
+25 ;
MAIL(MSG,SBJ) ; Send out some mail!
+1 NEW DIFROM,XMDUZ,XMSUB,XMTEXT,XMY,I
+2 SET XMDUZ="INPT PHARMACY"
SET XMSUB=SBJM
SET XMTEXT="MSG("
+3 SET XMY(DUZ)=""
+4 DO ^XMD
+5 QUIT ""
+6 ;
RESTART ;restart post install if error occurs
+1 IF $GET(DUZ)=""
WRITE !,"Your DUZ is not defined. It must be defined to run this routine."
QUIT
+2 SET RESTART=1
+3 DO QUE
+4 QUIT
