PSXCPRE ;BIR/WPB - Pre-init routine for PSX*1*3 [ 02/29/96 12:15 PM ]
;;1.0;CONSOLIDATED MAIL OUTPATIENT PHARMACY;**3**;10 May 95
HOST G:$G(^XMB("NETNAME"))'["CMOP-" MED
F XX="^DD(54,","^DIC(54," S DIU=XX,DIU(0)="DS" D EN^DIU2 K DIU,DIU(0)
S DIK="^DD(50,",DA=8,DA(1)=50 D ^DIK K DA,DIK
K XX
Q
MED Q:$G(^XMB("NETNAME"))["CMOP-"
S DIK="^DD(50,",DA=8,DA(1)=50 D ^DIK K DA,DIK
S DIK="^DD(52.5,",DA=3,DA(1)=52.5 D ^DIK K DA,DIK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSXCPRE 445 printed Sep 23, 2025@19:19:41 Page 2
PSXCPRE ;BIR/WPB - Pre-init routine for PSX*1*3 [ 02/29/96 12:15 PM ]
+1 ;;1.0;CONSOLIDATED MAIL OUTPATIENT PHARMACY;**3**;10 May 95
HOST if $GET(^XMB("NETNAME"))'["CMOP-"
GOTO MED
+1 FOR XX="^DD(54,","^DIC(54,"
SET DIU=XX
SET DIU(0)="DS"
DO EN^DIU2
KILL DIU,DIU(0)
+2 SET DIK="^DD(50,"
SET DA=8
SET DA(1)=50
DO ^DIK
KILL DA,DIK
+3 KILL XX
+4 QUIT
MED if $GET(^XMB("NETNAME"))["CMOP-"
QUIT
+1 SET DIK="^DD(50,"
SET DA=8
SET DA(1)=50
DO ^DIK
KILL DA,DIK
+2 SET DIK="^DD(52.5,"
SET DA=3
SET DA(1)=52.5
DO ^DIK
KILL DA,DIK
+3 QUIT
