PSSPOST2 ;BIR/LDT-Post install routine ;08/01/00
;;1.0;PHARMACY DATA MANAGEMENT;**38**;9/30/97
;External reference to ORY94 supported by DBIA 3415
; POST-INSTALL ROUTINE
I $$PATCH^XPDUTL("PSS*1.0*38") G END ; has patch already been installed
RES ;
I '$G(DT) S DT=$$DT^XLFDT
;Delete AD cross references on Orderable Items in Files 52.6 and 52.7
D DELIX^DDMOD(52.7,9,2)
D DELIX^DDMOD(52.6,15,2)
;Delete CHANGE TYPE OF ORDER FROM OERR field (#20.412) and IV IDENTIFIER field (#32) from the PHARMACY SYSTEM file (#59.7)
D BMES^XPDUTL("Deleting obsolete fields...")
S DA=20.412 S DIK="^DD(59.7,",DA(1)=59.7 D ^DIK K DIK
;Delete CORRESPONDING UD ITEM field (#3) and CORRESPONDING IV ITEM field (#4) from the PHARMACY ORDERABLE ITEM file (#50.7)
F DA=3,4 S DIK="^DD(50.7,",DA(1)=50.7 D ^DIK K DIK
;Delete Instructions multiple and Pre-Ordering Enhancement field
S DA=2,DA(1)=50.6066,DIK="^DD(50.6066," D ^DIK K DA,DIK
S DA=4,DIK="^DD(50.606,",DA(1)=50.606 D ^DIK K DA,DIK
K DIU S DIU=50.6062,DIU(0)="S" D EN^DIU2 K DIU
D BMES^XPDUTL("Deleting obsolete data...")
N PSSDF,PSSDF1 F PSSDF=0:0 S PSSDF=$O(^PS(50.606,PSSDF)) Q:'PSSDF D
.K ^PS(50.606,PSSDF,"INS")
.I $D(^PS(50.606,PSSDF,"MISC")) S $P(^PS(50.606,PSSDF,"MISC"),"^",2)=""
.F PSSDF1=0:0 S PSSDF1=$O(^PS(50.606,PSSDF,"NOUN",PSSDF1)) Q:'PSSDF1 I $D(^PS(50.606,PSSDF,"NOUN",PSSDF1,0)) S $P(^(0),"^",3)=""
N PSSPSF S PSSPSF=0 F S PSSPSF=$O(^PS(59.7,PSSPSF)) Q:'PSSPSF S $P(^PS(59.7,PSSPSF,20.4),"^",16)=""
N PSSOI S PSSOI=0 F S PSSOI=$O(^PS(50.7,PSSOI)) Q:'PSSOI S $P(^PS(50.7,PSSOI,0),"^",10)="",$P(^(0),"^",11)=""
;
;fix options (matching) DISABLE A/SMATCHING, MODIFY DD, FIX FROM DRIG ENTER.EDIT
;D QUICK^ORUPDATE ; loop through orders, call PSSQORD
;This quick order update may take a while, can CPRS write dots
CON N PSSL,PSSPOI,PSSADD,PSSSOL,PSSDRG,PSSNEWOI,PSSOLDOI,PSSXDATE
;Converting Additives and Solutions to new Orderable Items
S X1=DT,X2=+30 D C^%DTC S PSSXDATE=$G(X)
S ^XTMP("PSSCONA",0)=PSSXDATE_"^"_DT,^XTMP("PSSCONS",0)=PSSXDATE_"^"_DT
D BMES^XPDUTL("Updating IV Additive Orderable Items...")
F PSSL=0:0 S PSSL=$O(^PS(52.6,PSSL)) Q:'PSSL D:$D(^PS(52.6,PSSL,0))
.S PSSOLDOI=$P($G(^PS(52.6,PSSL,0)),"^",11) S $P(^PS(52.6,PSSL,0),"^",11)=""
.I PSSOLDOI K ^PS(52.6,"AOI",PSSOLDOI,PSSL)
.S PSSDRG=$P($G(^PS(52.6,PSSL,0)),"^",2) I 'PSSDRG Q
.S PSSNEWOI=$P($G(^PSDRUG(PSSDRG,2)),"^") D I 'PSSNEWOI Q
..I PSSOLDOI,PSSNEWOI S:'$D(^PSDRUG("A526",PSSDRG,PSSL)) ^XTMP("PSSCONA",PSSOLDOI,PSSL)=PSSNEWOI
.I '$D(^PS(50.7,PSSNEWOI,0)) Q
.S $P(^PS(52.6,PSSL,0),"^",11)=PSSNEWOI,^PS(52.6,"AOI",PSSNEWOI,PSSL)="",^PSDRUG("A526",PSSDRG,PSSL)=""
D BMES^XPDUTL("Updating IV Solution Orderable Items...")
F PSSL=0:0 S PSSL=$O(^PS(52.7,PSSL)) Q:'PSSL D:$D(^PS(52.7,PSSL,0))
.S PSSOLDOI=$P($G(^PS(52.7,PSSL,0)),"^",11) S $P(^PS(52.7,PSSL,0),"^",11)=""
.I PSSOLDOI K ^PS(52.7,"AOI",PSSOLDOI,PSSL)
.S PSSDRG=$P($G(^PS(52.7,PSSL,0)),"^",2) I 'PSSDRG Q
.S PSSNEWOI=$P($G(^PSDRUG(PSSDRG,2)),"^") D I 'PSSNEWOI Q
..I PSSOLDOI,PSSNEWOI S:'$D(^PSDRUG("A527",PSSDRG,PSSL)) ^XTMP("PSSCONS",PSSOLDOI,PSSL)=PSSNEWOI
.I '$D(^PS(50.7,PSSNEWOI,0)) Q
.S $P(^PS(52.7,PSSL,0),"^",11)=PSSNEWOI,^PS(52.7,"AOI",PSSNEWOI,PSSL)="",^PSDRUG("A527",PSSDRG,PSSL)=""
OI ;Updating CPRS with new Orderable Item information
N PSSORITM,PSSRI,PSSORIDT,PSSCONTX,PSSRD1,PSSRD2
D BMES^XPDUTL("Setting new Orderable Item cross reference...")
S PSSCONTX=0
F PSSRD1=0:0 S PSSRD1=$O(^PSDRUG(PSSRD1)) Q:'PSSRD1 D
.S PSSRD2=$P($G(^PSDRUG(PSSRD1,2)),"^") Q:'PSSRD2
.S ^PS(50.7,"A50",PSSRD2,PSSRD1)=""
.I '(PSSCONTX#50) W "."
.S PSSCONTX=PSSCONTX+1
S PSSCONTX=0
D BMES^XPDUTL("Updating Pharmacy Orderable Items...")
I '$G(DT) S DT=$$DT^XLFDT
F PSSRI=0:0 S PSSRI=$O(^PS(50.7,PSSRI)) Q:'PSSRI D:$D(^PS(50.7,PSSRI,0))
.S PSSORITM=PSSRI
.S $P(^PS(50.7,PSSORITM,0),"^",12)=""
.I $P(^PS(50.7,PSSORITM,0),"^",3) D
..S PSSORIDT=$P(^PS(50.7,PSSORITM,0),"^",4) I PSSORIDT,PSSORIDT'>DT Q
..S $P(^PS(50.7,PSSORITM,0),"^",4)=DT
.S PSSCROSS=1,PSSTEST=PSSORITM D EN1^PSSPOIDT K PSSTEST,PSSCROSS
.I '(PSSCONTX#10) W "."
.S PSSCONTX=PSSCONTX+1
;D BMES^XPDUTL("Queue Inpatient Medications order conversion...")
;S ZTDTH=$H,ZTRTN="CNIV^PSJUTL1()",ZTIO="",ZTDESC="Inpatient medications order conversion" D ^%ZTLOAD
;D EN^PSOPOST2
D POST^ORY94
;D POE^PSJPST50
MAIL ;
D NOW^%DTC S PSSTIMEB=%
S Y=$G(^XTMP("PSSTIMEX","START")) D DD^%DT S PSSTIMEA=Y
S Y=$G(PSSTIMEB) D DD^%DT S PSSTIMEB=Y
S XMDUZ="PHARMACY DATA MANAGEMENT PACKAGE",XMY(DUZ)="",XMSUB="Pharmacy Ordering Enhancements Install"
K PSSTEXT S PSSTEXT(1)="The Pharmacy Ordering Enhancements installation is complete.",PSSTEXT(2)="It started on "_$G(PSSTIMEA)_".",PSSTEXT(3)="It ended on "_$G(PSSTIMEB)_"."
S XMTEXT="PSSTEXT(" N DIFROM D ^XMD
K PSSTIMEA,PSSTIMEB,XMDUZ,XMSUB,PSSTEXT,XMTEXT
END ;
Q
RESTART ;restart post init job
G RES
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSPOST2 4952 printed Apr 09, 2024@21:36:45 Page 2
PSSPOST2 ;BIR/LDT-Post install routine ;08/01/00
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**38**;9/30/97
+2 ;External reference to ORY94 supported by DBIA 3415
+3 ; POST-INSTALL ROUTINE
+4 ; has patch already been installed
IF $$PATCH^XPDUTL("PSS*1.0*38")
GOTO END
RES ;
+1 IF '$GET(DT)
SET DT=$$DT^XLFDT
+2 ;Delete AD cross references on Orderable Items in Files 52.6 and 52.7
+3 DO DELIX^DDMOD(52.7,9,2)
+4 DO DELIX^DDMOD(52.6,15,2)
+5 ;Delete CHANGE TYPE OF ORDER FROM OERR field (#20.412) and IV IDENTIFIER field (#32) from the PHARMACY SYSTEM file (#59.7)
+6 DO BMES^XPDUTL("Deleting obsolete fields...")
+7 SET DA=20.412
SET DIK="^DD(59.7,"
SET DA(1)=59.7
DO ^DIK
KILL DIK
+8 ;Delete CORRESPONDING UD ITEM field (#3) and CORRESPONDING IV ITEM field (#4) from the PHARMACY ORDERABLE ITEM file (#50.7)
+9 FOR DA=3,4
SET DIK="^DD(50.7,"
SET DA(1)=50.7
DO ^DIK
KILL DIK
+10 ;Delete Instructions multiple and Pre-Ordering Enhancement field
+11 SET DA=2
SET DA(1)=50.6066
SET DIK="^DD(50.6066,"
DO ^DIK
KILL DA,DIK
+12 SET DA=4
SET DIK="^DD(50.606,"
SET DA(1)=50.606
DO ^DIK
KILL DA,DIK
+13 KILL DIU
SET DIU=50.6062
SET DIU(0)="S"
DO EN^DIU2
KILL DIU
+14 DO BMES^XPDUTL("Deleting obsolete data...")
+15 NEW PSSDF,PSSDF1
FOR PSSDF=0:0
SET PSSDF=$ORDER(^PS(50.606,PSSDF))
if 'PSSDF
QUIT
Begin DoDot:1
+16 KILL ^PS(50.606,PSSDF,"INS")
+17 IF $DATA(^PS(50.606,PSSDF,"MISC"))
SET $PIECE(^PS(50.606,PSSDF,"MISC"),"^",2)=""
+18 FOR PSSDF1=0:0
SET PSSDF1=$ORDER(^PS(50.606,PSSDF,"NOUN",PSSDF1))
if 'PSSDF1
QUIT
IF $DATA(^PS(50.606,PSSDF,"NOUN",PSSDF1,0))
SET $PIECE(^(0),"^",3)=""
End DoDot:1
+19 NEW PSSPSF
SET PSSPSF=0
FOR
SET PSSPSF=$ORDER(^PS(59.7,PSSPSF))
if 'PSSPSF
QUIT
SET $PIECE(^PS(59.7,PSSPSF,20.4),"^",16)=""
+20 NEW PSSOI
SET PSSOI=0
FOR
SET PSSOI=$ORDER(^PS(50.7,PSSOI))
if 'PSSOI
QUIT
SET $PIECE(^PS(50.7,PSSOI,0),"^",10)=""
SET $PIECE(^(0),"^",11)=""
+21 ;
+22 ;fix options (matching) DISABLE A/SMATCHING, MODIFY DD, FIX FROM DRIG ENTER.EDIT
+23 ;D QUICK^ORUPDATE ; loop through orders, call PSSQORD
+24 ;This quick order update may take a while, can CPRS write dots
CON NEW PSSL,PSSPOI,PSSADD,PSSSOL,PSSDRG,PSSNEWOI,PSSOLDOI,PSSXDATE
+1 ;Converting Additives and Solutions to new Orderable Items
+2 SET X1=DT
SET X2=+30
DO C^%DTC
SET PSSXDATE=$GET(X)
+3 SET ^XTMP("PSSCONA",0)=PSSXDATE_"^"_DT
SET ^XTMP("PSSCONS",0)=PSSXDATE_"^"_DT
+4 DO BMES^XPDUTL("Updating IV Additive Orderable Items...")
+5 FOR PSSL=0:0
SET PSSL=$ORDER(^PS(52.6,PSSL))
if 'PSSL
QUIT
if $DATA(^PS(52.6,PSSL,0))
Begin DoDot:1
+6 SET PSSOLDOI=$PIECE($GET(^PS(52.6,PSSL,0)),"^",11)
SET $PIECE(^PS(52.6,PSSL,0),"^",11)=""
+7 IF PSSOLDOI
KILL ^PS(52.6,"AOI",PSSOLDOI,PSSL)
+8 SET PSSDRG=$PIECE($GET(^PS(52.6,PSSL,0)),"^",2)
IF 'PSSDRG
QUIT
+9 SET PSSNEWOI=$PIECE($GET(^PSDRUG(PSSDRG,2)),"^")
Begin DoDot:2
+10 IF PSSOLDOI
IF PSSNEWOI
if '$DATA(^PSDRUG("A526",PSSDRG,PSSL))
SET ^XTMP("PSSCONA",PSSOLDOI,PSSL)=PSSNEWOI
End DoDot:2
IF 'PSSNEWOI
QUIT
+11 IF '$DATA(^PS(50.7,PSSNEWOI,0))
QUIT
+12 SET $PIECE(^PS(52.6,PSSL,0),"^",11)=PSSNEWOI
SET ^PS(52.6,"AOI",PSSNEWOI,PSSL)=""
SET ^PSDRUG("A526",PSSDRG,PSSL)=""
End DoDot:1
+13 DO BMES^XPDUTL("Updating IV Solution Orderable Items...")
+14 FOR PSSL=0:0
SET PSSL=$ORDER(^PS(52.7,PSSL))
if 'PSSL
QUIT
if $DATA(^PS(52.7,PSSL,0))
Begin DoDot:1
+15 SET PSSOLDOI=$PIECE($GET(^PS(52.7,PSSL,0)),"^",11)
SET $PIECE(^PS(52.7,PSSL,0),"^",11)=""
+16 IF PSSOLDOI
KILL ^PS(52.7,"AOI",PSSOLDOI,PSSL)
+17 SET PSSDRG=$PIECE($GET(^PS(52.7,PSSL,0)),"^",2)
IF 'PSSDRG
QUIT
+18 SET PSSNEWOI=$PIECE($GET(^PSDRUG(PSSDRG,2)),"^")
Begin DoDot:2
+19 IF PSSOLDOI
IF PSSNEWOI
if '$DATA(^PSDRUG("A527",PSSDRG,PSSL))
SET ^XTMP("PSSCONS",PSSOLDOI,PSSL)=PSSNEWOI
End DoDot:2
IF 'PSSNEWOI
QUIT
+20 IF '$DATA(^PS(50.7,PSSNEWOI,0))
QUIT
+21 SET $PIECE(^PS(52.7,PSSL,0),"^",11)=PSSNEWOI
SET ^PS(52.7,"AOI",PSSNEWOI,PSSL)=""
SET ^PSDRUG("A527",PSSDRG,PSSL)=""
End DoDot:1
OI ;Updating CPRS with new Orderable Item information
+1 NEW PSSORITM,PSSRI,PSSORIDT,PSSCONTX,PSSRD1,PSSRD2
+2 DO BMES^XPDUTL("Setting new Orderable Item cross reference...")
+3 SET PSSCONTX=0
+4 FOR PSSRD1=0:0
SET PSSRD1=$ORDER(^PSDRUG(PSSRD1))
if 'PSSRD1
QUIT
Begin DoDot:1
+5 SET PSSRD2=$PIECE($GET(^PSDRUG(PSSRD1,2)),"^")
if 'PSSRD2
QUIT
+6 SET ^PS(50.7,"A50",PSSRD2,PSSRD1)=""
+7 IF '(PSSCONTX#50)
WRITE "."
+8 SET PSSCONTX=PSSCONTX+1
End DoDot:1
+9 SET PSSCONTX=0
+10 DO BMES^XPDUTL("Updating Pharmacy Orderable Items...")
+11 IF '$GET(DT)
SET DT=$$DT^XLFDT
+12 FOR PSSRI=0:0
SET PSSRI=$ORDER(^PS(50.7,PSSRI))
if 'PSSRI
QUIT
if $DATA(^PS(50.7,PSSRI,0))
Begin DoDot:1
+13 SET PSSORITM=PSSRI
+14 SET $PIECE(^PS(50.7,PSSORITM,0),"^",12)=""
+15 IF $PIECE(^PS(50.7,PSSORITM,0),"^",3)
Begin DoDot:2
+16 SET PSSORIDT=$PIECE(^PS(50.7,PSSORITM,0),"^",4)
IF PSSORIDT
IF PSSORIDT'>DT
QUIT
+17 SET $PIECE(^PS(50.7,PSSORITM,0),"^",4)=DT
End DoDot:2
+18 SET PSSCROSS=1
SET PSSTEST=PSSORITM
DO EN1^PSSPOIDT
KILL PSSTEST,PSSCROSS
+19 IF '(PSSCONTX#10)
WRITE "."
+20 SET PSSCONTX=PSSCONTX+1
End DoDot:1
+21 ;D BMES^XPDUTL("Queue Inpatient Medications order conversion...")
+22 ;S ZTDTH=$H,ZTRTN="CNIV^PSJUTL1()",ZTIO="",ZTDESC="Inpatient medications order conversion" D ^%ZTLOAD
+23 ;D EN^PSOPOST2
+24 DO POST^ORY94
+25 ;D POE^PSJPST50
MAIL ;
+1 DO NOW^%DTC
SET PSSTIMEB=%
+2 SET Y=$GET(^XTMP("PSSTIMEX","START"))
DO DD^%DT
SET PSSTIMEA=Y
+3 SET Y=$GET(PSSTIMEB)
DO DD^%DT
SET PSSTIMEB=Y
+4 SET XMDUZ="PHARMACY DATA MANAGEMENT PACKAGE"
SET XMY(DUZ)=""
SET XMSUB="Pharmacy Ordering Enhancements Install"
+5 KILL PSSTEXT
SET PSSTEXT(1)="The Pharmacy Ordering Enhancements installation is complete."
SET PSSTEXT(2)="It started on "_$GET(PSSTIMEA)_"."
SET PSSTEXT(3)="It ended on "_$GET(PSSTIMEB)_"."
+6 SET XMTEXT="PSSTEXT("
NEW DIFROM
DO ^XMD
+7 KILL PSSTIMEA,PSSTIMEB,XMDUZ,XMSUB,PSSTEXT,XMTEXT
END ;
+1 QUIT
RESTART ;restart post init job
+1 GOTO RES
+2 QUIT
