source: FOIAVistA/trunk/r/DSS_EXTRACTS-ECX/ECXNUTPE.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 1.8 KB
Line 
1ECXNUTPE ;ALB/JRC - Nut Product Worksheet Edit ; 10/17/06 2:03pm
2 ;;3.0;DSS EXTRACTS;**92**;Dec 22, 1997;Build 30
3 ;
4EN ;entry point from menu option
5 ;Declare variables
6 N STOP,DIC,DTOUT,DUOUT,Y,DA,SCREEN,CATEGORY,DIET,PRODUCT,CAT,FL,DLAYGO
7 S STOP=0
8 F D Q:STOP
9 .;Select diet category
10 .S DIC="^ECX(728.45,",DIC(0)="AEQMZL",DLAYGO=728.45
11 .D ^DIC
12 .I ($D(DTOUT))!($D(DUOUT))!(Y<1) S STOP=1 Q
13 .W " ",Y(0,0)
14 .S SCREEN=$E($P(Y(0,0)," "),1)_$E($P(Y(0,0)," ",2),1)
15 .S CATEGORY=$P(Y,U,2)
16 .S CAT=+Y
17 .S FL=Y(0)
18 .S FL=$S(FL="PD":116.2,FL="SF":118,FL="SO":118.3,FL="TF":118.2,1:"")
19 .F D Q:STOP
20 ..;Select category subentry
21 ..S DA(1)=CAT,DIC(0)="AEQMZL"
22 ..S DIC="^ECX(728.45,"_DA(1)_",1,"
23 ..S DIC("V")="I +Y(0)="_FL_""
24 ..D ^DIC
25 ..I ($D(DTOUT))!($D(DUOUT))!(Y<1) S STOP=1 Q
26 ..S DIET=$P(Y,U,2)
27 ..D CHOICES
28 ..Q:STOP
29 ..D UPDATE
30 Q
31 ;
32CHOICES ;Prepare CHOICES variable for DIR call
33 ; Input - screen (Required)
34 ;
35 ; Output - Array of choices
36 ; 1 Regular
37 ; 2 Clear Liqs
38 ;Init variables
39 N CHOICES,OFF,TEXT,DSSCAT,DSSPRO,CNT,DIR,DIRUT,DUOUT,X,Y
40 S CHOICES=""
41 F OFF=1:1 S TEXT=$P($T(PRODUCTS+OFF^ECXNUTPP),";;",2) Q:TEXT="END" D
42 .S DSSCAT=$P(TEXT,U),DSSPRO=$P(TEXT,U,2)
43 .Q:DSSCAT'=SCREEN
44 .S CNT=$G(CNT)+1
45 .S CHOICES=$G(CHOICES)_CNT_":"_DSSPRO_";"
46 S DIR(0)="S^"_CHOICES
47 S DIR("A")="Select DSS Assigned Product"
48 D ^DIR
49 I $D(DIRUT)!$D(DUOUT) D CHOICES S STOP=1 Q
50 S PRODUCT=Y(0)
51 Q
52 ;
53UPDATE ;Update file (#728.45) assigned product field
54 N ECXFDA,ECXERR
55 S ECXFDA(728.45,"?1,",.01)=CATEGORY
56 S ECXFDA(728.451,"?+2,?1,",.01)=DIET
57 S ECXFDA(728.451,"?+2,?1,",1)=PRODUCT
58 D UPDATE^DIE("","ECXFDA","","ECXERR")
59 I $D(ECXERR) D
60 .W !!!,"Problem encountered during record update "
61 .W !!,"Contact IRM"_" Error: "_$G(ECXERR("DIERR",1,"TEXT",1))
62 Q
Note: See TracBrowser for help on using the repository browser.