PSXBPOST ;BIR/HTW-Post Initialization Routine;8/15/95 [ 08/25/95 3:28 PM ]
;;1.0;CONSOLIDATED MAIL OUTPATIENT PHARMACY;**2**;10 May 95
N I,NAME,DIE,DR,DA
REM F I="PSX ARCHIVE","PSX ARCHIVE PURGE","PSX ARCHIVE RETRIEVE","PSX ARCHIVE SAVE" D
.S DA=$O(^DIC(19,"B",I,0)) Q:'DA
.S DIK="^DIC(19," D ^DIK
K DIK,DA
F I="PSXB ARCHIVE","PSXB ARCHIVE PURGE","PSXB ARCHIVE RETRIEVE","PSXB ARCHIVE SAVE" D
.S NAME="PSX"_$P(I,"B",2),DA=$O(^DIC(19,"B",I,0)) Q:'DA
.S DIE="^DIC(19,",DR=".01////"_NAME
.D ^DIE
.W !,"Option ",I," renamed ",NAME
W !!,"Installation complete!"
K DA,NAME,DIE,DR,I
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSXBPOST 608 printed Dec 13, 2024@01:43:31 Page 2
PSXBPOST ;BIR/HTW-Post Initialization Routine;8/15/95 [ 08/25/95 3:28 PM ]
+1 ;;1.0;CONSOLIDATED MAIL OUTPATIENT PHARMACY;**2**;10 May 95
+2 NEW I,NAME,DIE,DR,DA
REM FOR I="PSX ARCHIVE","PSX ARCHIVE PURGE","PSX ARCHIVE RETRIEVE","PSX ARCHIVE SAVE"
Begin DoDot:1
+1 SET DA=$ORDER(^DIC(19,"B",I,0))
if 'DA
QUIT
+2 SET DIK="^DIC(19,"
DO ^DIK
End DoDot:1
+3 KILL DIK,DA
+4 FOR I="PSXB ARCHIVE","PSXB ARCHIVE PURGE","PSXB ARCHIVE RETRIEVE","PSXB ARCHIVE SAVE"
Begin DoDot:1
+5 SET NAME="PSX"_$PIECE(I,"B",2)
SET DA=$ORDER(^DIC(19,"B",I,0))
if 'DA
QUIT
+6 SET DIE="^DIC(19,"
SET DR=".01////"_NAME
+7 DO ^DIE
+8 WRITE !,"Option ",I," renamed ",NAME
End DoDot:1
+9 WRITE !!,"Installation complete!"
+10 KILL DA,NAME,DIE,DR,I
+11 QUIT
