ECXNUTDE.m

ECXNUTDE ;ALB/JRC - Nut Division Worksheet Edit ; 12/15/06 2:01pm

 ;;3.0;DSS EXTRACTS;**92,100**;Dec 22, 1997;Build 2

 ;

EN ;entry point from menu option

 ;Declare variables

 N STOP,DIR,DIRUT,FL,DIC,Y,DIVISION,DSSDIV,DTOUT,DUOUT,FL,DLAYGO

 S STOP=0

 F  D  Q:STOP

 .S DIR(0)="SO^PL:PRODUCTION LOCATION;DL:DELIVERY LOCATION"

 .S DIR("A")="Select location to edit?"

 .D ^DIR I $D(DIRUT) S STOP=1 Q

 .S FL=$S(Y="PL":119.71,Y="DL":119.72,1:"")

 .F  D  Q:STOP

 ..;Select division to edit

 ..S DIC="^ECX(728.46,",DIC(0)="AEQMZL",DLAYGO=728.45

 ..S DIC("A")="Select "_$S(FL=119.71:"Production",1:"Delivery")_" Location to edit: "

 ..S DIC("V")="I +Y(0)="_FL

 ..D ^DIC

 ..I ($D(DTOUT))!($D(DUOUT))!(Y<1) S STOP=1 Q

 ..S DIVISION=$P(Y,U,2)

 ..D SCREEN Q:STOP

 ..D UPDATE Q:STOP

 Q

 ;

SCREEN ;Screen Division Selection

 N DIV,IEN,INST,CHOICES,CNT,DIR,DIRUT,DUOUT,SITE,ECXINST,DIVNAME

 N DIVIEN,PARENT,NODE

 S SITE=+$P($$SITE^VASITE(),U,3) D SIBLING^XUAF4("ECXINST",SITE)

 S DIVIEN=0,(DIV,CHOICES,DIVNAME)=""

 S PARENT=$O(ECXINST("P",0)) Q:'PARENT

 F  S DIVIEN=$O(ECXINST("P",PARENT,"C",DIVIEN)) Q:'DIVIEN  D

 .S NODE=ECXINST("P",PARENT,"C",DIVIEN)

 .S DIVNAME=$P(NODE,U),DIV=$P(NODE,U,2)

 .Q:DIV'[SITE

 .;Prepare choices

 .S CNT=$G(CNT)+1,DIV(CNT)=DIVIEN

 .S CHOICES=$G(CHOICES)_CNT_":"_DIVNAME_" "_DIV_";"

 S DIR(0)="S^"_CHOICES

 S DIR("A")="Select DSS Assigned Division"

 D ^DIR

 I $D(DIRUT)!$D(DUOUT) S STOP=1 Q

 S DSSDIV=DIV(Y)

 Q

 ;

UPDATE ;Update file (#728.46) assigned product field

 N ECXFDA,ECXERR

 S ECXFDA(728.46,"?+1,",.01)=DIVISION

 S ECXFDA(728.46,"?+1,",1)=DSSDIV

 D UPDATE^DIE("","ECXFDA","","ECXERR")

 I $D(ECXERR) D

 .W !!!,"Problem encountered during record update "

 .W !!,"Contact IRM"_"  Error: "_$G(ECXERR("DIERR",1,"TEXT",1))

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ECXNUTDE   1796     printed  Apr 23, 2025@18:07:38                                                                                                                                                                                                    Page 2

ECXNUTDE  ;ALB/JRC - Nut Division Worksheet Edit ; 12/15/06 2:01pm

 +1       ;;3.0;DSS EXTRACTS;**92,100**;Dec 22, 1997;Build 2

 +2       ;

EN        ;entry point from menu option

 +1       ;Declare variables

 +2        NEW STOP,DIR,DIRUT,FL,DIC,Y,DIVISION,DSSDIV,DTOUT,DUOUT,FL,DLAYGO

 +3        SET STOP=0

 +4        FOR 

               Begin DoDot:1

 +5                SET DIR(0)="SO^PL:PRODUCTION LOCATION;DL:DELIVERY LOCATION"

 +6                SET DIR("A")="Select location to edit?"

 +7                DO ^DIR

                   IF $DATA(DIRUT)

                       SET STOP=1

                       QUIT 

 +8                SET FL=$SELECT(Y="PL":119.71,Y="DL":119.72,1:"")

 +9                FOR 

                       Begin DoDot:2

 +10      ;Select division to edit

 +11                       SET DIC="^ECX(728.46,"

                           SET DIC(0)="AEQMZL"

                           SET DLAYGO=728.45

 +12                       SET DIC("A")="Select "_$SELECT(FL=119.71:"Production",1:"Delivery")_" Location to edit: "

 +13                       SET DIC("V")="I +Y(0)="_FL

 +14                       DO ^DIC

 +15                       IF ($DATA(DTOUT))!($DATA(DUOUT))!(Y<1)

                               SET STOP=1

                               QUIT 

 +16                       SET DIVISION=$PIECE(Y,U,2)

 +17                       DO SCREEN

                           if STOP

                               QUIT 

 +18                       DO UPDATE

                           if STOP

                               QUIT 

                       End DoDot:2

                       if STOP

                           QUIT 

               End DoDot:1

               if STOP

                   QUIT 

 +19       QUIT 

 +20      ;

SCREEN    ;Screen Division Selection

 +1        NEW DIV,IEN,INST,CHOICES,CNT,DIR,DIRUT,DUOUT,SITE,ECXINST,DIVNAME

 +2        NEW DIVIEN,PARENT,NODE

 +3        SET SITE=+$PIECE($$SITE^VASITE(),U,3)

           DO SIBLING^XUAF4("ECXINST",SITE)

 +4        SET DIVIEN=0

           SET (DIV,CHOICES,DIVNAME)=""

 +5        SET PARENT=$ORDER(ECXINST("P",0))

           if 'PARENT

               QUIT 

 +6        FOR 

               SET DIVIEN=$ORDER(ECXINST("P",PARENT,"C",DIVIEN))

               if 'DIVIEN

                   QUIT 

               Begin DoDot:1

 +7                SET NODE=ECXINST("P",PARENT,"C",DIVIEN)

 +8                SET DIVNAME=$PIECE(NODE,U)

                   SET DIV=$PIECE(NODE,U,2)

 +9                if DIV'[SITE

                       QUIT 

 +10      ;Prepare choices

 +11               SET CNT=$GET(CNT)+1

                   SET DIV(CNT)=DIVIEN

 +12               SET CHOICES=$GET(CHOICES)_CNT_":"_DIVNAME_" "_DIV_";"

               End DoDot:1

 +13       SET DIR(0)="S^"_CHOICES

 +14       SET DIR("A")="Select DSS Assigned Division"

 +15       DO ^DIR

 +16       IF $DATA(DIRUT)!$DATA(DUOUT)

               SET STOP=1

               QUIT 

 +17       SET DSSDIV=DIV(Y)

 +18       QUIT 

 +19      ;

UPDATE    ;Update file (#728.46) assigned product field

 +1        NEW ECXFDA,ECXERR

 +2        SET ECXFDA(728.46,"?+1,",.01)=DIVISION

 +3        SET ECXFDA(728.46,"?+1,",1)=DSSDIV

 +4        DO UPDATE^DIE("","ECXFDA","","ECXERR")

 +5        IF $DATA(ECXERR)

               Begin DoDot:1

 +6                WRITE !!!,"Problem encountered during record update "

 +7                WRITE !!,"Contact IRM"_"  Error: "_$GET(ECXERR("DIERR",1,"TEXT",1))

               End DoDot:1

 +8        QUIT