PSSP254A ;CAN/EJD - PATCH PSS*1*254 Pre/Post-Init Rtn ; Jun 29, 2024@16:00
;;1.0;PHARMACY DATA MANAGEMENT;**254**;9/30/97;Build 109
;
;
;
RTEUNIT ; Call to setup when the install has already been done
K ^TMP("PSS254P",$J)
;
;Headers are handled in NEWROUTE
D NEWROUTE
;
;Start header for this like ST
D BMES^XPDUTL("DOSE UNITS file (#51.24) and DOSE UNIT CONVERSION file (#51.25) Updates:")
D SETTXT^PSSP254("")
D SETTXT^PSSP254("DOSE UNITS (#51.24) and DOSE UNIT CONVERSION file (#51.25) Updates:")
D SETTXT^PSSP254("===================================================================")
D NEWUNITS
;
;Mailer
D MAIL^PSSP254
K ^TMP("PSS254P",$J)
Q
;
NEWROUTE ; Addition of new STANDARD MEDICATION ROUTES (51.23) available in 4.5
;PSLIST - 1 - Route Name
; 2 - FDB Name
;
N DA,DIC,EFFDT,MTXT,PSJ,PSLIST,X,XUMF,Y
S XUMF=1
S EFFDT=3240501.083001 ;May 01, 2024 at 0830
;
D SETTXT^PSSP254("")
S MTXT="STANDARD MEDICATION ROUTES file (#51.23) New Entries:"
D BMES^XPDUTL(MTXT),SETTXT^PSSP254(MTXT)
D SETTXT^PSSP254("=================================================")
;
F PSJ=1:1 S PSLIST=$P($T(LISTRTE+PSJ),";;",2) Q:PSLIST="" D
. K DA,DIC
. S DIC(0)="L"
. S X=$P(PSLIST,";")
. S DA=$$FIND1^DIC(51.23,"","B",X) Q:DA
. ;
. S DIC="^PS(51.23,",DIC("DR")="1///"_$P(PSLIST,";",2)
. D FILE^DICN
. ;
. ;If failed to add, log and get the next
. I Y<0 D Q
. . S MTXT=" - Failed to Add '"_X_"'"
. . D BMES^XPDUTL(MTXT),SETTXT^PSSP254(MTXT)
. ;
. ;Log Add
. S DA=+Y
. S ^XTMP("PSSP254B","NEWROUTE",51.23,DA)=X
. S MTXT=" - Added '"_$$GET1^DIQ(51.23,DA,1)_"'"
. D BMES^XPDUTL(MTXT),SETTXT^PSSP254(MTXT)
. ;
. ;Add Effdt
. K DIC
. S DIC(0)="L"
. S DA(1)=+Y
. S X=EFFDT
. S DIC="^PS(51.23,"_DA(1)_",""TERMSTATUS"","
. S DIC("DR")=".02///ACTIVE"
. D FILE^DICN
;
;Index Rebuilds
D SETTXT^PSSP254("")
S MTXT="MEDICATION ROUTES Index Rebuild:"
D BMES^XPDUTL(MTXT),SETTXT^PSSP254(MTXT)
;
RIDX N DIK
S MTXT=" - Medication Routes"
D BMES^XPDUTL(MTXT),SETTXT^PSSP254(MTXT)
S DIK="^PS(51.2,",DIK(1)=".01^FDBMRT" D ENALL^DIK K DIK ;Rebuild
;
S MTXT=" - Standard Medication Routes"
D BMES^XPDUTL(MTXT),SETTXT^PSSP254(MTXT)
S DIK="^PS(51.23,",DIK(1)="1^FDBMRT" D ENALL^DIK K DIK ;Rebuild
Q
;
NEWUNITS ; Addition of new DOSE UNITS (51.24) available in 4.5
;PSLIST - 1 - Unit Name and FDB Name
; 2 - Dose Form Indicator (Y/N)
; 3 - Synonyms
;
N DA,DIC,EFFDT,MTXT,PSI,PSJ,PSLIST,SYN,X,XUMF,Y
S XUMF=1
;
D SETTXT^PSSP254("")
S MTXT="o New DOSE UNITs:" D BMES^XPDUTL(MTXT),SETTXT^PSSP254(MTXT)
F PSJ=1:1 S PSLIST=$P($T(LISTUNIT+PSJ),";;",2) Q:PSLIST="" D
. K DA,DIC
. S DIC(0)="L"
. S X=$P(PSLIST,";")
. S DA=$$FIND1^DIC(51.24,"","B",X) Q:DA
. ;
. S DIC="^PS(51.24,",DIC("DR")="1///"_$P(PSLIST,";")_";3///"_$P(PSLIST,";",2)
. D FILE^DICN
. ;
. ;If failed to add, log and get the next
. I Y<0 D Q
. . S MTXT=" - Failed to Add '"_X_"'"
. . D BMES^XPDUTL(MTXT),SETTXT^PSSP254(MTXT)
. ;
. ;Log Add
. S DA=+Y
. S ^XTMP("PSSP254B","NEWUNIT",51.24,DA)=X
. S MTXT=" - Added '"_$$GET1^DIQ(51.24,DA,.01)_"'"
. D BMES^XPDUTL(MTXT),SETTXT^PSSP254(MTXT)
. ;
. ;Add Synonyms
. K DIC
. S DIC(0)="L"
. S DA(1)=+Y
. S DIC="^PS(51.24,"_DA(1)_",1,"
. S SYM=$P(PSLIST,";",3)
. F PSI=1:1 S X=$P(SYM,",",PSI) Q:X="" D FILE^DICN
;
;Index Rebuilds
D SETTXT^PSSP254("")
S MTXT="o Index Rebuild:"
D BMES^XPDUTL(MTXT),SETTXT^PSSP254(MTXT)
;
UIDX N DIK
S MTXT=" - DOSE UNITS"
D BMES^XPDUTL(MTXT),SETTXT^PSSP254(MTXT)
S DIK="^PS(51.24,",DIK(1)=".01^FDBNAME" D ENALL^DIK K DIK ;Rebuild
;
S DIK="^PS(51.24,",DIK(1)="1^FDBUNIT" D ENALL^DIK K DIK ;Rebuild
;
;Multiple - Loop through the entries and call the build
N DFN S DFN=0
F S DFN=$O(^PS(51.24,DFN)) Q:'DFN D
. S DA(1)=DFN,DIK="^PS(51.24,"_DA(1)_",1,",DIK(1)=".01^FDBSYN" D ENALL^DIK K DIK
Q
;
;Removed the following routes from the list
;;FEEDING TUBE;FEEDING TUBE
;;G-TUBE;G-TUBE
;;J-TUBE;J-TUBE
;;PERIPHERAL NERVE BLOCK;PERIPHERAL NERVE BLOCK
;;SUBCUTANEOUS (VIA WEARABLE INJECTOR);SUBCUTANEOUS (VIA WEARABLE INJECTOR)
LISTRTE ;New Routes 51.23
;;ADDUCTOR CANAL BLOCK;ADDUCTOR CANAL BLOCK
;;CERVICAL;CERVICAL
;;ECTOPIC GESTATIONAL SAC;ECTOPIC GESTATIONAL SAC
;;ENDOTRACHEAL;ENDOTRACHEAL
;;HAND BULB NEBULIZER;HAND BULB NEBULIZER
;;IMPLANT;IMPLANT
;;INFRACLAVICULAR;INFRACLAVICULAR
;;INSTILLATION;INSTILLATION
;;INTERSCALENE;INTERSCALENE
;;INTRACANALICULAR;INTRACANALICULAR
;;INTRACORONARY;INTRACORONARY
;;INTRALUMBAR;INTRALUMBAR
;;INTRALYMPHATIC;INTRALYMPHATIC
;;INTRAPERICARDIAL;INTRAPERICARDIAL
;;INTRAPROSTATIC;INTRAPROSTATIC
;;INTRA-PYELOCALYCEAL;INTRA-PYELOCALYCEAL
;;INTRASALIVARY GLAND;INTRASALIVARY GLAND
;;INTRA-SUBACROMIAL SPACE;INTRA-SUBACROMIAL SPACE
;;INTRA-UMBILICAL VEIN;INTRA-UMBILICAL VEIN
;;INTRAVENTRICULAR;INTRAVENTRICULAR
;;IPPB;IPPB
;;JUXTASCLERAL;JUXTASCLERAL
;;MISCELLANEOUS;MISCELLANEOUS
;;MUCOUS MEMBRANE;MUCOUS MEMBRANE
;;O2 AEROSOLIZATION;O2 AEROSOLIZATION
;;PERCUTANEOUS;PERCUTANEOUS
;;PERFUSION;PERFUSION
;;PERIARTICULAR;PERIARTICULAR
;;PERINEURAL INJECTION;PERINEURAL INJECTION
;;SUBLESIONAL;SUBLESIONAL
;;SUBRETINAL;SUBRETINAL
;;SUPRACHOROIDAL;SUPRACHOROIDAL
;;TENDON SHEATH INJ;TENDON SHEATH INJ.
;;TRANSTRACHEAL;TRANSTRACHEAL
;;TRANSURETHRAL;TRANSURETHRAL
;;
;;Unit Name;Y/N Dose Form Indicator;Synonyms
LISTUNIT ;New Units 51.24
;;AMPULE;Y;AMPULES,AMP,AMPS
;;BILLION CELLS;Y;
;;CELL;Y;CELLS
;;COLONY FORMING UNIT;Y;COLONY FORMING UNITS,CF UNIT
;;MELT;Y;MELTS
;;MICROGRAM DIETARY FOLATE EQUIVALENT;N;MICROGRAM DIETARY FOLATE EQUIVALENTS,MCG DFE
;;MILLICURIE;Y;MILLICURIES,MCI
;;MILLIGRAM FISH OIL;N;MILLIGRAMS FISH OIL,MG FISH OIL
;;MILLION CELLS;Y;MMU CELLS
;;MILLION PLAQUE FORMING UNITS;Y;MPF UNIT,MPF UNITS
;;MILLIUNIT;N;MILLIUNITS
;;PLAQUE FORMING UNIT;Y;PLAQUE FORMING UNITS,PF UNIT
;;TOWELETTE;Y;TOWELETTES,TOWEL,TOWELS
;;TUBE;Y;TUBES
;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSP254A 6105 printed Aug 26, 2025@22:49:11 Page 2
PSSP254A ;CAN/EJD - PATCH PSS*1*254 Pre/Post-Init Rtn ; Jun 29, 2024@16:00
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**254**;9/30/97;Build 109
+2 ;
+3 ;
+4 ;
RTEUNIT ; Call to setup when the install has already been done
+1 KILL ^TMP("PSS254P",$JOB)
+2 ;
+3 ;Headers are handled in NEWROUTE
+4 DO NEWROUTE
+5 ;
+6 ;Start header for this like ST
+7 DO BMES^XPDUTL("DOSE UNITS file (#51.24) and DOSE UNIT CONVERSION file (#51.25) Updates:")
+8 DO SETTXT^PSSP254("")
+9 DO SETTXT^PSSP254("DOSE UNITS (#51.24) and DOSE UNIT CONVERSION file (#51.25) Updates:")
+10 DO SETTXT^PSSP254("===================================================================")
+11 DO NEWUNITS
+12 ;
+13 ;Mailer
+14 DO MAIL^PSSP254
+15 KILL ^TMP("PSS254P",$JOB)
+16 QUIT
+17 ;
NEWROUTE ; Addition of new STANDARD MEDICATION ROUTES (51.23) available in 4.5
+1 ;PSLIST - 1 - Route Name
+2 ; 2 - FDB Name
+3 ;
+4 NEW DA,DIC,EFFDT,MTXT,PSJ,PSLIST,X,XUMF,Y
+5 SET XUMF=1
+6 ;May 01, 2024 at 0830
SET EFFDT=3240501.083001
+7 ;
+8 DO SETTXT^PSSP254("")
+9 SET MTXT="STANDARD MEDICATION ROUTES file (#51.23) New Entries:"
+10 DO BMES^XPDUTL(MTXT)
DO SETTXT^PSSP254(MTXT)
+11 DO SETTXT^PSSP254("=================================================")
+12 ;
+13 FOR PSJ=1:1
SET PSLIST=$PIECE($TEXT(LISTRTE+PSJ),";;",2)
if PSLIST=""
QUIT
Begin DoDot:1
+14 KILL DA,DIC
+15 SET DIC(0)="L"
+16 SET X=$PIECE(PSLIST,";")
+17 SET DA=$$FIND1^DIC(51.23,"","B",X)
if DA
QUIT
+18 ;
+19 SET DIC="^PS(51.23,"
SET DIC("DR")="1///"_$PIECE(PSLIST,";",2)
+20 DO FILE^DICN
+21 ;
+22 ;If failed to add, log and get the next
+23 IF Y<0
Begin DoDot:2
+24 SET MTXT=" - Failed to Add '"_X_"'"
+25 DO BMES^XPDUTL(MTXT)
DO SETTXT^PSSP254(MTXT)
End DoDot:2
QUIT
+26 ;
+27 ;Log Add
+28 SET DA=+Y
+29 SET ^XTMP("PSSP254B","NEWROUTE",51.23,DA)=X
+30 SET MTXT=" - Added '"_$$GET1^DIQ(51.23,DA,1)_"'"
+31 DO BMES^XPDUTL(MTXT)
DO SETTXT^PSSP254(MTXT)
+32 ;
+33 ;Add Effdt
+34 KILL DIC
+35 SET DIC(0)="L"
+36 SET DA(1)=+Y
+37 SET X=EFFDT
+38 SET DIC="^PS(51.23,"_DA(1)_",""TERMSTATUS"","
+39 SET DIC("DR")=".02///ACTIVE"
+40 DO FILE^DICN
End DoDot:1
+41 ;
+42 ;Index Rebuilds
+43 DO SETTXT^PSSP254("")
+44 SET MTXT="MEDICATION ROUTES Index Rebuild:"
+45 DO BMES^XPDUTL(MTXT)
DO SETTXT^PSSP254(MTXT)
+46 ;
RIDX NEW DIK
+1 SET MTXT=" - Medication Routes"
+2 DO BMES^XPDUTL(MTXT)
DO SETTXT^PSSP254(MTXT)
+3 ;Rebuild
SET DIK="^PS(51.2,"
SET DIK(1)=".01^FDBMRT"
DO ENALL^DIK
KILL DIK
+4 ;
+5 SET MTXT=" - Standard Medication Routes"
+6 DO BMES^XPDUTL(MTXT)
DO SETTXT^PSSP254(MTXT)
+7 ;Rebuild
SET DIK="^PS(51.23,"
SET DIK(1)="1^FDBMRT"
DO ENALL^DIK
KILL DIK
+8 QUIT
+9 ;
NEWUNITS ; Addition of new DOSE UNITS (51.24) available in 4.5
+1 ;PSLIST - 1 - Unit Name and FDB Name
+2 ; 2 - Dose Form Indicator (Y/N)
+3 ; 3 - Synonyms
+4 ;
+5 NEW DA,DIC,EFFDT,MTXT,PSI,PSJ,PSLIST,SYN,X,XUMF,Y
+6 SET XUMF=1
+7 ;
+8 DO SETTXT^PSSP254("")
+9 SET MTXT="o New DOSE UNITs:"
DO BMES^XPDUTL(MTXT)
DO SETTXT^PSSP254(MTXT)
+10 FOR PSJ=1:1
SET PSLIST=$PIECE($TEXT(LISTUNIT+PSJ),";;",2)
if PSLIST=""
QUIT
Begin DoDot:1
+11 KILL DA,DIC
+12 SET DIC(0)="L"
+13 SET X=$PIECE(PSLIST,";")
+14 SET DA=$$FIND1^DIC(51.24,"","B",X)
if DA
QUIT
+15 ;
+16 SET DIC="^PS(51.24,"
SET DIC("DR")="1///"_$PIECE(PSLIST,";")_";3///"_$PIECE(PSLIST,";",2)
+17 DO FILE^DICN
+18 ;
+19 ;If failed to add, log and get the next
+20 IF Y<0
Begin DoDot:2
+21 SET MTXT=" - Failed to Add '"_X_"'"
+22 DO BMES^XPDUTL(MTXT)
DO SETTXT^PSSP254(MTXT)
End DoDot:2
QUIT
+23 ;
+24 ;Log Add
+25 SET DA=+Y
+26 SET ^XTMP("PSSP254B","NEWUNIT",51.24,DA)=X
+27 SET MTXT=" - Added '"_$$GET1^DIQ(51.24,DA,.01)_"'"
+28 DO BMES^XPDUTL(MTXT)
DO SETTXT^PSSP254(MTXT)
+29 ;
+30 ;Add Synonyms
+31 KILL DIC
+32 SET DIC(0)="L"
+33 SET DA(1)=+Y
+34 SET DIC="^PS(51.24,"_DA(1)_",1,"
+35 SET SYM=$PIECE(PSLIST,";",3)
+36 FOR PSI=1:1
SET X=$PIECE(SYM,",",PSI)
if X=""
QUIT
DO FILE^DICN
End DoDot:1
+37 ;
+38 ;Index Rebuilds
+39 DO SETTXT^PSSP254("")
+40 SET MTXT="o Index Rebuild:"
+41 DO BMES^XPDUTL(MTXT)
DO SETTXT^PSSP254(MTXT)
+42 ;
UIDX NEW DIK
+1 SET MTXT=" - DOSE UNITS"
+2 DO BMES^XPDUTL(MTXT)
DO SETTXT^PSSP254(MTXT)
+3 ;Rebuild
SET DIK="^PS(51.24,"
SET DIK(1)=".01^FDBNAME"
DO ENALL^DIK
KILL DIK
+4 ;
+5 ;Rebuild
SET DIK="^PS(51.24,"
SET DIK(1)="1^FDBUNIT"
DO ENALL^DIK
KILL DIK
+6 ;
+7 ;Multiple - Loop through the entries and call the build
+8 NEW DFN
SET DFN=0
+9 FOR
SET DFN=$ORDER(^PS(51.24,DFN))
if 'DFN
QUIT
Begin DoDot:1
+10 SET DA(1)=DFN
SET DIK="^PS(51.24,"_DA(1)_",1,"
SET DIK(1)=".01^FDBSYN"
DO ENALL^DIK
KILL DIK
End DoDot:1
+11 QUIT
+12 ;
+13 ;Removed the following routes from the list
+14 ;;FEEDING TUBE;FEEDING TUBE
+15 ;;G-TUBE;G-TUBE
+16 ;;J-TUBE;J-TUBE
+17 ;;PERIPHERAL NERVE BLOCK;PERIPHERAL NERVE BLOCK
+18 ;;SUBCUTANEOUS (VIA WEARABLE INJECTOR);SUBCUTANEOUS (VIA WEARABLE INJECTOR)
LISTRTE ;New Routes 51.23
+1 ;;ADDUCTOR CANAL BLOCK;ADDUCTOR CANAL BLOCK
+2 ;;CERVICAL;CERVICAL
+3 ;;ECTOPIC GESTATIONAL SAC;ECTOPIC GESTATIONAL SAC
+4 ;;ENDOTRACHEAL;ENDOTRACHEAL
+5 ;;HAND BULB NEBULIZER;HAND BULB NEBULIZER
+6 ;;IMPLANT;IMPLANT
+7 ;;INFRACLAVICULAR;INFRACLAVICULAR
+8 ;;INSTILLATION;INSTILLATION
+9 ;;INTERSCALENE;INTERSCALENE
+10 ;;INTRACANALICULAR;INTRACANALICULAR
+11 ;;INTRACORONARY;INTRACORONARY
+12 ;;INTRALUMBAR;INTRALUMBAR
+13 ;;INTRALYMPHATIC;INTRALYMPHATIC
+14 ;;INTRAPERICARDIAL;INTRAPERICARDIAL
+15 ;;INTRAPROSTATIC;INTRAPROSTATIC
+16 ;;INTRA-PYELOCALYCEAL;INTRA-PYELOCALYCEAL
+17 ;;INTRASALIVARY GLAND;INTRASALIVARY GLAND
+18 ;;INTRA-SUBACROMIAL SPACE;INTRA-SUBACROMIAL SPACE
+19 ;;INTRA-UMBILICAL VEIN;INTRA-UMBILICAL VEIN
+20 ;;INTRAVENTRICULAR;INTRAVENTRICULAR
+21 ;;IPPB;IPPB
+22 ;;JUXTASCLERAL;JUXTASCLERAL
+23 ;;MISCELLANEOUS;MISCELLANEOUS
+24 ;;MUCOUS MEMBRANE;MUCOUS MEMBRANE
+25 ;;O2 AEROSOLIZATION;O2 AEROSOLIZATION
+26 ;;PERCUTANEOUS;PERCUTANEOUS
+27 ;;PERFUSION;PERFUSION
+28 ;;PERIARTICULAR;PERIARTICULAR
+29 ;;PERINEURAL INJECTION;PERINEURAL INJECTION
+30 ;;SUBLESIONAL;SUBLESIONAL
+31 ;;SUBRETINAL;SUBRETINAL
+32 ;;SUPRACHOROIDAL;SUPRACHOROIDAL
+33 ;;TENDON SHEATH INJ;TENDON SHEATH INJ.
+34 ;;TRANSTRACHEAL;TRANSTRACHEAL
+35 ;;TRANSURETHRAL;TRANSURETHRAL
+36 ;;
+37 ;;Unit Name;Y/N Dose Form Indicator;Synonyms
LISTUNIT ;New Units 51.24
+1 ;;AMPULE;Y;AMPULES,AMP,AMPS
+2 ;;BILLION CELLS;Y;
+3 ;;CELL;Y;CELLS
+4 ;;COLONY FORMING UNIT;Y;COLONY FORMING UNITS,CF UNIT
+5 ;;MELT;Y;MELTS
+6 ;;MICROGRAM DIETARY FOLATE EQUIVALENT;N;MICROGRAM DIETARY FOLATE EQUIVALENTS,MCG DFE
+7 ;;MILLICURIE;Y;MILLICURIES,MCI
+8 ;;MILLIGRAM FISH OIL;N;MILLIGRAMS FISH OIL,MG FISH OIL
+9 ;;MILLION CELLS;Y;MMU CELLS
+10 ;;MILLION PLAQUE FORMING UNITS;Y;MPF UNIT,MPF UNITS
+11 ;;MILLIUNIT;N;MILLIUNITS
+12 ;;PLAQUE FORMING UNIT;Y;PLAQUE FORMING UNITS,PF UNIT
+13 ;;TOWELETTE;Y;TOWELETTES,TOWEL,TOWELS
+14 ;;TUBE;Y;TUBES
+15 ;;
