PSODELI ;IHS/DSD/JCM - DELETE ENTRIES IN APSP INTERVENTION FILE ;03/28/93 21:15
;;7.0;OUTPATIENT PHARMACY;**10,268,251,375,387**;DEC 1997;Build 13
;External reference to ^APSPQA(32.4 supported by DBIA 2179
;External reference to ^DD("DILOCKTM" supported by DBIA 4909
;
; 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,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"),DIRUT S VALMBCK="R"
Q
EOJ ; Clean up variables
K PSODELI,APSP("LOG DEL FLG"),X,Y,DIRUT,DTOUT,DUOUT,DIC,DIK,DA,DR,DIDEL,DIE
Q
EDIT ;Edit Pharmacy Intervention
N DIC,DLAYGO,DA,Y,DIE,DR
W @IOF W !!,"Edit Existing Intervention",!!
F S DIC(0)="QEAM",DIC="^APSPQA(32.4,",DIC("A")="Select INTERVENTION:" D ^DIC K:Y=-1 X,DIC,DA,DIE Q:Y=-1 D
.S DA=+Y,DIE=DIC,DR="[PSO INTERVENTION EDIT]" D ^DIE
D EOJ S VALMBCK="R"
Q
NEW ;Enter Pharmacy Intervention
N DIC,DLAYGO,Y,DIE,DR,DIADD
W @IOF W !!,"Enter Pharmacy Intervention",!!
F S DIC(0)="QEMAL",DIC="^APSPQA(32.4,",DLAYGO=9009032.4,DIADD="" D ^DIC K DA,DR,DIADD K:Y=-1 X,DIC,DIADD,DA,DIE Q:Y=-1 D
.S DA=+Y,DIE=DIC,DR="[PSO INTERVENTION NEW]" K DIC D ^DIE
D EOJ S VALMBCK="R"
Q
OUT ; Print Pharmacy Intervention
N L,DIC,FLDS,BY,Y
W @IOF W !!,"Print Pharmacy Intervention",!!
S L=0,DIC="^APSPQA(32.4,",FLDS="[PSO INTERVENTIONS]",BY="[PSO INTERVENTIONS]"
D EN1^DIP W !!,"Pharmacy Intervention Menu",!!
D EOJ S VALMBCK="R"
Q
VIEW ;View Pharmacy Interventions
D FULL^VALM1
W @IOF,!!,"View Interventions",!! S PSOVWI("DIC")="^APSPQA(32.4," D ^PSOVWI
D EOJ S VALMBCK="R"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSODELI 2693 printed Dec 13, 2024@02:26:49 Page 2
PSODELI ;IHS/DSD/JCM - DELETE ENTRIES IN APSP INTERVENTION FILE ;03/28/93 21:15
+1 ;;7.0;OUTPATIENT PHARMACY;**10,268,251,375,387**;DEC 1997;Build 13
+2 ;External reference to ^APSPQA(32.4 supported by DBIA 2179
+3 ;External reference to ^DD("DILOCKTM" supported by DBIA 4909
+4 ;
+5 ; This routine is called by the option that delete entries in
+6 ; the APSP INTERVENTION file.
+7 ; These options are locked with the PSZMGR key.
+8 ;
+9 ; External Calls : ^DIE,^DIC,^DIR
+10 ;-----------------------------------------------------------------
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")
DO ^DIC
KILL DIC,DA,DR
+2 IF Y=-1
SET PSODELI("QFLG")=1
GOTO DELX
+3 SET PSODELI("DA")=+Y
SET DIR(0)="Y"
SET Y=0
SET DIR("A")="SURE YOU WANT TO DELETE THE ENTIRE ENTRY"
+4 DO ^DIR
KILL DIR
if $DATA(DIRUT)!('Y)
GOTO DELX
+5 SET DIE=PSODELI("DIC")
SET DA=PSODELI("DA")
SET DR=".01///@"
SET DIDEL=9009032.4
+6 LOCK +^APSPQA(32.4,PSODELI("DA")):$SELECT(+$GET(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3)
+7 DO ^DIE
KILL DIE,DA,DR
+8 LOCK -^APSPQA(32.4,PSODELI("DA"))
DELX ; Exit point from DEL
+1 KILL DIC,DIR,DA,X,Y,PSODELI("DIC"),DIRUT
SET VALMBCK="R"
+2 QUIT
EOJ ; Clean up variables
+1 KILL PSODELI,APSP("LOG DEL FLG"),X,Y,DIRUT,DTOUT,DUOUT,DIC,DIK,DA,DR,DIDEL,DIE
+2 QUIT
EDIT ;Edit Pharmacy Intervention
+1 NEW DIC,DLAYGO,DA,Y,DIE,DR
+2 WRITE @IOF
WRITE !!,"Edit Existing Intervention",!!
+3 FOR
SET DIC(0)="QEAM"
SET DIC="^APSPQA(32.4,"
SET DIC("A")="Select INTERVENTION:"
DO ^DIC
if Y=-1
KILL X,DIC,DA,DIE
if Y=-1
QUIT
Begin DoDot:1
+4 SET DA=+Y
SET DIE=DIC
SET DR="[PSO INTERVENTION EDIT]"
DO ^DIE
End DoDot:1
+5 DO EOJ
SET VALMBCK="R"
+6 QUIT
NEW ;Enter Pharmacy Intervention
+1 NEW DIC,DLAYGO,Y,DIE,DR,DIADD
+2 WRITE @IOF
WRITE !!,"Enter Pharmacy Intervention",!!
+3 FOR
SET DIC(0)="QEMAL"
SET DIC="^APSPQA(32.4,"
SET DLAYGO=9009032.4
SET DIADD=""
DO ^DIC
KILL DA,DR,DIADD
if Y=-1
KILL X,DIC,DIADD,DA,DIE
if Y=-1
QUIT
Begin DoDot:1
+4 SET DA=+Y
SET DIE=DIC
SET DR="[PSO INTERVENTION NEW]"
KILL DIC
DO ^DIE
End DoDot:1
+5 DO EOJ
SET VALMBCK="R"
+6 QUIT
OUT ; Print Pharmacy Intervention
+1 NEW L,DIC,FLDS,BY,Y
+2 WRITE @IOF
WRITE !!,"Print Pharmacy Intervention",!!
+3 SET L=0
SET DIC="^APSPQA(32.4,"
SET FLDS="[PSO INTERVENTIONS]"
SET BY="[PSO INTERVENTIONS]"
+4 DO EN1^DIP
WRITE !!,"Pharmacy Intervention Menu",!!
+5 DO EOJ
SET VALMBCK="R"
+6 QUIT
VIEW ;View Pharmacy Interventions
+1 DO FULL^VALM1
+2 WRITE @IOF,!!,"View Interventions",!!
SET PSOVWI("DIC")="^APSPQA(32.4,"
DO ^PSOVWI
+3 DO EOJ
SET VALMBCK="R"
+4 QUIT
