PSOHPOST ;BHAM ISC/RTR - Patch PSO*6*138 post init ; 06/12/95
;;6.0;OUTPATIENT PHARMACY;**138**;APRIL 1993
S DIK="^PS(52.11,",DA=0 F S DA=$O(^PS(52.11,DA)) Q:'DA D ^DIK
K ^PS(52.11,"AD"),^PS(52.11,"ANAM"),^PS(52.11,"ATIC"),^PS(52.11,"BI"),^PS(52.11,"B"),^PS(52.11,"BA"),^PS(52.11,"C")
F ZZ=0:0 S ZZ=$O(^PS(52.5,"AC",ZZ)) Q:'ZZ F XX=0:0 S XX=$O(^PS(52.5,"AC",ZZ,XX)) Q:'XX F TT=0:0 S TT=$O(^PS(52.5,"AC",ZZ,XX,TT)) Q:'TT D
.I '$D(^PS(52.5,TT,0)) K ^PS(52.5,"AC",ZZ,XX,TT),^PS(52.5,"C",XX,TT) Q
.I $D(^PS(52.5,TT,0)),XX'=$P(^(0),"^",2) D
..S PSOSDATE=$P(^PS(52.5,TT,0),"^",2) K ^PS(52.5,"AC",ZZ,XX,TT),^PS(52.5,"C",XX,TT) S ^PS(52.5,"C",PSOSDATE,TT)="" I $G(^PS(52.5,TT,"P"))=0!($G(^PS(52.5,TT,"P"))=2) S ^PS(52.5,"AC",ZZ,PSOSDATE,TT)=""
.I $P($G(^PS(52.5,TT,0)),"^",7)'="" S PSCMDATE=+$P($G(^(0)),"^",2) K ^PS(52.5,"AC",ZZ,PSCMDATE,TT)
END K DA,DIE,ZZ,XX,TT,PSOQTIME,PSOSDATE,PSCMDATE Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOHPOST 909 printed Dec 13, 2024@02:30:17 Page 2
PSOHPOST ;BHAM ISC/RTR - Patch PSO*6*138 post init ; 06/12/95
+1 ;;6.0;OUTPATIENT PHARMACY;**138**;APRIL 1993
+2 SET DIK="^PS(52.11,"
SET DA=0
FOR
SET DA=$ORDER(^PS(52.11,DA))
if 'DA
QUIT
DO ^DIK
+3 KILL ^PS(52.11,"AD"),^PS(52.11,"ANAM"),^PS(52.11,"ATIC"),^PS(52.11,"BI"),^PS(52.11,"B"),^PS(52.11,"BA"),^PS(52.11,"C")
+4 FOR ZZ=0:0
SET ZZ=$ORDER(^PS(52.5,"AC",ZZ))
if 'ZZ
QUIT
FOR XX=0:0
SET XX=$ORDER(^PS(52.5,"AC",ZZ,XX))
if 'XX
QUIT
FOR TT=0:0
SET TT=$ORDER(^PS(52.5,"AC",ZZ,XX,TT))
if 'TT
QUIT
Begin DoDot:1
+5 IF '$DATA(^PS(52.5,TT,0))
KILL ^PS(52.5,"AC",ZZ,XX,TT),^PS(52.5,"C",XX,TT)
QUIT
+6 IF $DATA(^PS(52.5,TT,0))
IF XX'=$PIECE(^(0),"^",2)
Begin DoDot:2
+7 SET PSOSDATE=$PIECE(^PS(52.5,TT,0),"^",2)
KILL ^PS(52.5,"AC",ZZ,XX,TT),^PS(52.5,"C",XX,TT)
SET ^PS(52.5,"C",PSOSDATE,TT)=""
IF $GET(^PS(52.5,TT,"P"))=0!($GET(^PS(52.5,TT,"P"))=2)
SET ^PS(52.5,"AC",ZZ,PSOSDATE,TT)=""
End DoDot:2
+8 IF $PIECE($GET(^PS(52.5,TT,0)),"^",7)'=""
SET PSCMDATE=+$PIECE($GET(^(0)),"^",2)
KILL ^PS(52.5,"AC",ZZ,PSCMDATE,TT)
End DoDot:1
END KILL DA,DIE,ZZ,XX,TT,PSOQTIME,PSOSDATE,PSCMDATE
QUIT
