source: WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXNUTDE.m@ 1703

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

initial load of WorldVistAEHR

File size: 1.7 KB
Line 
1ECXNUTDE ;ALB/JRC - Nut Division Worksheet Edit ; 12/15/06 2:01pm
2 ;;3.0;DSS EXTRACTS;**92,100**;Dec 22, 1997;Build 2
3 ;
4EN ;entry point from menu option
5 ;Declare variables
6 N STOP,DIR,DIRUT,FL,DIC,Y,DIVISION,DSSDIV,DTOUT,DUOUT,FL,DLAYGO
7 S STOP=0
8 F D Q:STOP
9 .S DIR(0)="SO^PL:PRODUCTION LOCATION;DL:DELIVERY LOCATION"
10 .S DIR("A")="Select location to edit?"
11 .D ^DIR I $D(DIRUT) S STOP=1 Q
12 .S FL=$S(Y="PL":119.71,Y="DL":119.72,1:"")
13 .F D Q:STOP
14 ..;Select division to edit
15 ..S DIC="^ECX(728.46,",DIC(0)="AEQMZL",DLAYGO=728.45
16 ..S DIC("A")="Select "_$S(FL=119.71:"Production",1:"Delivery")_" Location to edit: "
17 ..S DIC("V")="I +Y(0)="_FL
18 ..D ^DIC
19 ..I ($D(DTOUT))!($D(DUOUT))!(Y<1) S STOP=1 Q
20 ..S DIVISION=$P(Y,U,2)
21 ..D SCREEN Q:STOP
22 ..D UPDATE Q:STOP
23 Q
24 ;
25SCREEN ;Screen Division Selection
26 N DIV,IEN,INST,CHOICES,CNT,DIR,DIRUT,DUOUT,SITE,ECXINST,DIVNAME
27 N DIVIEN,PARENT,NODE
28 S SITE=+$P($$SITE^VASITE(),U,3) D SIBLING^XUAF4("ECXINST",SITE)
29 S DIVIEN=0,(DIV,CHOICES,DIVNAME)=""
30 S PARENT=$O(ECXINST("P",0)) Q:'PARENT
31 F S DIVIEN=$O(ECXINST("P",PARENT,"C",DIVIEN)) Q:'DIVIEN D
32 .S NODE=ECXINST("P",PARENT,"C",DIVIEN)
33 .S DIVNAME=$P(NODE,U),DIV=$P(NODE,U,2)
34 .Q:DIV'[SITE
35 .;Prepare choices
36 .S CNT=$G(CNT)+1,DIV(CNT)=DIVIEN
37 .S CHOICES=$G(CHOICES)_CNT_":"_DIVNAME_" "_DIV_";"
38 S DIR(0)="S^"_CHOICES
39 S DIR("A")="Select DSS Assigned Division"
40 D ^DIR
41 I $D(DIRUT)!$D(DUOUT) S STOP=1 Q
42 S DSSDIV=DIV(Y)
43 Q
44 ;
45UPDATE ;Update file (#728.46) assigned product field
46 N ECXFDA,ECXERR
47 S ECXFDA(728.46,"?+1,",.01)=DIVISION
48 S ECXFDA(728.46,"?+1,",1)=DSSDIV
49 D UPDATE^DIE("","ECXFDA","","ECXERR")
50 I $D(ECXERR) D
51 .W !!!,"Problem encountered during record update "
52 .W !!,"Contact IRM"_" Error: "_$G(ECXERR("DIERR",1,"TEXT",1))
53 Q
Note: See TracBrowser for help on using the repository browser.