PSJ320PO ;BIR/TC - Post Install routine for patch PSJ*5*320 ;06/16/15
;;5.0;INPATIENT MEDICATIONS ;**320**;9/30/97;Build 7
;
; Reference to ^PS(55 is supported by DBIA #2191.
; Reference to ^OR(100 is supported by DBIA# 3582.
;
QUE ;
N NAMSP,PATCH,JOBN,ZTSK,ZTRTN,ZTIO,ZTDTH,ZTDESC,Y,ZTQUEUED,ZTREQ,ZTSAVE,CNT,PSJCNT,SBJM,RESTART,SMSG
S NAMSP="PSJ320PO"
S JOBN="PSJ*5*320 Post Install"
S PATCH="PSJ*5*320"
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. This may take 4-5 minutes.")
D MES^XPDUTL("==============================================================")
;
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)
. D MES^XPDUTL("*** Task #"_ZTSK_" Queued! ***")
. D BMES^XPDUTL("")
. S ZTSAVE("ZTSK")=""
D BMES^XPDUTL("")
K XPDQUES
Q
;
EN ; Do mail message
N PSJDFN,DA,STARTH,STOPH,SUBJ
S STARTH=$$HTE^XLFDT(ZTDTH)
K ^TMP("PSJOR",$J),^TMP("PSJTEXT",$J) S PSJCNT=0
S PSJLOC="" F S PSJLOC=$O(^DPT("CN",PSJLOC)) Q:PSJLOC="" D
.S PSJDFN=0 F S PSJDFN=$O(^DPT("CN",PSJLOC,PSJDFN)) Q:PSJDFN'>0 D
..S PSJDTS=DT F S PSJDTS=$O(^PS(55,PSJDFN,5,"AUS",PSJDTS)) Q:PSJDTS'>0 F PSJL=5,"IV" D
...S PSJON=0 F S PSJON=$O(^PS(55,PSJDFN,PSJL,"AUS",PSJDTS,PSJON)) Q:+PSJON'>0 D
....S PSJORDN1=$P($G(^PS(55,PSJDFN,PSJL,+PSJON,0)),U,21) S PSJNODE4=$G(^OR(100,+PSJORDN1,4)),PSJND=$E(PSJNODE4,$L(PSJNODE4)-1,$L(PSJNODE4)) I PSJND["UU" D
.....S PSJCNT=PSJCNT+1,$P(PSJLINE," ",77)=""
.....S PSJDATA=$E(PSJDFN_PSJLINE,1,20)_" "_$E(+PSJORDN1_PSJLINE,1,15)_" "_PSJNODE4
.....S ^TMP("PSJOR",$J,PSJCNT)=PSJDATA
;
;Send message
S Y=$$NOW^XLFDT S STOPH=$$FMTH^XLFDT(Y),STOPH=$$HTE^XLFDT(STOPH)
S XMDUZ="PSJ*5*320 POST INSTALL Complete"
S XMY(DUZ)=""
S ^TMP("PSJTEXT",$J,1)="The background job "_ZTSK_" began "_STARTH_" and "
S ^TMP("PSJTEXT",$J,2)="ended "_STOPH_"."
S ^TMP("PSJTEXT",$J,3)=" "
I PSJCNT<1 S ^TMP("PSJTEXT",$J,4)=" NO AFFECTED ORDERS FOUND " D MAIL K ^TMP("PSJTEXT",$J),^TMP("PSJOR",$J) Q
S ^TMP("PSJTEXT",$J,4)="The following orders contain ""UU"" in Node 4 of the Order File (#100) "
S ^TMP("PSJTEXT",$J,5)=" "
S ^TMP("PSJTEXT",$J,6)=" STEPS TO CORRECT THE DATA "
S ^TMP("PSJTEXT",$J,7)=" 1) Discontinue the affected order(s) and re-enter them "
S ^TMP("PSJTEXT",$J,8)=" 2) Using Fileman, delete the patient from BCBU Workstation (file #53.7)"
S ^TMP("PSJTEXT",$J,9)=" 3) Do a Single Patient Init (PSB BCBU INIT SINGLE PT) for each patient "
S ^TMP("PSJTEXT",$J,10)=" "
S ^TMP("PSJTEXT",$J,11)=" If you have any questions on this process, please log a remedy ticket "
S ^TMP("PSJTEXT",$J,12)=" "
S ^TMP("PSJTEXT",$J,13)=" DFN ORDER # NODE 4 "
S PSJTXLN=14
F PSJCNT=0:0 S PSJCNT=$O(^TMP("PSJOR",$J,PSJCNT)) Q:'PSJCNT S ^TMP("PSJTEXT",$J,PSJTXLN)=$G(^TMP("PSJOR",$J,PSJCNT)),PSJTXLN=PSJTXLN+1
D MAIL
K ^TMP("PSJTEXT",$J),^TMP("PSJOR",$J)
Q
MAIL ;
N DIFROM,XMDUZ,XMSUB,XMTEXT,XMY,I
S XMDUZ="INPT PHARMACY",XMSUB=SBJM,XMTEXT="^TMP(""PSJTEXT"","_$J_","
S XMY(DUZ)=""
D ^XMD
Q ""
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJ320PO 3467 printed Sep 23, 2025@19:41:58 Page 2
PSJ320PO ;BIR/TC - Post Install routine for patch PSJ*5*320 ;06/16/15
+1 ;;5.0;INPATIENT MEDICATIONS ;**320**;9/30/97;Build 7
+2 ;
+3 ; Reference to ^PS(55 is supported by DBIA #2191.
+4 ; Reference to ^OR(100 is supported by DBIA# 3582.
+5 ;
QUE ;
+1 NEW NAMSP,PATCH,JOBN,ZTSK,ZTRTN,ZTIO,ZTDTH,ZTDESC,Y,ZTQUEUED,ZTREQ,ZTSAVE,CNT,PSJCNT,SBJM,RESTART,SMSG
+2 SET NAMSP="PSJ320PO"
+3 SET JOBN="PSJ*5*320 Post Install"
+4 SET PATCH="PSJ*5*320"
+5 SET Y=$$NOW^XLFDT
SET ZTDTH=$$FMTH^XLFDT(Y)
+6 ;
+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. This may take 4-5 minutes.")
+12 DO MES^XPDUTL("==============================================================")
+13 ;
+14 SET ZTRTN="EN^"_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 ;
EN ; Do mail message
+1 NEW PSJDFN,DA,STARTH,STOPH,SUBJ
+2 SET STARTH=$$HTE^XLFDT(ZTDTH)
+3 KILL ^TMP("PSJOR",$JOB),^TMP("PSJTEXT",$JOB)
SET PSJCNT=0
+4 SET PSJLOC=""
FOR
SET PSJLOC=$ORDER(^DPT("CN",PSJLOC))
if PSJLOC=""
QUIT
Begin DoDot:1
+5 SET PSJDFN=0
FOR
SET PSJDFN=$ORDER(^DPT("CN",PSJLOC,PSJDFN))
if PSJDFN'>0
QUIT
Begin DoDot:2
+6 SET PSJDTS=DT
FOR
SET PSJDTS=$ORDER(^PS(55,PSJDFN,5,"AUS",PSJDTS))
if PSJDTS'>0
QUIT
FOR PSJL=5,"IV"
Begin DoDot:3
+7 SET PSJON=0
FOR
SET PSJON=$ORDER(^PS(55,PSJDFN,PSJL,"AUS",PSJDTS,PSJON))
if +PSJON'>0
QUIT
Begin DoDot:4
+8 SET PSJORDN1=$PIECE($GET(^PS(55,PSJDFN,PSJL,+PSJON,0)),U,21)
SET PSJNODE4=$GET(^OR(100,+PSJORDN1,4))
SET PSJND=$EXTRACT(PSJNODE4,$LENGTH(PSJNODE4)-1,$LENGTH(PSJNODE4))
IF PSJND["UU"
Begin DoDot:5
+9 SET PSJCNT=PSJCNT+1
SET $PIECE(PSJLINE," ",77)=""
+10 SET PSJDATA=$EXTRACT(PSJDFN_PSJLINE,1,20)_" "_$EXTRACT(+PSJORDN1_PSJLINE,1,15)_" "_PSJNODE4
+11 SET ^TMP("PSJOR",$JOB,PSJCNT)=PSJDATA
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+12 ;
+13 ;Send message
+14 SET Y=$$NOW^XLFDT
SET STOPH=$$FMTH^XLFDT(Y)
SET STOPH=$$HTE^XLFDT(STOPH)
+15 SET XMDUZ="PSJ*5*320 POST INSTALL Complete"
+16 SET XMY(DUZ)=""
+17 SET ^TMP("PSJTEXT",$JOB,1)="The background job "_ZTSK_" began "_STARTH_" and "
+18 SET ^TMP("PSJTEXT",$JOB,2)="ended "_STOPH_"."
+19 SET ^TMP("PSJTEXT",$JOB,3)=" "
+20 IF PSJCNT<1
SET ^TMP("PSJTEXT",$JOB,4)=" NO AFFECTED ORDERS FOUND "
DO MAIL
KILL ^TMP("PSJTEXT",$JOB),^TMP("PSJOR",$JOB)
QUIT
+21 SET ^TMP("PSJTEXT",$JOB,4)="The following orders contain ""UU"" in Node 4 of the Order File (#100) "
+22 SET ^TMP("PSJTEXT",$JOB,5)=" "
+23 SET ^TMP("PSJTEXT",$JOB,6)=" STEPS TO CORRECT THE DATA "
+24 SET ^TMP("PSJTEXT",$JOB,7)=" 1) Discontinue the affected order(s) and re-enter them "
+25 SET ^TMP("PSJTEXT",$JOB,8)=" 2) Using Fileman, delete the patient from BCBU Workstation (file #53.7)"
+26 SET ^TMP("PSJTEXT",$JOB,9)=" 3) Do a Single Patient Init (PSB BCBU INIT SINGLE PT) for each patient "
+27 SET ^TMP("PSJTEXT",$JOB,10)=" "
+28 SET ^TMP("PSJTEXT",$JOB,11)=" If you have any questions on this process, please log a remedy ticket "
+29 SET ^TMP("PSJTEXT",$JOB,12)=" "
+30 SET ^TMP("PSJTEXT",$JOB,13)=" DFN ORDER # NODE 4 "
+31 SET PSJTXLN=14
+32 FOR PSJCNT=0:0
SET PSJCNT=$ORDER(^TMP("PSJOR",$JOB,PSJCNT))
if 'PSJCNT
QUIT
SET ^TMP("PSJTEXT",$JOB,PSJTXLN)=$GET(^TMP("PSJOR",$JOB,PSJCNT))
SET PSJTXLN=PSJTXLN+1
+33 DO MAIL
+34 KILL ^TMP("PSJTEXT",$JOB),^TMP("PSJOR",$JOB)
+35 QUIT
MAIL ;
+1 NEW DIFROM,XMDUZ,XMSUB,XMTEXT,XMY,I
+2 SET XMDUZ="INPT PHARMACY"
SET XMSUB=SBJM
SET XMTEXT="^TMP(""PSJTEXT"","_$JOB_","
+3 SET XMY(DUZ)=""
+4 DO ^XMD
+5 QUIT ""
+6 ;
