PSOCOSTP.m

PSOCOSTP ;BHAM-ISC/SAB - Purges data from drug cost file (#50.9) ; 05/12/94 8:20

 ;;7.0;OUTPATIENT PHARMACY;;DEC 1997

 I '$O(^PSCST(0)) W !,$C(7),"There is NO cost Data to be Purged !",! K ^PSOCST("B") Q

ST K ZTSK,ZTQUEUED,%DT S Y=$O(^PSCST(0)) D DD^%DT S DEF=Y

BEG W ! S %DT("A")="Purge Cost Data Starting: ",%DT="AEP",%DT("B")=DEF D ^%DT G:"^"[X EX G:Y<0 BEG S (%DT(0),BDT)=Y

END K %DT("B"),DEF S %DT("A")="Purge Cost Data Ending: ",%DT="AEP" D ^%DT G:"^"[X EX G:Y<0 END S EDT=Y

 W ! K DIR S DIR("A",1)="Are you sure you want to purge cost data",DIR("A")="from "_$E(BDT,4,5)_"/"_$E(BDT,6,7)_"/"_$E(BDT,2,3)_" to "_$E(EDT,4,5)_"/"_$E(EDT,6,7)_"/"_$E(EDT,2,3),DIR(0)="Y",DIR("B")="NO" D ^DIR

 G:$D(DTOUT)!($D(DUOUT)) EX I 'Y G ST

 W ! K DIR S DIR("A")="Do you want this option to run IMMEDIATELY or QUEUED? ",DIR(0)="SA^1:QUEUED;0:IMMEDIATELY",DIR("B")="Q" D ^DIR

 G:$D(DTOUT)!($D(DUOUT)) EX I 'Y D WAIT^DICD G EN

 S ZTRTN="EN^PSOCOSTP",ZTDESC="Outpatient Pharmacy Drug Cost file (50.9) Purge Option",ZTIO="",ZTSAVE("BDT")="",ZTSAVE("EDT")="" D ^%ZTLOAD W:$D(ZTSK) !,"Task #"_ZTSK_" QUEUED.",! G EX

EN S DIK="^PSCST(",PDT=BDT-1 F  S PDT=$O(^PSCST(PDT)) Q:'PDT!(PDT>EDT)  S DA=PDT D ^DIK W:'$D(ZTQUEUED) "."

EX K Y,X,T,%DT,DIR,BDT,EDT,PDT,DUOUT,DTOUT S:$D(ZTQUEUED) ZTREQ="@"

 Q

PSOCOSTP  ;BHAM-ISC/SAB - Purges data from drug cost file (#50.9) ; 05/12/94 8:20

 +1       ;;7.0;OUTPATIENT PHARMACY;;DEC 1997

 +2        IF '$ORDER(^PSCST(0))

               WRITE !,$CHAR(7),"There is NO cost Data to be Purged !",!

               KILL ^PSOCST("B")

               QUIT 

ST         KILL ZTSK,ZTQUEUED,%DT

           SET Y=$ORDER(^PSCST(0))

           DO DD^%DT

           SET DEF=Y

BEG        WRITE !

           SET %DT("A")="Purge Cost Data Starting: "

           SET %DT="AEP"

           SET %DT("B")=DEF

           DO ^%DT

           IF "^"[X

               GOTO EX

           IF Y<0

               GOTO BEG

           SET (%DT(0),BDT)=Y

END        KILL %DT("B"),DEF

           SET %DT("A")="Purge Cost Data Ending: "

           SET %DT="AEP"

           DO ^%DT

           IF "^"[X

               GOTO EX

           IF Y<0

               GOTO END

           SET EDT=Y

 +1        WRITE !

           KILL DIR

           SET DIR("A",1)="Are you sure you want to purge cost data"

           SET DIR("A")="from "_$EXTRACT(BDT,4,5)_"/"_$EXTRACT(BDT,6,7)_"/"_$EXTRACT(BDT,2,3)_" to "_$EXTRACT(EDT,4,5)_"/"_$EXTRACT(EDT,6,7)_"/"_$EXTRACT(EDT,2,3)

           SET DIR(0)="Y"

           SET DIR("B")="NO"

           DO ^DIR

 +2        IF $DATA(DTOUT)!($DATA(DUOUT))

               GOTO EX

           IF 'Y

               GOTO ST

 +3        WRITE !

           KILL DIR

           SET DIR("A")="Do you want this option to run IMMEDIATELY or QUEUED? "

           SET DIR(0)="SA^1:QUEUED;0:IMMEDIATELY"

           SET DIR("B")="Q"

           DO ^DIR

 +4        IF $DATA(DTOUT)!($DATA(DUOUT))

               GOTO EX

           IF 'Y

               DO WAIT^DICD

               GOTO EN

 +5        SET ZTRTN="EN^PSOCOSTP"

           SET ZTDESC="Outpatient Pharmacy Drug Cost file (50.9) Purge Option"

           SET ZTIO=""

           SET ZTSAVE("BDT")=""

           SET ZTSAVE("EDT")=""

           DO ^%ZTLOAD

           IF $DATA(ZTSK)

               WRITE !,"Task #"_ZTSK_" QUEUED.",!

           GOTO EX

EN         SET DIK="^PSCST("

           SET PDT=BDT-1

           FOR 

               SET PDT=$ORDER(^PSCST(PDT))

               IF 'PDT!(PDT>EDT)

                   QUIT 

               SET DA=PDT

               DO ^DIK

               IF '$DATA(ZTQUEUED)

                   WRITE "."

EX         KILL Y,X,T,%DT,DIR,BDT,EDT,PDT,DUOUT,DTOUT

           IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +1        QUIT