PSSP254V ;CAN/EJD - PSS*1*254 Uninstall ; Jul 22, 2024@23:47
;;1.0;PHARMACY DATA MANAGEMENT;**254**;9/30/97;Build 109
;
;Split into two routines PSSP254U and PSSP254V
;
Q ;Call @Backout
;
;MTXT and PSSLINE are NEWed in the calling routine (PSSP254U)
;
NEWROUTE ;New route rollback
N DA,DIK,NAME,XUMF
;
D SETTXT^PSSP254U("")
S MTXT="STANDARD MEDICATION ROUTES file (#51.23) New Entries:"
D BMES^XPDUTL(MTXT),SETTXT^PSSP254U(MTXT)
D SETTXT^PSSP254U("=================================================")
;
;If file was not impacted, leave
I '$D(^XTMP("PSSP254B","NEWROUTE")) D Q
. S MTXT="No updates needed"
. D MES^XPDUTL(MTXT),SETTXT^PSSP254U(MTXT)
;
S DIK="^PS(51.23,"
S XUMF=1
;
;Loop through ^XTMP("PSSP254B","NEWROUTE",51.23,DA and delete
S DA=""
F S DA=$O(^XTMP("PSSP254B","NEWROUTE",51.23,DA)) Q:DA="" D
. S NAME=^XTMP("PSSP254B","NEWROUTE",51.23,DA)
. ;
. ;If already removed will be "", if overwritten it is already gone
. I $$GET1^DIQ(51.23,DA,.01)'=NAME D Q
. . S MTXT=" - '"_NAME_"' no update needed"
. . D MES^XPDUTL(MTXT),SETTXT^PSSP254U(MTXT)
. ;
. S MTXT=" - Removed "_NAME
. D ^DIK
. D MES^XPDUTL(MTXT),SETTXT^PSSP254U(MTXT)
;
;Index Rebuilds
D SETTXT^PSSP254U("")
S MTXT="MEDICATION ROUTES Index Rebuild:"
D BMES^XPDUTL(MTXT),SETTXT^PSSP254U(MTXT)
;
K DIK
S MTXT=" - Medication Routes"
D MES^XPDUTL(MTXT),SETTXT^PSSP254U(MTXT)
S DIK="^PS(51.2,",DIK(1)=".01^B" D ENALL2^DIK K DIK ;Wipe
S DIK="^PS(51.2,",DIK(1)=".01^B" D ENALL^DIK K DIK ;Rebuild
;
S MTXT=" - Standard Medication Routes"
D MES^XPDUTL(MTXT),SETTXT^PSSP254U(MTXT)
S DIK="^PS(51.23,",DIK(1)="1^C" D ENALL2^DIK K DIK ;Wipe
S DIK="^PS(51.23,",DIK(1)="1^C" D ENALL^DIK K DIK ;Rebuild
Q
;
NEWUNIT ;New unit rollback
N DA,DIK,NAME,XUMF
;
S MTXT="o New DOSE UNITs:" D BMES^XPDUTL(MTXT),SETTXT^PSSP254U(MTXT)
;
;If file was not impacted, leave
I '$D(^XTMP("PSSP254B","NEWUNIT")) D Q
. S MTXT="No updates needed"
. D MES^XPDUTL(MTXT),SETTXT^PSSP254U(MTXT)
;
S DIK="^PS(51.24,"
S XUMF=1
;
;Loop through ^XTMP("PSSP254B","NEWUNIT",51.24,DA and delete
S DA=""
F S DA=$O(^XTMP("PSSP254B","NEWUNIT",51.24,DA)) Q:DA="" D
. S NAME=^XTMP("PSSP254B","NEWUNIT",51.24,DA)
. ;
. ;If already removed will be "", if overwritten it is already gone
. I $$GET1^DIQ(51.24,DA,.01)'=NAME D Q
. . S MTXT=" - '"_NAME_"' no update needed"
. . D MES^XPDUTL(MTXT),SETTXT^PSSP254U(MTXT)
. ;
. S MTXT=" - Removed '"_NAME_"'"
. D ^DIK
. D MES^XPDUTL(MTXT),SETTXT^PSSP254U(MTXT)
;
;Index Rebuilds
D SETTXT^PSSP254U("")
S MTXT="o Index Rebuild:"
D BMES^XPDUTL(MTXT),SETTXT^PSSP254U(MTXT)
;
K DIK
S MTXT=" - DOSE UNITS"
D MES^XPDUTL(MTXT),SETTXT^PSSP254U(MTXT)
S DIK="^PS(51.24,",DIK(1)=".01^B" D ENALL2^DIK K DIK ;Wipe
S DIK="^PS(51.24,",DIK(1)=".01^B" D ENALL^DIK K DIK ;Rebuild
;
S DIK="^PS(51.24,",DIK(1)="1^C" D ENALL2^DIK K DIK ;Wipe
S DIK="^PS(51.24,",DIK(1)="1^C" D ENALL^DIK K DIK ;Rebuild
Q
;
SETUP ;Setup the post patch rollback calls - from PSSP254U@SAVELOG
;Launched with X ^XTMP("PSSP254U","CODE","DOSEUNIT")
S ^XTMP("PSSP254U","CODE","DOSEUNIT")="N LINE F LINE=1:1:5 X ^XTMP(""PSSP254U"",""CODE"",""DOSEUNIT"",LINE)"
S ^XTMP("PSSP254U","CODE","DOSEUNIT",1)="K DIK S DIK=""^PS(51.24,"",DIK(1)="".01^B"" D ENALL2^DIK K DIK"
S ^XTMP("PSSP254U","CODE","DOSEUNIT",2)="S DIK=""^PS(51.24,"",DIK(1)="".01^B"" D ENALL^DIK K DIK"
S ^XTMP("PSSP254U","CODE","DOSEUNIT",3)="S DIK=""^PS(51.24,"",DIK(1)=""1^C"" D ENALL2^DIK K DIK"
S ^XTMP("PSSP254U","CODE","DOSEUNIT",4)="S DIK=""^PS(51.24,"",DIK(1)=""1^C"" D ENALL^DIK K DIK"
S ^XTMP("PSSP254U","CODE","DOSEUNIT",5)="W !,""Dose Unit Index Rebuild Complete."""
;
;Launched with X ^XTMP("PSSP254U","CODE","ROUTE")
S ^XTMP("PSSP254U","CODE","ROUTE")="N LINE F LINE=1:1:5 X ^XTMP(""PSSP254U"",""CODE"",""ROUTE"",LINE)"
S ^XTMP("PSSP254U","CODE","ROUTE",1)="K DIK S DIK=""^PS(51.2,"",DIK(1)="".01^B"" D ENALL2^DIK K DIK"
S ^XTMP("PSSP254U","CODE","ROUTE",2)="S DIK=""^PS(51.2,"",DIK(1)="".01^B"" D ENALL^DIK K DIK"
S ^XTMP("PSSP254U","CODE","ROUTE",3)="S DIK=""^PS(51.23,"",DIK(1)=""1^C"" D ENALL2^DIK K DIK"
S ^XTMP("PSSP254U","CODE","ROUTE",4)="S DIK=""^PS(51.23,"",DIK(1)=""1^C"" D ENALL^DIK K DIK"
S ^XTMP("PSSP254U","CODE","ROUTE",5)="W !,""Medical Route Index Rebuild Complete."""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSP254V 4440 printed Aug 26, 2025@22:49:14 Page 2
PSSP254V ;CAN/EJD - PSS*1*254 Uninstall ; Jul 22, 2024@23:47
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**254**;9/30/97;Build 109
+2 ;
+3 ;Split into two routines PSSP254U and PSSP254V
+4 ;
+5 ;Call @Backout
QUIT
+6 ;
+7 ;MTXT and PSSLINE are NEWed in the calling routine (PSSP254U)
+8 ;
NEWROUTE ;New route rollback
+1 NEW DA,DIK,NAME,XUMF
+2 ;
+3 DO SETTXT^PSSP254U("")
+4 SET MTXT="STANDARD MEDICATION ROUTES file (#51.23) New Entries:"
+5 DO BMES^XPDUTL(MTXT)
DO SETTXT^PSSP254U(MTXT)
+6 DO SETTXT^PSSP254U("=================================================")
+7 ;
+8 ;If file was not impacted, leave
+9 IF '$DATA(^XTMP("PSSP254B","NEWROUTE"))
Begin DoDot:1
+10 SET MTXT="No updates needed"
+11 DO MES^XPDUTL(MTXT)
DO SETTXT^PSSP254U(MTXT)
End DoDot:1
QUIT
+12 ;
+13 SET DIK="^PS(51.23,"
+14 SET XUMF=1
+15 ;
+16 ;Loop through ^XTMP("PSSP254B","NEWROUTE",51.23,DA and delete
+17 SET DA=""
+18 FOR
SET DA=$ORDER(^XTMP("PSSP254B","NEWROUTE",51.23,DA))
if DA=""
QUIT
Begin DoDot:1
+19 SET NAME=^XTMP("PSSP254B","NEWROUTE",51.23,DA)
+20 ;
+21 ;If already removed will be "", if overwritten it is already gone
+22 IF $$GET1^DIQ(51.23,DA,.01)'=NAME
Begin DoDot:2
+23 SET MTXT=" - '"_NAME_"' no update needed"
+24 DO MES^XPDUTL(MTXT)
DO SETTXT^PSSP254U(MTXT)
End DoDot:2
QUIT
+25 ;
+26 SET MTXT=" - Removed "_NAME
+27 DO ^DIK
+28 DO MES^XPDUTL(MTXT)
DO SETTXT^PSSP254U(MTXT)
End DoDot:1
+29 ;
+30 ;Index Rebuilds
+31 DO SETTXT^PSSP254U("")
+32 SET MTXT="MEDICATION ROUTES Index Rebuild:"
+33 DO BMES^XPDUTL(MTXT)
DO SETTXT^PSSP254U(MTXT)
+34 ;
+35 KILL DIK
+36 SET MTXT=" - Medication Routes"
+37 DO MES^XPDUTL(MTXT)
DO SETTXT^PSSP254U(MTXT)
+38 ;Wipe
SET DIK="^PS(51.2,"
SET DIK(1)=".01^B"
DO ENALL2^DIK
KILL DIK
+39 ;Rebuild
SET DIK="^PS(51.2,"
SET DIK(1)=".01^B"
DO ENALL^DIK
KILL DIK
+40 ;
+41 SET MTXT=" - Standard Medication Routes"
+42 DO MES^XPDUTL(MTXT)
DO SETTXT^PSSP254U(MTXT)
+43 ;Wipe
SET DIK="^PS(51.23,"
SET DIK(1)="1^C"
DO ENALL2^DIK
KILL DIK
+44 ;Rebuild
SET DIK="^PS(51.23,"
SET DIK(1)="1^C"
DO ENALL^DIK
KILL DIK
+45 QUIT
+46 ;
NEWUNIT ;New unit rollback
+1 NEW DA,DIK,NAME,XUMF
+2 ;
+3 SET MTXT="o New DOSE UNITs:"
DO BMES^XPDUTL(MTXT)
DO SETTXT^PSSP254U(MTXT)
+4 ;
+5 ;If file was not impacted, leave
+6 IF '$DATA(^XTMP("PSSP254B","NEWUNIT"))
Begin DoDot:1
+7 SET MTXT="No updates needed"
+8 DO MES^XPDUTL(MTXT)
DO SETTXT^PSSP254U(MTXT)
End DoDot:1
QUIT
+9 ;
+10 SET DIK="^PS(51.24,"
+11 SET XUMF=1
+12 ;
+13 ;Loop through ^XTMP("PSSP254B","NEWUNIT",51.24,DA and delete
+14 SET DA=""
+15 FOR
SET DA=$ORDER(^XTMP("PSSP254B","NEWUNIT",51.24,DA))
if DA=""
QUIT
Begin DoDot:1
+16 SET NAME=^XTMP("PSSP254B","NEWUNIT",51.24,DA)
+17 ;
+18 ;If already removed will be "", if overwritten it is already gone
+19 IF $$GET1^DIQ(51.24,DA,.01)'=NAME
Begin DoDot:2
+20 SET MTXT=" - '"_NAME_"' no update needed"
+21 DO MES^XPDUTL(MTXT)
DO SETTXT^PSSP254U(MTXT)
End DoDot:2
QUIT
+22 ;
+23 SET MTXT=" - Removed '"_NAME_"'"
+24 DO ^DIK
+25 DO MES^XPDUTL(MTXT)
DO SETTXT^PSSP254U(MTXT)
End DoDot:1
+26 ;
+27 ;Index Rebuilds
+28 DO SETTXT^PSSP254U("")
+29 SET MTXT="o Index Rebuild:"
+30 DO BMES^XPDUTL(MTXT)
DO SETTXT^PSSP254U(MTXT)
+31 ;
+32 KILL DIK
+33 SET MTXT=" - DOSE UNITS"
+34 DO MES^XPDUTL(MTXT)
DO SETTXT^PSSP254U(MTXT)
+35 ;Wipe
SET DIK="^PS(51.24,"
SET DIK(1)=".01^B"
DO ENALL2^DIK
KILL DIK
+36 ;Rebuild
SET DIK="^PS(51.24,"
SET DIK(1)=".01^B"
DO ENALL^DIK
KILL DIK
+37 ;
+38 ;Wipe
SET DIK="^PS(51.24,"
SET DIK(1)="1^C"
DO ENALL2^DIK
KILL DIK
+39 ;Rebuild
SET DIK="^PS(51.24,"
SET DIK(1)="1^C"
DO ENALL^DIK
KILL DIK
+40 QUIT
+41 ;
SETUP ;Setup the post patch rollback calls - from PSSP254U@SAVELOG
+1 ;Launched with X ^XTMP("PSSP254U","CODE","DOSEUNIT")
+2 SET ^XTMP("PSSP254U","CODE","DOSEUNIT")="N LINE F LINE=1:1:5 X ^XTMP(""PSSP254U"",""CODE"",""DOSEUNIT"",LINE)"
+3 SET ^XTMP("PSSP254U","CODE","DOSEUNIT",1)="K DIK S DIK=""^PS(51.24,"",DIK(1)="".01^B"" D ENALL2^DIK K DIK"
+4 SET ^XTMP("PSSP254U","CODE","DOSEUNIT",2)="S DIK=""^PS(51.24,"",DIK(1)="".01^B"" D ENALL^DIK K DIK"
+5 SET ^XTMP("PSSP254U","CODE","DOSEUNIT",3)="S DIK=""^PS(51.24,"",DIK(1)=""1^C"" D ENALL2^DIK K DIK"
+6 SET ^XTMP("PSSP254U","CODE","DOSEUNIT",4)="S DIK=""^PS(51.24,"",DIK(1)=""1^C"" D ENALL^DIK K DIK"
+7 SET ^XTMP("PSSP254U","CODE","DOSEUNIT",5)="W !,""Dose Unit Index Rebuild Complete."""
+8 ;
+9 ;Launched with X ^XTMP("PSSP254U","CODE","ROUTE")
+10 SET ^XTMP("PSSP254U","CODE","ROUTE")="N LINE F LINE=1:1:5 X ^XTMP(""PSSP254U"",""CODE"",""ROUTE"",LINE)"
+11 SET ^XTMP("PSSP254U","CODE","ROUTE",1)="K DIK S DIK=""^PS(51.2,"",DIK(1)="".01^B"" D ENALL2^DIK K DIK"
+12 SET ^XTMP("PSSP254U","CODE","ROUTE",2)="S DIK=""^PS(51.2,"",DIK(1)="".01^B"" D ENALL^DIK K DIK"
+13 SET ^XTMP("PSSP254U","CODE","ROUTE",3)="S DIK=""^PS(51.23,"",DIK(1)=""1^C"" D ENALL2^DIK K DIK"
+14 SET ^XTMP("PSSP254U","CODE","ROUTE",4)="S DIK=""^PS(51.23,"",DIK(1)=""1^C"" D ENALL^DIK K DIK"
+15 SET ^XTMP("PSSP254U","CODE","ROUTE",5)="W !,""Medical Route Index Rebuild Complete."""
+16 QUIT
