PSSP254U ;CAN/EJD - PSS*1*254 Uninstall ; Nov 02, 2022@16:00
;;1.0;PHARMACY DATA MANAGEMENT;**254**;9/30/97;Build 109
;
;Split into two routines PSSP254U and PSSP254V
;
Q ;Call @Backout
;
;Patterned after PSSP254@POST
BACKOUT ;Perform the backout
N PSSLINE,MTXT
;
;Verify there is backup data
I '$D(^XTMP("PSSP254B")) W !!,"No data to rollback. Nothing Done." Q
;
;Prompt the user "Are you sure you want to do this" before continuing
I '$$GONOGO() Q
;
;This TEMP global will be used for the Mailman Message
K ^TMP("PSS254P",$J)
;
I $G(U)="" S U="^"
;
;Updates to the PPSN & FDB WebServices
D WS
;
;Updates to DOSE UNITS (#51.24) and DOSE UNIT CONVERSION (#51.25) files
;New units were added late. To facilitate component testing, handled in a separate call.
D ST
D NEWUNIT^PSSP254V
;
;Updates to STANDARD MEDICATION ROUTES (#51.23) file
;New routes were added late. To facilitate component testing, handled in a separate call.
D MR
D NEWROUTE^PSSP254V
;
;Updates to the DOSING CHECK FREQUENCY field for the files #51 and #51.1
D DCF
;
;Sends Mailman Message to Installer and PSNMGR key holders listing updates
D MAIL
;
;Backup the rollback log
D SAVELOG
;
K ^TMP("PSS254P",$J)
Q
;
;Prompt the user Are you sure before continuing
;Y: 0 = No // 1 = Yes
GONOGO() ;Safety Check
N DIR,X,Y
;
S DIR(0)="Y"
S DIR("A")="Are you sure you want to do this"
S DIR("B")="No" ;Default to No
D ^DIR
;
I Y'=1 W !!,"Nothing Done" Q 0
Q 1
;
;Save and wipe the original rollback log
SAVELOG ;Save
K ^XTMP("PSSP254U") ;Wipe to ensure this is clear
D SETUP^PSSP254V ;Save post patch rollback code for the indice rebuild
M ^XTMP("PSSP254U")=^XTMP("PSSP254B") ;Save the original rollback log
K ^XTMP("PSSP254B") ;Wipe the original rollback log
Q
;
DCF ;File 51 and 51.1 Dosing Check Frequency
N FILE,FIELD,MEDSCH,OLDFREQ,NEWFREQ,XX,LINE,DIE,DR,DA,X,Y,FREQCHK,DRGCTR,DRGFILE,DRGNODE,TMPMSG
;
D SETTXT("")
S MTXT="DOSING CHECK FREQUENCY field Conversion:"
D BMES^XPDUTL(MTXT),SETTXT(MTXT)
D SETTXT("========================================")
;
I '$D(^XTMP("PSSP254B","DCF")) D
. S MTXT="No updates needed"
. D MES^XPDUTL(MTXT),SETTXT(MTXT)
E D
. S FILE="" F S FILE=$O(^XTMP("PSSP254B","DCF",FILE)) Q:'FILE D
. . S MTXT="o File: "_$S(FILE=51:"MEDICATION INSTRUCTION (#51)",1:"ADMINISTRATION SCHEDULE (#51.1)")
. . D MES^XPDUTL(MTXT),SETTXT(MTXT)
. . S MEDSCH="" F S MEDSCH=$O(^XTMP("PSSP254B","DCF",FILE,MEDSCH)) Q:MEDSCH="" D
. . . S FIELD="" F S FIELD=$O(^XTMP("PSSP254B","DCF",FILE,MEDSCH,FIELD)) Q:FIELD="" D
. . . . S XX=$G(^XTMP("PSSP254B","DCF",FILE,MEDSCH,FIELD))
. . . . S NEWFREQ=$P(XX,U,2)
. . . . S OLDFREQ=$P(XX,U)
. . . . ;
. . . . S MTXT=" - "_$$GET1^DIQ(FILE,MEDSCH,.01)_" ("_$$GET1^DIQ(FILE,MEDSCH,$S(FILE=51:1,1:8))
. . . . ;
. . . . ;Already restored
. . . . I OLDFREQ=$$GET1^DIQ(FILE,MEDSCH,$S(FILE=51:32,1:11)) D Q
. . . . . S MTXT=MTXT_") - no update needed"
. . . . . D MES^XPDUTL(MTXT),SETTXT(MTXT)
. . . . ;
. . . . ;If it was deleted, restore drugs too
. . . . I NEWFREQ="@" D
. . . . . K DIE,DR S DIE=FILE,DR=FIELD_"////"_OLDFREQ,DA=MEDSCH D ^DIE
. . . . . S MTXT=MTXT_") - '"_OLDFREQ_"' restored."
. . . . . D MES^XPDUTL(MTXT),SETTXT(MTXT)
. . . . . I $D(^XTMP("PSSP254B","DCFDRUG",FILE,MEDSCH,FIELD)) D DCFDRG(FILE,MEDSCH,FIELD)
. . . . E D
. . . . . K DIE,DR S DIE=FILE,DR=FIELD_"////"_OLDFREQ,DA=MEDSCH D ^DIE
. . . . . S MTXT=MTXT_") - Restored from '"_NEWFREQ_"' to '"_OLDFREQ_"'"
. . . . . D MES^XPDUTL(MTXT),SETTXT(MTXT)
. . D SETTXT("")
Q
;
;FILE is 51 (Medication Instruction) or 51.1 (Administration Schedule)
;MEDSCH is the DA for the FILE entry
;FIELD is the Dosing Check Frequency field in FILE
DCFDRG(FILE,MEDSCH,FIELD) ;Restore impacted drugs
N DA,DIC,DRGCTR,DRGFILE,DRGLIST,DRGNAME,X
;
S DRGFILE=$S(FILE=51:51.321,1:51.111)
S DRGNODE=$S(FILE=51:5,1:4)
;
S DRGCTR=""
F S DRGCTR=$O(^XTMP("PSSP254B","DCFDRUG",FILE,MEDSCH,FIELD,DRGCTR)) Q:DRGCTR="" D
. S X=$P(^XTMP("PSSP254B","DCFDRUG",FILE,MEDSCH,FIELD,DRGCTR),U)
. S DRGNAME=$P(^XTMP("PSSP254B","DCFDRUG",FILE,MEDSCH,FIELD,DRGCTR),U,2)
. S DA(1)=MEDSCH
. S DIC="^PS("_FILE_","_DA(1)_","_DRGNODE_","
. S DIC(0)="L"
. D FILE^DICN
. ;
. I DRGNAME'="" S DRGLIST(DRGNAME)="" ;Setup for alphabetical display
;
I $D(DRGLIST) D
. S MTXT=" Restored Drugs"
. D MES^XPDUTL(MTXT),SETTXT(MTXT)
. S DRGNAME="" F S DRGNAME=$O(DRGLIST(DRGNAME)) Q:DRGNAME="" D
. . S MTXT=" "_DRGNAME
. . D MES^XPDUTL(MTXT),SETTXT(MTXT)
Q
;
WS ; Web Service updates
N FDA,PORT,PSSERR,PSSIEN,PSSIENC,SERVER,SRVNAME
;
;If webservices were not impacted, leave
I '$Data(^XTMP("PSSP254B","WS")) D MES^XPDUTL("No Web Services update needed") Q
;
D MES^XPDUTL("Restoring the Web Services:")
S PSSIEN=""
F S PSSIEN=$O(^XTMP("PSSP254B","WS",18.12,PSSIEN)) Q:PSSIEN="" D
. K FDA
. ;
. S SRVNAME=$P($G(^XTMP("PSSP254B","WS",18.12,PSSIEN,0)),U,1)
. S SERVER=$P($G(^XTMP("PSSP254B","WS",18.12,PSSIEN,0)),U,4)
. S PORT=$P($G(^XTMP("PSSP254B","WS",18.12,PSSIEN,0)),U,3)
. ;
. ;Verify current loadout
. I SERVER=$$GET1^DIQ(18.12,PSSIEN,.04),PORT=$$GET1^DIQ(18.12,PSSIEN,.03) D Q
. . S MTXT="o WEB SERVER '"_SRVNAME_"' no update needed"
. . D MES^XPDUTL(MTXT),SETTXT(MTXT)
. ;
. S PSSIENC=PSSIEN_"," D DISABLE(SRVNAME,PSSIENC)
. S FDA(18.12,PSSIENC,.04)=SERVER
. S FDA(18.12,PSSIENC,.03)=PORT
. S FDA(18.12,PSSIENC,.06)=1 ; status
. D FILE^DIE("K","FDA","PSSERR")
. I '$D(PSSERR("DIERR",1,"TEXT",1)) S MTXT="o WEB SERVER '"_SRVNAME_"' updated successfully"
. I $D(PSSERR("DIERR",1,"TEXT",1)) S MTXT="o WEB SERVER '"_SRVNAME_"' Error: "_PSSERR("DIERR",1,"TEXT",1)
. D MES^XPDUTL(MTXT),SETTXT(MTXT)
Q
;
MR ; STANDARD MEDICATION ROUTES (#51.23) file updates
N DA,DIE,DR,FROM,NAME,OLD
;
D SETTXT("")
S MTXT="STANDARD MEDICATION ROUTES file (#51.23) Updates:"
D BMES^XPDUTL(MTXT),SETTXT(MTXT)
D SETTXT("=================================================")
;
;If file was not impacted, leave
I '$D(^XTMP("PSSP254B","SMR-U")) D Q
. S MTXT="No updates needed"
. D MES^XPDUTL(MTXT),SETTXT(MTXT)
;
;Loop through ^XTMP("PSSP254B","SMR-U",51.23,DA - roll back to $P(1)
S DA="" F S DA=$O(^XTMP("PSSP254B","SMR-U",51.23,DA)) Q:DA="" D
. S OLD=$P(^XTMP("PSSP254B","SMR-U",51.23,DA,1),U)
. S NAME=$$GET1^DIQ(51.23,DA,.01)
. ;
. ;Verify whether update is needed
. I OLD=$$GET1^DIQ(51.23,DA,1) D Q
. . S MTXT=" - '"_NAME_"' no update needed"
. . D MES^XPDUTL(MTXT),SETTXT(MTXT)
. ;
. S MTXT=" - Restored "_NAME_" from '"_$$GET1^DIQ(51.23,DA,1)_"' to '"_OLD_"'"
. I OLD="" S OLD="@"
. S DIE="^PS(51.23,",DR="1////"_OLD D ^DIE
. D MES^XPDUTL(MTXT),SETTXT(MTXT)
Q
;
ST ; Update entries in DOSE UNITS file (#51.24) and DOSE UNIT CONVERSION file (#51.25)
N II,JJ,PSA,PSI,PSJ,PSL,PSLIST,PSX,SYM,TXT,X
;
S TXT="DOSE UNITS file (#51.24) Updates"
D BMES^XPDUTL(TXT)
D SETTXT("")
D SETTXT(TXT)
D SETTXT("===================================================================")
;
;File 51.24 - FDB Dose Unit
D FDB
;
D SETTXT("")
;
;File 51.24 - Synonyms
D SYN
;
D SETTXT("")
;
;File 51.24 - Deleted Entries
D DEL24
;
D SETTXT("")
;
S TXT="DOSE UNIT CONVERSION file (#51.25) Updates"
D BMES^XPDUTL(TXT)
D SETTXT("")
D SETTXT(TXT)
D SETTXT("===================================================================")
;
;File 51.25 - Dose Unit 1
D DUC
;
D SETTXT("")
;
;File 51.25 - Deleted Entries
D DEL25
;
D SETTXT("")
;
;File 51.25 - Dose Unit 2
D UNIT2
;
K DIE,DR,DA,XUMF
Q
;
FDB ; 1st DataBank Dose Unit Updates
N DA,DIE,DR,NAME,OLD,XUMF
;
S MTXT="o FDB DOSE UNIT updates:" D BMES^XPDUTL(MTXT),SETTXT(MTXT)
;
I '$D(^XTMP("PSSP254B","DU-U",51.24)) D Q
. S MTXT="No updates needed"
. D MES^XPDUTL(MTXT),SETTXT(MTXT)
;
S DA="" F S DA=$O(^XTMP("PSSP254B","DU-U",51.24,DA)) Q:DA="" D
. S NAME=$P(^XTMP("PSSP254B","DU-U",51.24,DA,1),U)
. S OLD=$P(^XTMP("PSSP254B","DU-U",51.24,DA,1),U,2)
. ;
. I $$GET1^DIQ(51.24,DA,1)=OLD D Q
. . S MTXT=" - Entry #"_DA_" ("_NAME_"): no update needed"
. . D MES^XPDUTL(MTXT),SETTXT(MTXT)
. ;
. S MTXT=" - Entry #"_DA_" ("_NAME_"): restored from '"_$$GET1^DIQ(51.24,DA,1)_"' to '"_OLD_"'"
. I OLD="" S OLD="@"
. S XUMF=1,DR="1////"_OLD,DIE=51.24 D ^DIE
. D MES^XPDUTL(MTXT),SETTXT(MTXT)
Q
;
SYN ; SYNONYM updates
N DA,DIE,DR,ENTRY,SFILE,SUBS,SYN
;
;SUBS(X)
; 1 = FILE
; 2 = DA(1)
; 3 = TMP
; 4 = DA
;
S MTXT="o New Synonyms:" D BMES^XPDUTL(MTXT),SETTXT(MTXT)
;
I '$D(^XTMP("PSSP254B","DU-SYN-A")) D Q
. S MTXT="No updates needed"
. D MES^XPDUTL(MTXT),SETTXT(MTXT)
;
S SUBS(1)="" F S SUBS(1)=$O(^XTMP("PSSP254B","DU-SYN-A",SUBS(1))) Q:SUBS(1)="" D
. S SUBS(2)="" F S SUBS(2)=$O(^XTMP("PSSP254B","DU-SYN-A",SUBS(1),SUBS(2))) Q:SUBS(2)="" D
. . S SUBS(3)="" F S SUBS(3)=$O(^XTMP("PSSP254B","DU-SYN-A",SUBS(1),SUBS(2),SUBS(3))) Q:SUBS(3)="" D
. . . S SUBS(4)="" F S SUBS(4)=$O(^XTMP("PSSP254B","DU-SYN-A",SUBS(1),SUBS(2),SUBS(3),SUBS(4))) Q:SUBS(4)="" D
. . . . S DA=SUBS(4),DA(1)=SUBS(2)
. . . . S SYN=^XTMP("PSSP254B","DU-SYN-A",SUBS(1),DA(1),SUBS(3),DA)
. . . . S ENTRY=$$GET1^DIQ(51.24,DA(1),.01)
. . . . ;
. . . . ;No update needed
. . . . I $$GET1^DIQ(51.242,DA_","_DA(1),.01)'=SYN D Q
. . . . . S MTXT=" - Entry '"_ENTRY_"': '"_SYN_"' no updated needed"
. . . . . D MES^XPDUTL(MTXT),SETTXT(MTXT)
. . . . ;
. . . . ;Update
. . . . S MTXT=" - Entry '"_ENTRY_"': '"_SYN_"' removed"
. . . . S DIE="^PS(51.24,"_DA(1)_",1,",DR=".01////@" D ^DIE
. . . . D MES^XPDUTL(MTXT),SETTXT(MTXT)
;
Q
;
DEL24 ; delete entries from file #51.24
N CTR,DA,DATA,DIC,DIE,ENTRY,SUB,X,XUMF
S XUMF=1
;
S MTXT="o Deleted entries:" D BMES^XPDUTL(MTXT),SETTXT(MTXT)
;
I '$D(^XTMP("PSSP254B","DU-D")) D Q
. S MTXT="No updates needed"
. D MES^XPDUTL(MTXT),SETTXT(MTXT)
;
S SUB(1)="" F S SUB(1)=$O(^XTMP("PSSP254B","DU-D",51.24,SUB(1))) Q:SUB(1)="" D
. S DA=SUB(1)
. S DA(1)=DA
. S DATA=$G(^XTMP("PSSP254B","DU-D",51.24,SUB(1),0))
. ;
. ;Verify it has not already been restored
. I +$$FIND1^DIC(51.24,"","B",$P(DATA,U)) D Q
. . S MTXT=" - Entry '"_$P(DATA,U)_"' no update needed."
. . D MES^XPDUTL(MTXT),SETTXT(MTXT)
. ;
. ;Main Fields
. S DR=".01////"_$P(DATA,U)
. I $P(DATA,U,2)'="" S DR=DR_";1////"_$P(DATA,U,2)
. I $P(DATA,U,3)'="" S DR=DR_";3////"_$P(DATA,U,3)
. S DIE=51.24
. D ^DIE
. ;
. ;Repeating Synonym field is Node 1
. S CTR=0 F S CTR=$O(^XTMP("PSSP254B","DU-D",51.24,SUB(1),1,CTR)) Q:CTR="" D
. . S X=$G(^XTMP("PSSP254B","DU-D",51.24,SUB(1),1,CTR,0))
. . S DIC="^PS(51.24,"_DA(1)_",1,"
. . S DIC(0)="L"
. . D FILE^DICN
. ;
. S MTXT=" - Entry '"_$P(DATA,U)_"' restored"
. D MES^XPDUTL(MTXT),SETTXT(MTXT)
Q
;
DUC ; update the DOSE UNIT 1 (#.01) of the DOSE UNIT CONVERSION file (#51.25)
N DA,DIE,DR,NAME,OLD,XUMF
;
S MTXT="o DOSE UNIT 1 updates:" D BMES^XPDUTL(MTXT),SETTXT(MTXT)
;
I '$D(^XTMP("PSSP254B","DUC-U")) D Q
. S MTXT="No updates needed"
. D MES^XPDUTL(MTXT),SETTXT(MTXT)
;
S DA="" F S DA=$O(^XTMP("PSSP254B","DUC-U",51.25,DA)) Q:DA="" D
. S OLD=$P(^XTMP("PSSP254B","DUC-U",51.25,DA,.01),U)
. S NAME=$$GET1^DIQ(51.25,DA,.01)
. ;
. I (OLD="")!(NAME=OLD) D Q
. . S MTXT=" - Entry #"_DA_" ("_NAME_"): no update needed"
. . D MES^XPDUTL(MTXT),SETTXT(MTXT)
. ;
. S MTXT=" - Entry #"_DA_": restored from '"_NAME_"' to '"_OLD_"'"
. S XUMF=1,DR=".01////"_OLD,DIE=51.25 D ^DIE
. D MES^XPDUTL(MTXT),SETTXT(MTXT)
Q
;
DEL25 ; delete entries from the DOSE UNIT CONVERSION file (#51.25)
N CTR,DA,DATA,DIC,DIE,DR,ENTRY,SUB,X,XUMF
S XUMF=1
;
S MTXT="o Deleted entries:" D BMES^XPDUTL(MTXT),SETTXT(MTXT)
;
I '$D(^XTMP("PSSP254B","DUC-D")) D Q
. S MTXT="No updates needed"
. D MES^XPDUTL(MTXT),SETTXT(MTXT)
;
S SUB(1)="" F S SUB(1)=$O(^XTMP("PSSP254B","DUC-D",51.25,SUB(1))) Q:SUB(1)="" D
. S DA=SUB(1)
. S DA(1)=DA
. S DATA=$G(^XTMP("PSSP254B","DUC-D",51.25,SUB(1),0))
. ;
. ;Verify it has not already been restored
. I +$$FIND1^DIC(51.25,"","B",$P(DATA,U)) D Q
. . S MTXT=" - Entry '"_$P(DATA,U)_"' no update needed."
. . D MES^XPDUTL(MTXT),SETTXT(MTXT)
. ;
. ;Main Fields
. S DR=".01////"_$P(DATA,U)
. S DIE=51.25
. D ^DIE
. ;
. ;Repeating Synonym field is Node 1
. S CTR=0 F S CTR=$O(^XTMP("PSSP254B","DUC-D",51.25,SUB(1),1,CTR)) Q:CTR="" D
. . S X=$G(^XTMP("PSSP254B","DUC-D",51.25,SUB(1),1,CTR,0))
. . S DIC="^PS(51.25,"_DA(1)_",1,"
. . S DIC(0)="L"
. . D FILE^DICN
. ;
. S MTXT=" - Entry '"_$P(DATA,U)_"' restored"
. D MES^XPDUTL(MTXT),SETTXT(MTXT)
Q
;
UNIT2 ; update the DOSE UNIT 2 field (#.01) and the CONVERSION FACTOR field (#1) entries in file (#51.25)
N CTR,CURCONV,CURRENT,DATA,DA,DIE,DR,NAME,SUB,XUMF
;
S MTXT="o DOSE UNIT 2 updates:" D BMES^XPDUTL(MTXT),SETTXT(MTXT)
;
I '$D(^XTMP("PSSP254B","DU2C-U")),'$D(^XTMP("PSSP254B","DU2C-D")) D Q
. S MTXT="No updates needed"
. D MES^XPDUTL(MTXT),SETTXT(MTXT)
;
S XUMF=1
;
;DU2C-U - Updates first - Verify that updates are really needed.
S SUB="" F S SUB=$O(^XTMP("PSSP254B","DU2C-U",51.251,SUB)) Q:SUB="" D
. S CTR="" F S CTR=$O(^XTMP("PSSP254B","DU2C-U",51.251,SUB,CTR)) Q:CTR="" D
. . S DATA=$G(^XTMP("PSSP254B","DU2C-U",51.251,SUB,CTR,0))
. . S DA(1)=SUB,DA=CTR
. . S NAME=$$GET1^DIQ(51.25,DA(1),.01)
. . S CURRENT=$$GET1^DIQ(51.251,DA_","_DA(1)_",",.01)
. . S CURCONV=$$GET1^DIQ(51.251,DA_","_DA(1)_",",1)
. . ;
. . ;Verify whether the Synonym or Conversion Factor need to be rolled back
. . I CURRENT=$P(DATA,U),CURCONV=$P(DATA,U,2) D Q
. . . S MTXT=" - Entry '"_NAME_"': no update needed for "_CURRENT
. . . D MES^XPDUTL(MTXT),SETTXT(MTXT)
. . ;
. . S DIE="^PS(51.25,"_DA(1)_",1,"
. . ;
. . I CURRENT'=$P(DATA,U) D
. . . S DR=".01////"_$P(DATA,U)
. . . I CURCONV'=$P(DATA,U,2) S DR=DR_";1////"_$P(DATA,U,2)
. . . S MTXT=" - Entry '"_NAME_"': restored '"_CURRENT_"' to '"_$P(DATA,U)_"'"
. . ;
. . I CURRENT=$P(DATA,U),CURCONV'=$P(DATA,U,2) D
. . . S DR="1////"_$P(DATA,U,2)
. . . S MTXT=" - Entry '"_NAME_"': restored '"_CURRENT_"'"
. . ;
. . D ^DIE
. . D MES^XPDUTL(MTXT),SETTXT(MTXT)
;
;DU2C-D - Deletions next
S SUB="" F S SUB=$O(^XTMP("PSSP254B","DU2C-D",51.251,SUB)) Q:SUB="" D
. S CTR="" F S CTR=$O(^XTMP("PSSP254B","DU2C-D",51.251,SUB,CTR)) Q:CTR="" D
. . S DATA=$G(^XTMP("PSSP254B","DU2C-D",51.251,SUB,CTR,0))
. . S DA(1)=SUB,DA=CTR
. . S NAME=$$GET1^DIQ(51.25,DA(1),.01)
. . ;
. . ;Verify whether this has already been restored
. . I $$FIND1^DIC(51.251,","_DA(1)_",","B",$P(DATA,U)) D Q
. . . S MTXT=" - Entry '"_NAME_"': no update needed for "_$P(DATA,U)
. . . D MES^XPDUTL(MTXT),SETTXT(MTXT)
. . ;
. . S DIE="^PS(51.25,"_DA(1)_",1,"
. . S DR=".01////"_$P(DATA,U)_";1////"_$P(DATA,U,2)
. . D ^DIE
. . ;
. . S MTXT=" - Entry '"_NAME_"': restored '"_$P(DATA,U)_"'"
. . D MES^XPDUTL(MTXT),SETTXT(MTXT)
Q
;
;Utilities copied from PSSP254
DISABLE(SRVNAME,PSSIEN) ; Disable PPSN server if it exists-will set it back to enabled
N PSSERVER,PSSERR
; Set STATUS to DISABLED
S PSSERVER(18.12,PSSIEN,.06)=0
D FILE^DIE("","PSSERVER","PSSERR") ; update existing entry
D BMES^XPDUTL("o WEB SERVER '"_SRVNAME_"' server temporarily disabled.")
Q
;
SETTXT(TXT) ; Setting Plain Text
S PSSLINE=$G(PSSLINE)+1,^TMP("PSS254P",$J,PSSLINE)=TXT
Q
;
MAIL ; Sends Mailman message
N II,XMX,XMSUB,XMDUZ,XMTEXT,XMY,DIFROM
;
D BMES^XPDUTL("Sending Mailman Message with updates...")
;
S II=0 F S II=$O(^XUSEC("PSNMGR",II)) Q:'II S XMY(II)=""
S XMY(DUZ)="",XMSUB="PSS*1*254 FDB v4.5 Upgrade Uninstall"
S XMDUZ="PSS*1*254 Uninstall",XMTEXT="^TMP(""PSS254P"",$J,"
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSP254U 16110 printed Aug 26, 2025@22:49:13 Page 2
PSSP254U ;CAN/EJD - PSS*1*254 Uninstall ; Nov 02, 2022@16:00
+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 ;Patterned after PSSP254@POST
BACKOUT ;Perform the backout
+1 NEW PSSLINE,MTXT
+2 ;
+3 ;Verify there is backup data
+4 IF '$DATA(^XTMP("PSSP254B"))
WRITE !!,"No data to rollback. Nothing Done."
QUIT
+5 ;
+6 ;Prompt the user "Are you sure you want to do this" before continuing
+7 IF '$$GONOGO()
QUIT
+8 ;
+9 ;This TEMP global will be used for the Mailman Message
+10 KILL ^TMP("PSS254P",$JOB)
+11 ;
+12 IF $GET(U)=""
SET U="^"
+13 ;
+14 ;Updates to the PPSN & FDB WebServices
+15 DO WS
+16 ;
+17 ;Updates to DOSE UNITS (#51.24) and DOSE UNIT CONVERSION (#51.25) files
+18 ;New units were added late. To facilitate component testing, handled in a separate call.
+19 DO ST
+20 DO NEWUNIT^PSSP254V
+21 ;
+22 ;Updates to STANDARD MEDICATION ROUTES (#51.23) file
+23 ;New routes were added late. To facilitate component testing, handled in a separate call.
+24 DO MR
+25 DO NEWROUTE^PSSP254V
+26 ;
+27 ;Updates to the DOSING CHECK FREQUENCY field for the files #51 and #51.1
+28 DO DCF
+29 ;
+30 ;Sends Mailman Message to Installer and PSNMGR key holders listing updates
+31 DO MAIL
+32 ;
+33 ;Backup the rollback log
+34 DO SAVELOG
+35 ;
+36 KILL ^TMP("PSS254P",$JOB)
+37 QUIT
+38 ;
+39 ;Prompt the user Are you sure before continuing
+40 ;Y: 0 = No // 1 = Yes
GONOGO() ;Safety Check
+1 NEW DIR,X,Y
+2 ;
+3 SET DIR(0)="Y"
+4 SET DIR("A")="Are you sure you want to do this"
+5 ;Default to No
SET DIR("B")="No"
+6 DO ^DIR
+7 ;
+8 IF Y'=1
WRITE !!,"Nothing Done"
QUIT 0
+9 QUIT 1
+10 ;
+11 ;Save and wipe the original rollback log
SAVELOG ;Save
+1 ;Wipe to ensure this is clear
KILL ^XTMP("PSSP254U")
+2 ;Save post patch rollback code for the indice rebuild
DO SETUP^PSSP254V
+3 ;Save the original rollback log
MERGE ^XTMP("PSSP254U")=^XTMP("PSSP254B")
+4 ;Wipe the original rollback log
KILL ^XTMP("PSSP254B")
+5 QUIT
+6 ;
DCF ;File 51 and 51.1 Dosing Check Frequency
+1 NEW FILE,FIELD,MEDSCH,OLDFREQ,NEWFREQ,XX,LINE,DIE,DR,DA,X,Y,FREQCHK,DRGCTR,DRGFILE,DRGNODE,TMPMSG
+2 ;
+3 DO SETTXT("")
+4 SET MTXT="DOSING CHECK FREQUENCY field Conversion:"
+5 DO BMES^XPDUTL(MTXT)
DO SETTXT(MTXT)
+6 DO SETTXT("========================================")
+7 ;
+8 IF '$DATA(^XTMP("PSSP254B","DCF"))
Begin DoDot:1
+9 SET MTXT="No updates needed"
+10 DO MES^XPDUTL(MTXT)
DO SETTXT(MTXT)
End DoDot:1
+11 IF '$TEST
Begin DoDot:1
+12 SET FILE=""
FOR
SET FILE=$ORDER(^XTMP("PSSP254B","DCF",FILE))
if 'FILE
QUIT
Begin DoDot:2
+13 SET MTXT="o File: "_$SELECT(FILE=51:"MEDICATION INSTRUCTION (#51)",1:"ADMINISTRATION SCHEDULE (#51.1)")
+14 DO MES^XPDUTL(MTXT)
DO SETTXT(MTXT)
+15 SET MEDSCH=""
FOR
SET MEDSCH=$ORDER(^XTMP("PSSP254B","DCF",FILE,MEDSCH))
if MEDSCH=""
QUIT
Begin DoDot:3
+16 SET FIELD=""
FOR
SET FIELD=$ORDER(^XTMP("PSSP254B","DCF",FILE,MEDSCH,FIELD))
if FIELD=""
QUIT
Begin DoDot:4
+17 SET XX=$GET(^XTMP("PSSP254B","DCF",FILE,MEDSCH,FIELD))
+18 SET NEWFREQ=$PIECE(XX,U,2)
+19 SET OLDFREQ=$PIECE(XX,U)
+20 ;
+21 SET MTXT=" - "_$$GET1^DIQ(FILE,MEDSCH,.01)_" ("_$$GET1^DIQ(FILE,MEDSCH,$SELECT(FILE=51:1,1:8))
+22 ;
+23 ;Already restored
+24 IF OLDFREQ=$$GET1^DIQ(FILE,MEDSCH,$SELECT(FILE=51:32,1:11))
Begin DoDot:5
+25 SET MTXT=MTXT_") - no update needed"
+26 DO MES^XPDUTL(MTXT)
DO SETTXT(MTXT)
End DoDot:5
QUIT
+27 ;
+28 ;If it was deleted, restore drugs too
+29 IF NEWFREQ="@"
Begin DoDot:5
+30 KILL DIE,DR
SET DIE=FILE
SET DR=FIELD_"////"_OLDFREQ
SET DA=MEDSCH
DO ^DIE
+31 SET MTXT=MTXT_") - '"_OLDFREQ_"' restored."
+32 DO MES^XPDUTL(MTXT)
DO SETTXT(MTXT)
+33 IF $DATA(^XTMP("PSSP254B","DCFDRUG",FILE,MEDSCH,FIELD))
DO DCFDRG(FILE,MEDSCH,FIELD)
End DoDot:5
+34 IF '$TEST
Begin DoDot:5
+35 KILL DIE,DR
SET DIE=FILE
SET DR=FIELD_"////"_OLDFREQ
SET DA=MEDSCH
DO ^DIE
+36 SET MTXT=MTXT_") - Restored from '"_NEWFREQ_"' to '"_OLDFREQ_"'"
+37 DO MES^XPDUTL(MTXT)
DO SETTXT(MTXT)
End DoDot:5
End DoDot:4
End DoDot:3
+38 DO SETTXT("")
End DoDot:2
End DoDot:1
+39 QUIT
+40 ;
+41 ;FILE is 51 (Medication Instruction) or 51.1 (Administration Schedule)
+42 ;MEDSCH is the DA for the FILE entry
+43 ;FIELD is the Dosing Check Frequency field in FILE
DCFDRG(FILE,MEDSCH,FIELD) ;Restore impacted drugs
+1 NEW DA,DIC,DRGCTR,DRGFILE,DRGLIST,DRGNAME,X
+2 ;
+3 SET DRGFILE=$SELECT(FILE=51:51.321,1:51.111)
+4 SET DRGNODE=$SELECT(FILE=51:5,1:4)
+5 ;
+6 SET DRGCTR=""
+7 FOR
SET DRGCTR=$ORDER(^XTMP("PSSP254B","DCFDRUG",FILE,MEDSCH,FIELD,DRGCTR))
if DRGCTR=""
QUIT
Begin DoDot:1
+8 SET X=$PIECE(^XTMP("PSSP254B","DCFDRUG",FILE,MEDSCH,FIELD,DRGCTR),U)
+9 SET DRGNAME=$PIECE(^XTMP("PSSP254B","DCFDRUG",FILE,MEDSCH,FIELD,DRGCTR),U,2)
+10 SET DA(1)=MEDSCH
+11 SET DIC="^PS("_FILE_","_DA(1)_","_DRGNODE_","
+12 SET DIC(0)="L"
+13 DO FILE^DICN
+14 ;
+15 ;Setup for alphabetical display
IF DRGNAME'=""
SET DRGLIST(DRGNAME)=""
End DoDot:1
+16 ;
+17 IF $DATA(DRGLIST)
Begin DoDot:1
+18 SET MTXT=" Restored Drugs"
+19 DO MES^XPDUTL(MTXT)
DO SETTXT(MTXT)
+20 SET DRGNAME=""
FOR
SET DRGNAME=$ORDER(DRGLIST(DRGNAME))
if DRGNAME=""
QUIT
Begin DoDot:2
+21 SET MTXT=" "_DRGNAME
+22 DO MES^XPDUTL(MTXT)
DO SETTXT(MTXT)
End DoDot:2
End DoDot:1
+23 QUIT
+24 ;
WS ; Web Service updates
+1 NEW FDA,PORT,PSSERR,PSSIEN,PSSIENC,SERVER,SRVNAME
+2 ;
+3 ;If webservices were not impacted, leave
+4
*** ERROR ***
IF '$Data(^XTMP("PSSP254B","WS"))
DO MES^XPDUTL("No Web Services update needed")
QUIT
+5 ;
+6 DO MES^XPDUTL("Restoring the Web Services:")
+7 SET PSSIEN=""
+8 FOR
SET PSSIEN=$ORDER(^XTMP("PSSP254B","WS",18.12,PSSIEN))
if PSSIEN=""
QUIT
Begin DoDot:1
+9 KILL FDA
+10 ;
+11 SET SRVNAME=$PIECE($GET(^XTMP("PSSP254B","WS",18.12,PSSIEN,0)),U,1)
+12 SET SERVER=$PIECE($GET(^XTMP("PSSP254B","WS",18.12,PSSIEN,0)),U,4)
+13 SET PORT=$PIECE($GET(^XTMP("PSSP254B","WS",18.12,PSSIEN,0)),U,3)
+14 ;
+15 ;Verify current loadout
+16 IF SERVER=$$GET1^DIQ(18.12,PSSIEN,.04)
IF PORT=$$GET1^DIQ(18.12,PSSIEN,.03)
Begin DoDot:2
+17 SET MTXT="o WEB SERVER '"_SRVNAME_"' no update needed"
+18 DO MES^XPDUTL(MTXT)
DO SETTXT(MTXT)
End DoDot:2
QUIT
+19 ;
+20 SET PSSIENC=PSSIEN_","
DO DISABLE(SRVNAME,PSSIENC)
+21 SET FDA(18.12,PSSIENC,.04)=SERVER
+22 SET FDA(18.12,PSSIENC,.03)=PORT
+23 ; status
SET FDA(18.12,PSSIENC,.06)=1
+24 DO FILE^DIE("K","FDA","PSSERR")
+25 IF '$DATA(PSSERR("DIERR",1,"TEXT",1))
SET MTXT="o WEB SERVER '"_SRVNAME_"' updated successfully"
+26 IF $DATA(PSSERR("DIERR",1,"TEXT",1))
SET MTXT="o WEB SERVER '"_SRVNAME_"' Error: "_PSSERR("DIERR",1,"TEXT",1)
+27 DO MES^XPDUTL(MTXT)
DO SETTXT(MTXT)
End DoDot:1
+28 QUIT
+29 ;
MR ; STANDARD MEDICATION ROUTES (#51.23) file updates
+1 NEW DA,DIE,DR,FROM,NAME,OLD
+2 ;
+3 DO SETTXT("")
+4 SET MTXT="STANDARD MEDICATION ROUTES file (#51.23) Updates:"
+5 DO BMES^XPDUTL(MTXT)
DO SETTXT(MTXT)
+6 DO SETTXT("=================================================")
+7 ;
+8 ;If file was not impacted, leave
+9 IF '$DATA(^XTMP("PSSP254B","SMR-U"))
Begin DoDot:1
+10 SET MTXT="No updates needed"
+11 DO MES^XPDUTL(MTXT)
DO SETTXT(MTXT)
End DoDot:1
QUIT
+12 ;
+13 ;Loop through ^XTMP("PSSP254B","SMR-U",51.23,DA - roll back to $P(1)
+14 SET DA=""
FOR
SET DA=$ORDER(^XTMP("PSSP254B","SMR-U",51.23,DA))
if DA=""
QUIT
Begin DoDot:1
+15 SET OLD=$PIECE(^XTMP("PSSP254B","SMR-U",51.23,DA,1),U)
+16 SET NAME=$$GET1^DIQ(51.23,DA,.01)
+17 ;
+18 ;Verify whether update is needed
+19 IF OLD=$$GET1^DIQ(51.23,DA,1)
Begin DoDot:2
+20 SET MTXT=" - '"_NAME_"' no update needed"
+21 DO MES^XPDUTL(MTXT)
DO SETTXT(MTXT)
End DoDot:2
QUIT
+22 ;
+23 SET MTXT=" - Restored "_NAME_" from '"_$$GET1^DIQ(51.23,DA,1)_"' to '"_OLD_"'"
+24 IF OLD=""
SET OLD="@"
+25 SET DIE="^PS(51.23,"
SET DR="1////"_OLD
DO ^DIE
+26 DO MES^XPDUTL(MTXT)
DO SETTXT(MTXT)
End DoDot:1
+27 QUIT
+28 ;
ST ; Update entries in DOSE UNITS file (#51.24) and DOSE UNIT CONVERSION file (#51.25)
+1 NEW II,JJ,PSA,PSI,PSJ,PSL,PSLIST,PSX,SYM,TXT,X
+2 ;
+3 SET TXT="DOSE UNITS file (#51.24) Updates"
+4 DO BMES^XPDUTL(TXT)
+5 DO SETTXT("")
+6 DO SETTXT(TXT)
+7 DO SETTXT("===================================================================")
+8 ;
+9 ;File 51.24 - FDB Dose Unit
+10 DO FDB
+11 ;
+12 DO SETTXT("")
+13 ;
+14 ;File 51.24 - Synonyms
+15 DO SYN
+16 ;
+17 DO SETTXT("")
+18 ;
+19 ;File 51.24 - Deleted Entries
+20 DO DEL24
+21 ;
+22 DO SETTXT("")
+23 ;
+24 SET TXT="DOSE UNIT CONVERSION file (#51.25) Updates"
+25 DO BMES^XPDUTL(TXT)
+26 DO SETTXT("")
+27 DO SETTXT(TXT)
+28 DO SETTXT("===================================================================")
+29 ;
+30 ;File 51.25 - Dose Unit 1
+31 DO DUC
+32 ;
+33 DO SETTXT("")
+34 ;
+35 ;File 51.25 - Deleted Entries
+36 DO DEL25
+37 ;
+38 DO SETTXT("")
+39 ;
+40 ;File 51.25 - Dose Unit 2
+41 DO UNIT2
+42 ;
+43 KILL DIE,DR,DA,XUMF
+44 QUIT
+45 ;
FDB ; 1st DataBank Dose Unit Updates
+1 NEW DA,DIE,DR,NAME,OLD,XUMF
+2 ;
+3 SET MTXT="o FDB DOSE UNIT updates:"
DO BMES^XPDUTL(MTXT)
DO SETTXT(MTXT)
+4 ;
+5 IF '$DATA(^XTMP("PSSP254B","DU-U",51.24))
Begin DoDot:1
+6 SET MTXT="No updates needed"
+7 DO MES^XPDUTL(MTXT)
DO SETTXT(MTXT)
End DoDot:1
QUIT
+8 ;
+9 SET DA=""
FOR
SET DA=$ORDER(^XTMP("PSSP254B","DU-U",51.24,DA))
if DA=""
QUIT
Begin DoDot:1
+10 SET NAME=$PIECE(^XTMP("PSSP254B","DU-U",51.24,DA,1),U)
+11 SET OLD=$PIECE(^XTMP("PSSP254B","DU-U",51.24,DA,1),U,2)
+12 ;
+13 IF $$GET1^DIQ(51.24,DA,1)=OLD
Begin DoDot:2
+14 SET MTXT=" - Entry #"_DA_" ("_NAME_"): no update needed"
+15 DO MES^XPDUTL(MTXT)
DO SETTXT(MTXT)
End DoDot:2
QUIT
+16 ;
+17 SET MTXT=" - Entry #"_DA_" ("_NAME_"): restored from '"_$$GET1^DIQ(51.24,DA,1)_"' to '"_OLD_"'"
+18 IF OLD=""
SET OLD="@"
+19 SET XUMF=1
SET DR="1////"_OLD
SET DIE=51.24
DO ^DIE
+20 DO MES^XPDUTL(MTXT)
DO SETTXT(MTXT)
End DoDot:1
+21 QUIT
+22 ;
SYN ; SYNONYM updates
+1 NEW DA,DIE,DR,ENTRY,SFILE,SUBS,SYN
+2 ;
+3 ;SUBS(X)
+4 ; 1 = FILE
+5 ; 2 = DA(1)
+6 ; 3 = TMP
+7 ; 4 = DA
+8 ;
+9 SET MTXT="o New Synonyms:"
DO BMES^XPDUTL(MTXT)
DO SETTXT(MTXT)
+10 ;
+11 IF '$DATA(^XTMP("PSSP254B","DU-SYN-A"))
Begin DoDot:1
+12 SET MTXT="No updates needed"
+13 DO MES^XPDUTL(MTXT)
DO SETTXT(MTXT)
End DoDot:1
QUIT
+14 ;
+15 SET SUBS(1)=""
FOR
SET SUBS(1)=$ORDER(^XTMP("PSSP254B","DU-SYN-A",SUBS(1)))
if SUBS(1)=""
QUIT
Begin DoDot:1
+16 SET SUBS(2)=""
FOR
SET SUBS(2)=$ORDER(^XTMP("PSSP254B","DU-SYN-A",SUBS(1),SUBS(2)))
if SUBS(2)=""
QUIT
Begin DoDot:2
+17 SET SUBS(3)=""
FOR
SET SUBS(3)=$ORDER(^XTMP("PSSP254B","DU-SYN-A",SUBS(1),SUBS(2),SUBS(3)))
if SUBS(3)=""
QUIT
Begin DoDot:3
+18 SET SUBS(4)=""
FOR
SET SUBS(4)=$ORDER(^XTMP("PSSP254B","DU-SYN-A",SUBS(1),SUBS(2),SUBS(3),SUBS(4)))
if SUBS(4)=""
QUIT
Begin DoDot:4
+19 SET DA=SUBS(4)
SET DA(1)=SUBS(2)
+20 SET SYN=^XTMP("PSSP254B","DU-SYN-A",SUBS(1),DA(1),SUBS(3),DA)
+21 SET ENTRY=$$GET1^DIQ(51.24,DA(1),.01)
+22 ;
+23 ;No update needed
+24 IF $$GET1^DIQ(51.242,DA_","_DA(1),.01)'=SYN
Begin DoDot:5
+25 SET MTXT=" - Entry '"_ENTRY_"': '"_SYN_"' no updated needed"
+26 DO MES^XPDUTL(MTXT)
DO SETTXT(MTXT)
End DoDot:5
QUIT
+27 ;
+28 ;Update
+29 SET MTXT=" - Entry '"_ENTRY_"': '"_SYN_"' removed"
+30 SET DIE="^PS(51.24,"_DA(1)_",1,"
SET DR=".01////@"
DO ^DIE
+31 DO MES^XPDUTL(MTXT)
DO SETTXT(MTXT)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+32 ;
+33 QUIT
+34 ;
DEL24 ; delete entries from file #51.24
+1 NEW CTR,DA,DATA,DIC,DIE,ENTRY,SUB,X,XUMF
+2 SET XUMF=1
+3 ;
+4 SET MTXT="o Deleted entries:"
DO BMES^XPDUTL(MTXT)
DO SETTXT(MTXT)
+5 ;
+6 IF '$DATA(^XTMP("PSSP254B","DU-D"))
Begin DoDot:1
+7 SET MTXT="No updates needed"
+8 DO MES^XPDUTL(MTXT)
DO SETTXT(MTXT)
End DoDot:1
QUIT
+9 ;
+10 SET SUB(1)=""
FOR
SET SUB(1)=$ORDER(^XTMP("PSSP254B","DU-D",51.24,SUB(1)))
if SUB(1)=""
QUIT
Begin DoDot:1
+11 SET DA=SUB(1)
+12 SET DA(1)=DA
+13 SET DATA=$GET(^XTMP("PSSP254B","DU-D",51.24,SUB(1),0))
+14 ;
+15 ;Verify it has not already been restored
+16 IF +$$FIND1^DIC(51.24,"","B",$PIECE(DATA,U))
Begin DoDot:2
+17 SET MTXT=" - Entry '"_$PIECE(DATA,U)_"' no update needed."
+18 DO MES^XPDUTL(MTXT)
DO SETTXT(MTXT)
End DoDot:2
QUIT
+19 ;
+20 ;Main Fields
+21 SET DR=".01////"_$PIECE(DATA,U)
+22 IF $PIECE(DATA,U,2)'=""
SET DR=DR_";1////"_$PIECE(DATA,U,2)
+23 IF $PIECE(DATA,U,3)'=""
SET DR=DR_";3////"_$PIECE(DATA,U,3)
+24 SET DIE=51.24
+25 DO ^DIE
+26 ;
+27 ;Repeating Synonym field is Node 1
+28 SET CTR=0
FOR
SET CTR=$ORDER(^XTMP("PSSP254B","DU-D",51.24,SUB(1),1,CTR))
if CTR=""
QUIT
Begin DoDot:2
+29 SET X=$GET(^XTMP("PSSP254B","DU-D",51.24,SUB(1),1,CTR,0))
+30 SET DIC="^PS(51.24,"_DA(1)_",1,"
+31 SET DIC(0)="L"
+32 DO FILE^DICN
End DoDot:2
+33 ;
+34 SET MTXT=" - Entry '"_$PIECE(DATA,U)_"' restored"
+35 DO MES^XPDUTL(MTXT)
DO SETTXT(MTXT)
End DoDot:1
+36 QUIT
+37 ;
DUC ; update the DOSE UNIT 1 (#.01) of the DOSE UNIT CONVERSION file (#51.25)
+1 NEW DA,DIE,DR,NAME,OLD,XUMF
+2 ;
+3 SET MTXT="o DOSE UNIT 1 updates:"
DO BMES^XPDUTL(MTXT)
DO SETTXT(MTXT)
+4 ;
+5 IF '$DATA(^XTMP("PSSP254B","DUC-U"))
Begin DoDot:1
+6 SET MTXT="No updates needed"
+7 DO MES^XPDUTL(MTXT)
DO SETTXT(MTXT)
End DoDot:1
QUIT
+8 ;
+9 SET DA=""
FOR
SET DA=$ORDER(^XTMP("PSSP254B","DUC-U",51.25,DA))
if DA=""
QUIT
Begin DoDot:1
+10 SET OLD=$PIECE(^XTMP("PSSP254B","DUC-U",51.25,DA,.01),U)
+11 SET NAME=$$GET1^DIQ(51.25,DA,.01)
+12 ;
+13 IF (OLD="")!(NAME=OLD)
Begin DoDot:2
+14 SET MTXT=" - Entry #"_DA_" ("_NAME_"): no update needed"
+15 DO MES^XPDUTL(MTXT)
DO SETTXT(MTXT)
End DoDot:2
QUIT
+16 ;
+17 SET MTXT=" - Entry #"_DA_": restored from '"_NAME_"' to '"_OLD_"'"
+18 SET XUMF=1
SET DR=".01////"_OLD
SET DIE=51.25
DO ^DIE
+19 DO MES^XPDUTL(MTXT)
DO SETTXT(MTXT)
End DoDot:1
+20 QUIT
+21 ;
DEL25 ; delete entries from the DOSE UNIT CONVERSION file (#51.25)
+1 NEW CTR,DA,DATA,DIC,DIE,DR,ENTRY,SUB,X,XUMF
+2 SET XUMF=1
+3 ;
+4 SET MTXT="o Deleted entries:"
DO BMES^XPDUTL(MTXT)
DO SETTXT(MTXT)
+5 ;
+6 IF '$DATA(^XTMP("PSSP254B","DUC-D"))
Begin DoDot:1
+7 SET MTXT="No updates needed"
+8 DO MES^XPDUTL(MTXT)
DO SETTXT(MTXT)
End DoDot:1
QUIT
+9 ;
+10 SET SUB(1)=""
FOR
SET SUB(1)=$ORDER(^XTMP("PSSP254B","DUC-D",51.25,SUB(1)))
if SUB(1)=""
QUIT
Begin DoDot:1
+11 SET DA=SUB(1)
+12 SET DA(1)=DA
+13 SET DATA=$GET(^XTMP("PSSP254B","DUC-D",51.25,SUB(1),0))
+14 ;
+15 ;Verify it has not already been restored
+16 IF +$$FIND1^DIC(51.25,"","B",$PIECE(DATA,U))
Begin DoDot:2
+17 SET MTXT=" - Entry '"_$PIECE(DATA,U)_"' no update needed."
+18 DO MES^XPDUTL(MTXT)
DO SETTXT(MTXT)
End DoDot:2
QUIT
+19 ;
+20 ;Main Fields
+21 SET DR=".01////"_$PIECE(DATA,U)
+22 SET DIE=51.25
+23 DO ^DIE
+24 ;
+25 ;Repeating Synonym field is Node 1
+26 SET CTR=0
FOR
SET CTR=$ORDER(^XTMP("PSSP254B","DUC-D",51.25,SUB(1),1,CTR))
if CTR=""
QUIT
Begin DoDot:2
+27 SET X=$GET(^XTMP("PSSP254B","DUC-D",51.25,SUB(1),1,CTR,0))
+28 SET DIC="^PS(51.25,"_DA(1)_",1,"
+29 SET DIC(0)="L"
+30 DO FILE^DICN
End DoDot:2
+31 ;
+32 SET MTXT=" - Entry '"_$PIECE(DATA,U)_"' restored"
+33 DO MES^XPDUTL(MTXT)
DO SETTXT(MTXT)
End DoDot:1
+34 QUIT
+35 ;
UNIT2 ; update the DOSE UNIT 2 field (#.01) and the CONVERSION FACTOR field (#1) entries in file (#51.25)
+1 NEW CTR,CURCONV,CURRENT,DATA,DA,DIE,DR,NAME,SUB,XUMF
+2 ;
+3 SET MTXT="o DOSE UNIT 2 updates:"
DO BMES^XPDUTL(MTXT)
DO SETTXT(MTXT)
+4 ;
+5 IF '$DATA(^XTMP("PSSP254B","DU2C-U"))
IF '$DATA(^XTMP("PSSP254B","DU2C-D"))
Begin DoDot:1
+6 SET MTXT="No updates needed"
+7 DO MES^XPDUTL(MTXT)
DO SETTXT(MTXT)
End DoDot:1
QUIT
+8 ;
+9 SET XUMF=1
+10 ;
+11 ;DU2C-U - Updates first - Verify that updates are really needed.
+12 SET SUB=""
FOR
SET SUB=$ORDER(^XTMP("PSSP254B","DU2C-U",51.251,SUB))
if SUB=""
QUIT
Begin DoDot:1
+13 SET CTR=""
FOR
SET CTR=$ORDER(^XTMP("PSSP254B","DU2C-U",51.251,SUB,CTR))
if CTR=""
QUIT
Begin DoDot:2
+14 SET DATA=$GET(^XTMP("PSSP254B","DU2C-U",51.251,SUB,CTR,0))
+15 SET DA(1)=SUB
SET DA=CTR
+16 SET NAME=$$GET1^DIQ(51.25,DA(1),.01)
+17 SET CURRENT=$$GET1^DIQ(51.251,DA_","_DA(1)_",",.01)
+18 SET CURCONV=$$GET1^DIQ(51.251,DA_","_DA(1)_",",1)
+19 ;
+20 ;Verify whether the Synonym or Conversion Factor need to be rolled back
+21 IF CURRENT=$PIECE(DATA,U)
IF CURCONV=$PIECE(DATA,U,2)
Begin DoDot:3
+22 SET MTXT=" - Entry '"_NAME_"': no update needed for "_CURRENT
+23 DO MES^XPDUTL(MTXT)
DO SETTXT(MTXT)
End DoDot:3
QUIT
+24 ;
+25 SET DIE="^PS(51.25,"_DA(1)_",1,"
+26 ;
+27 IF CURRENT'=$PIECE(DATA,U)
Begin DoDot:3
+28 SET DR=".01////"_$PIECE(DATA,U)
+29 IF CURCONV'=$PIECE(DATA,U,2)
SET DR=DR_";1////"_$PIECE(DATA,U,2)
+30 SET MTXT=" - Entry '"_NAME_"': restored '"_CURRENT_"' to '"_$PIECE(DATA,U)_"'"
End DoDot:3
+31 ;
+32 IF CURRENT=$PIECE(DATA,U)
IF CURCONV'=$PIECE(DATA,U,2)
Begin DoDot:3
+33 SET DR="1////"_$PIECE(DATA,U,2)
+34 SET MTXT=" - Entry '"_NAME_"': restored '"_CURRENT_"'"
End DoDot:3
+35 ;
+36 DO ^DIE
+37 DO MES^XPDUTL(MTXT)
DO SETTXT(MTXT)
End DoDot:2
End DoDot:1
+38 ;
+39 ;DU2C-D - Deletions next
+40 SET SUB=""
FOR
SET SUB=$ORDER(^XTMP("PSSP254B","DU2C-D",51.251,SUB))
if SUB=""
QUIT
Begin DoDot:1
+41 SET CTR=""
FOR
SET CTR=$ORDER(^XTMP("PSSP254B","DU2C-D",51.251,SUB,CTR))
if CTR=""
QUIT
Begin DoDot:2
+42 SET DATA=$GET(^XTMP("PSSP254B","DU2C-D",51.251,SUB,CTR,0))
+43 SET DA(1)=SUB
SET DA=CTR
+44 SET NAME=$$GET1^DIQ(51.25,DA(1),.01)
+45 ;
+46 ;Verify whether this has already been restored
+47 IF $$FIND1^DIC(51.251,","_DA(1)_",","B",$PIECE(DATA,U))
Begin DoDot:3
+48 SET MTXT=" - Entry '"_NAME_"': no update needed for "_$PIECE(DATA,U)
+49 DO MES^XPDUTL(MTXT)
DO SETTXT(MTXT)
End DoDot:3
QUIT
+50 ;
+51 SET DIE="^PS(51.25,"_DA(1)_",1,"
+52 SET DR=".01////"_$PIECE(DATA,U)_";1////"_$PIECE(DATA,U,2)
+53 DO ^DIE
+54 ;
+55 SET MTXT=" - Entry '"_NAME_"': restored '"_$PIECE(DATA,U)_"'"
+56 DO MES^XPDUTL(MTXT)
DO SETTXT(MTXT)
End DoDot:2
End DoDot:1
+57 QUIT
+58 ;
+59 ;Utilities copied from PSSP254
DISABLE(SRVNAME,PSSIEN) ; Disable PPSN server if it exists-will set it back to enabled
+1 NEW PSSERVER,PSSERR
+2 ; Set STATUS to DISABLED
+3 SET PSSERVER(18.12,PSSIEN,.06)=0
+4 ; update existing entry
DO FILE^DIE("","PSSERVER","PSSERR")
+5 DO BMES^XPDUTL("o WEB SERVER '"_SRVNAME_"' server temporarily disabled.")
+6 QUIT
+7 ;
SETTXT(TXT) ; Setting Plain Text
+1 SET PSSLINE=$GET(PSSLINE)+1
SET ^TMP("PSS254P",$JOB,PSSLINE)=TXT
+2 QUIT
+3 ;
MAIL ; Sends Mailman message
+1 NEW II,XMX,XMSUB,XMDUZ,XMTEXT,XMY,DIFROM
+2 ;
+3 DO BMES^XPDUTL("Sending Mailman Message with updates...")
+4 ;
+5 SET II=0
FOR
SET II=$ORDER(^XUSEC("PSNMGR",II))
if 'II
QUIT
SET XMY(II)=""
+6 SET XMY(DUZ)=""
SET XMSUB="PSS*1*254 FDB v4.5 Upgrade Uninstall"
+7 SET XMDUZ="PSS*1*254 Uninstall"
SET XMTEXT="^TMP(""PSS254P"",$J,"
+8 DO ^XMD
+9 QUIT
