| 1 | PSODELI ;IHS/DSD/JCM - DELETE ENTRIES IN APSP INTERVENTION FILE ; 03/28/93 21:15
 | 
|---|
| 2 |  ;;7.0;OUTPATIENT PHARMACY;**10,268**;DEC 1997;Build 9
 | 
|---|
| 3 |  ;
 | 
|---|
| 4 |  ; This routine is called by the option that delete entries in
 | 
|---|
| 5 |  ; the APSP INTERVENTION file.
 | 
|---|
| 6 |  ; These options are locked with the PSZMGR key.
 | 
|---|
| 7 |  ; 
 | 
|---|
| 8 |  ; External Calls : ^DIE,^DIC,^DIR
 | 
|---|
| 9 |  ;-----------------------------------------------------------------
 | 
|---|
| 10 | START ;
 | 
|---|
| 11 |  K DIC,DR,DIE,DA
 | 
|---|
| 12 |  D INTERV ; Sets up DIC and DIE calls for files
 | 
|---|
| 13 | END D EOJ ; Cleans up variables
 | 
|---|
| 14 |  Q
 | 
|---|
| 15 |  ;------------------------------------------------------------------
 | 
|---|
| 16 | INTERV ; Deletes entries from APSP INTERVENTION file
 | 
|---|
| 17 |  W !,"You may only delete entries entered on the current day.",!
 | 
|---|
| 18 |  S PSODELI("QFLG")=0,APSP("LOG DEL FLG")="INTERV"
 | 
|---|
| 19 |  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
 | 
|---|
| 20 |  Q
 | 
|---|
| 21 | DEL ; Does actual lookup and deletion of entries
 | 
|---|
| 22 |  K PSODELI("DA")
 | 
|---|
| 23 |  D ^DIC K DIC,DA,DR
 | 
|---|
| 24 |  I Y=-1 S PSODELI("QFLG")=1 G DELX
 | 
|---|
| 25 |  S PSODELI("DA")=+Y
 | 
|---|
| 26 |  S DIR(0)="Y",Y=0,DIR("A")="SURE YOU WANT TO DELETE THE ENTIRE ENTRY"
 | 
|---|
| 27 |  D ^DIR K DIR
 | 
|---|
| 28 |  G:$D(DIRUT)!('Y) DELX
 | 
|---|
| 29 |  S DIE=PSODELI("DIC"),DA=PSODELI("DA"),DR=".01///@",DIDEL=9009032.4
 | 
|---|
| 30 |  L +^APSPQA(32.4,PSODELI("DA")):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3)
 | 
|---|
| 31 |  D ^DIE K DIE,DA,DR
 | 
|---|
| 32 |  L -^APSPQA(32.4,PSODELI("DA"))
 | 
|---|
| 33 | DELX ; Exit point from DEL
 | 
|---|
| 34 |  K DIC,DIR,DA,X,Y,PSODELI("DIC")
 | 
|---|
| 35 |  Q
 | 
|---|
| 36 | EOJ ; Clean up variables
 | 
|---|
| 37 |  K PSODELI,APSP("LOG DEL FLG"),X,Y,DIRUT,DTOUT,DUOUT
 | 
|---|
| 38 |  K DIC,DIK,DA,DR,DIDEL
 | 
|---|
| 39 |  Q
 | 
|---|