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 ---[H[J[2J[HECXNUTDE 1796 printed Nov 22, 2024@17:03:20 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
