- 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 Jan 18, 2025@02:44:55 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