PSODELI.m

PSODELI ;IHS/DSD/JCM - DELETE ENTRIES IN APSP INTERVENTION FILE ; 03/28/93 21:15

 ;;7.0;OUTPATIENT PHARMACY;**10,268**;DEC 1997;Build 9

 ;

 ; This routine is called by the option that delete entries in

 ; the APSP INTERVENTION file.

 ; These options are locked with the PSZMGR key.

 ; 

 ; External Calls : ^DIE,^DIC,^DIR

 ;-----------------------------------------------------------------

START ;

 K DIC,DR,DIE,DA

 D INTERV ; Sets up DIC and DIE calls for files

END D EOJ ; Cleans up variables

 Q

 ;------------------------------------------------------------------

INTERV ; Deletes entries from APSP INTERVENTION file

 W !,"You may only delete entries entered on the current day.",!

 S PSODELI("QFLG")=0,APSP("LOG DEL FLG")="INTERV"

 F PSODELI=0:0 S DIC(0)="QEAM",(PSODELI("DIC"),DIC)="^APSPQA(32.4,",DIC("S")="I DT=$P(^(0),U,1)" Q:PSODELI("QFLG")  D DEL

 Q

DEL ; Does actual lookup and deletion of entries

 K PSODELI("DA")

 D ^DIC K DIC,DA,DR

 I Y=-1 S PSODELI("QFLG")=1 G DELX

 S PSODELI("DA")=+Y

 S DIR(0)="Y",Y=0,DIR("A")="SURE YOU WANT TO DELETE THE ENTIRE ENTRY"

 D ^DIR K DIR

 G:$D(DIRUT)!('Y) DELX

 S DIE=PSODELI("DIC"),DA=PSODELI("DA"),DR=".01///@",DIDEL=9009032.4

 L +^APSPQA(32.4,PSODELI("DA")):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3)

 D ^DIE K DIE,DA,DR

 L -^APSPQA(32.4,PSODELI("DA"))

DELX ; Exit point from DEL

 K DIC,DIR,DA,X,Y,PSODELI("DIC")

 Q

EOJ ; Clean up variables

 K PSODELI,APSP("LOG DEL FLG"),X,Y,DIRUT,DTOUT,DUOUT

 K DIC,DIK,DA,DR,DIDEL

 Q

PSODELI   ;IHS/DSD/JCM - DELETE ENTRIES IN APSP INTERVENTION FILE ; 03/28/93 21:15

 +1       ;;7.0;OUTPATIENT PHARMACY;**10,268**;DEC 1997;Build 9

 +2       ;

 +3       ; This routine is called by the option that delete entries in

 +4       ; the APSP INTERVENTION file.

 +5       ; These options are locked with the PSZMGR key.

 +6       ; 

 +7       ; External Calls : ^DIE,^DIC,^DIR

 +8       ;-----------------------------------------------------------------

START     ;

 +1        KILL DIC,DR,DIE,DA

 +2       ; Sets up DIC and DIE calls for files

           DO INTERV

END       ; Cleans up variables

           DO EOJ

 +1        QUIT 

 +2       ;------------------------------------------------------------------

INTERV    ; Deletes entries from APSP INTERVENTION file

 +1        WRITE !,"You may only delete entries entered on the current day.",!

 +2        SET PSODELI("QFLG")=0

           SET APSP("LOG DEL FLG")="INTERV"

 +3        FOR PSODELI=0:0

               SET DIC(0)="QEAM"

               SET (PSODELI("DIC"),DIC)="^APSPQA(32.4,"

               SET DIC("S")="I DT=$P(^(0),U,1)"

               IF PSODELI("QFLG")

                   QUIT 

               DO DEL

 +4        QUIT 

DEL       ; Does actual lookup and deletion of entries

 +1        KILL PSODELI("DA")

 +2        DO ^DIC

           KILL DIC,DA,DR

 +3        IF Y=-1

               SET PSODELI("QFLG")=1

               GOTO DELX

 +4        SET PSODELI("DA")=+Y

 +5        SET DIR(0)="Y"

           SET Y=0

           SET DIR("A")="SURE YOU WANT TO DELETE THE ENTIRE ENTRY"

 +6        DO ^DIR

           KILL DIR

 +7        IF $DATA(DIRUT)!('Y)

               GOTO DELX

 +8        SET DIE=PSODELI("DIC")

           SET DA=PSODELI("DA")

           SET DR=".01///@"

           SET DIDEL=9009032.4

 +9        LOCK +^APSPQA(32.4,PSODELI("DA")):$SELECT(+$GET(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3)

 +10       DO ^DIE

           KILL DIE,DA,DR

 +11       LOCK -^APSPQA(32.4,PSODELI("DA"))

DELX      ; Exit point from DEL

 +1        KILL DIC,DIR,DA,X,Y,PSODELI("DIC")

 +2        QUIT 

EOJ       ; Clean up variables

 +1        KILL PSODELI,APSP("LOG DEL FLG"),X,Y,DIRUT,DTOUT,DUOUT

 +2        KILL DIC,DIK,DA,DR,DIDEL

 +3        QUIT