PSXCPOST ;BIR/WPB - Post-init routine for PSX*1*3 [ 03/07/96 11:02 AM ]
;;1.0;CONSOLIDATED MAIL OUTPATIENT PHARMACY;**3**;10 May 95
HOST G:$G(^XMB("NETNAME"))'["CMOP-" MED
F ZZ=52.5,550,550.1 S DIU=ZZ,DIU(0)="D" D EN^DIU2 K DIU,DIU(0)
K ZZ
D DRG^PSXUTL
Q
MED Q:$G(^XMB("NETNAME"))["CMOP-"
S XX=0 F S XX=$O(^PS(52.5,"AG",XX)) Q:XX'>0 S ZZ=0 F S ZZ=$O(^PS(52.5,"AG",XX,ZZ)) Q:ZZ'>0 D
.I '$D(^PS(52.5,ZZ,0)) K ^PS(52.5,"AG",XX,ZZ) Q
.I $P(^PS(52.5,ZZ,0),"^",7)'="Q"&($P(^PS(52.5,ZZ,0),"^",7)'="P") K ^PS(52.5,"AG",XX,ZZ)
I $D(^PS(52.5,"AR")) K ^PS(52.5,"AR")
K XX,DIK,DIK(1),ZZ
D DRG^PSXUTL
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSXCPOST 622 printed Sep 23, 2025@19:19:40 Page 2
PSXCPOST ;BIR/WPB - Post-init routine for PSX*1*3 [ 03/07/96 11:02 AM ]
+1 ;;1.0;CONSOLIDATED MAIL OUTPATIENT PHARMACY;**3**;10 May 95
HOST if $GET(^XMB("NETNAME"))'["CMOP-"
GOTO MED
+1 FOR ZZ=52.5,550,550.1
SET DIU=ZZ
SET DIU(0)="D"
DO EN^DIU2
KILL DIU,DIU(0)
+2 KILL ZZ
+3 DO DRG^PSXUTL
+4 QUIT
MED if $GET(^XMB("NETNAME"))["CMOP-"
QUIT
+1 SET XX=0
FOR
SET XX=$ORDER(^PS(52.5,"AG",XX))
if XX'>0
QUIT
SET ZZ=0
FOR
SET ZZ=$ORDER(^PS(52.5,"AG",XX,ZZ))
if ZZ'>0
QUIT
Begin DoDot:1
+2 IF '$DATA(^PS(52.5,ZZ,0))
KILL ^PS(52.5,"AG",XX,ZZ)
QUIT
+3 IF $PIECE(^PS(52.5,ZZ,0),"^",7)'="Q"&($PIECE(^PS(52.5,ZZ,0),"^",7)'="P")
KILL ^PS(52.5,"AG",XX,ZZ)
End DoDot:1
+4 IF $DATA(^PS(52.5,"AR"))
KILL ^PS(52.5,"AR")
+5 KILL XX,DIK,DIK(1),ZZ
+6 DO DRG^PSXUTL
+7 QUIT
