PSDPRG ;BIR/JPW-Purge the CS WORKSHEET file (#58.85) ; 3 Jun 94
;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
LOOP ;start looping on order status x-ref
F PSD=3.99:0 S PSD=$O(^PSD(58.85,"AC",PSD)) Q:'PSD!(PSD>9) F PSDA=0:0 S PSDA=$O(^PSD(58.85,"AC",PSD,PSDA)) Q:'PSDA F PSDR=0:0 S PSDR=$O(^PSD(58.85,"AC",PSD,PSDA,PSDR)) Q:'PSDR D
.F PSDN=0:0 S PSDN=$O(^PSD(58.85,"AC",PSD,PSDA,PSDR,PSDN)) Q:'PSDN S DA=+$O(^PSD(58.85,"AC",PSD,PSDA,PSDR,PSDN,0)) I DA,$D(^PSD(58.85,+DA,0)) S DIK="^PSD(58.85," D ^DIK K DA,DIK
K PSD,PSDA,PSDN,PSDR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDPRG 538 printed Dec 13, 2024@01:48:11 Page 2
PSDPRG ;BIR/JPW-Purge the CS WORKSHEET file (#58.85) ; 3 Jun 94
+1 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
LOOP ;start looping on order status x-ref
+1 FOR PSD=3.99:0
SET PSD=$ORDER(^PSD(58.85,"AC",PSD))
if 'PSD!(PSD>9)
QUIT
FOR PSDA=0:0
SET PSDA=$ORDER(^PSD(58.85,"AC",PSD,PSDA))
if 'PSDA
QUIT
FOR PSDR=0:0
SET PSDR=$ORDER(^PSD(58.85,"AC",PSD,PSDA,PSDR))
if 'PSDR
QUIT
Begin DoDot:1
+2 FOR PSDN=0:0
SET PSDN=$ORDER(^PSD(58.85,"AC",PSD,PSDA,PSDR,PSDN))
if 'PSDN
QUIT
SET DA=+$ORDER(^PSD(58.85,"AC",PSD,PSDA,PSDR,PSDN,0))
IF DA
IF $DATA(^PSD(58.85,+DA,0))
SET DIK="^PSD(58.85,"
DO ^DIK
KILL DA,DIK
End DoDot:1
+3 KILL PSD,PSDA,PSDN,PSDR
