Routine: PSXCPOST

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

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSXCPOST   622     printed  Apr 09, 2024@20:48:41                                                                                                                                                                                                     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

PSXCPOST.m