source: WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXPHVE.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.8 KB
Line 
1ECXPHVE ;ALB/JAM - Pharmacy Volume Edit ; 7/10/06 3:00pm
2 ;;3.0;DSS EXTRACTS;**92**;Dec 22, 1997;Build 30
3 ;
4EN ;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 ;
18EXTEDT ;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"")"
37RESET 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
43CKREC(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
Note: See TracBrowser for help on using the repository browser.