1 | ECXPHVE ;ALB/JAM - Pharmacy Volume Edit ; 7/10/06 3:00pm
|
---|
2 | ;;3.0;DSS EXTRACTS;**92**;Dec 22, 1997;Build 30
|
---|
3 | ;
|
---|
4 | EN ;entry point from menu option
|
---|
5 | N DIR,DIRUT,ECXX,Y,STOP,ECPIECE
|
---|
6 | N $ESTACK,$ETRAP S $ETRAP="D RESET^ECXPHVE"
|
---|
7 | S DIR(0)="SO^P:PRE;I:IVP;U:UDP"
|
---|
8 | S DIR("A")="Which extract do you need to edit?"
|
---|
9 | D ^DIR I $D(DIRUT) Q
|
---|
10 | S ECXX=Y(0),ECPIECE=$S(ECXX="PRE":2,ECXX="IVP":19,1:8)
|
---|
11 | S STOP=0 I $P($G(^ECX(728,1,7.1)),"^",ECPIECE)]"" D I STOP Q
|
---|
12 | .W !!,ECXX," Extract running, cannot edit. Try later.",!! S STOP=1
|
---|
13 | .K DIR S DIR(0)="E" D ^DIR
|
---|
14 | S $P(^ECX(728,1,7.1),"^",ECPIECE)="R"
|
---|
15 | D EXTEDT
|
---|
16 | Q
|
---|
17 | ;
|
---|
18 | EXTEDT ;Edit extracts - PRE, IVP, or UDP
|
---|
19 | N DIC,DIE,DA,DR,DTOUT,DUOUT,Y,D
|
---|
20 | S DIC(0)="AENMQZ",DIC("S")="I $$CKREC^ECXPHVE($P(^(0),""^"",3))"
|
---|
21 | S DIC("A")="Select "_ECXX_" EXTRACT OR SEQUENCE NUMBER: "
|
---|
22 | ;PRE extract (file #727.1) edit Quantity (field #16) & Unit of Issue (field #22)
|
---|
23 | I ECXX="PRE" D
|
---|
24 | .S DIC="^ECX(727.81,",DR="16;22"
|
---|
25 | .D TURNON^DIAUTL(727.81,"16;22","y")
|
---|
26 | ;IVP extract (file #727.819) edit Quantity (field #10)
|
---|
27 | I ECXX="IVP" D
|
---|
28 | .S DIC="^ECX(727.819,",DR="10"
|
---|
29 | .D TURNON^DIAUTL(727.819,"10","y")
|
---|
30 | ;UDP extract (file #727.809) edit Quantity (field #10)
|
---|
31 | I ECXX="UDP" D
|
---|
32 | .S DIC="^ECX(727.809,",DR="10"
|
---|
33 | .D TURNON^DIAUTL(727.809,"10","y")
|
---|
34 | F D D MIX^DIC1 Q:($D(DTOUT))!($D(DUOUT))!(Y<1) S DIE=DIC,DA=+Y D ^DIE
|
---|
35 | .S D="AC^B"
|
---|
36 | .S DIC("W")="W ?30,"" "",$P(^(0),U,2),"" "",?45,$P(^(0),U,3),"" "",?55,$$GET1^DIQ(2,+$P(^(0),U,5),.01,""E"")"
|
---|
37 | RESET I $G(ECXX)="" Q
|
---|
38 | I ECXX="PRE" D TURNON^DIAUTL(727.81,"16;22","e")
|
---|
39 | I ECXX="IVP" D TURNON^DIAUTL(727.819,"10","e")
|
---|
40 | I ECXX="UDP" D TURNON^DIAUTL(727.809,"10","e")
|
---|
41 | I $G(ECPIECE) S $P(^ECX(728,1,7.1),"^",ECPIECE)=""
|
---|
42 | Q
|
---|
43 | CKREC(ECXN) ;Checks if record should be edited.
|
---|
44 | I ECXN="" Q 0
|
---|
45 | I $G(^ECX(727,ECXN,"PURG"))'="" Q 0
|
---|
46 | I $G(^ECX(727,ECXN,"TR"))'="" Q 0
|
---|
47 | I $G(^ECX(727,ECXN,"Q"))'="" Q 0
|
---|
48 | Q 1
|
---|