PSDPRG.m

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

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