ECXNUTPE ;ALB/JRC - Nut Product Worksheet Edit ; 9/4/09 9:01am
;;3.0;DSS EXTRACTS;**92,112,119**;Dec 22, 1997;Build 19
;
EN ;entry point from menu option
;Declare variables
N STOP,DIC,DIE,DTOUT,DUOUT,Y,DA,DR,SCREEN,SCREEN1,CATEGORY,DIET,PRODUCT,CAT,FL,FL1,DLAYGO
S STOP=0
F D Q:STOP
.;Select diet category
.S DIC="^ECX(728.45,",DIC(0)="AEQMZL",DLAYGO=728.45
.D ^DIC
.I ($D(DTOUT))!($D(DUOUT))!(Y<1) S STOP=1 Q
.W " ",Y(0,0)
.S SCREEN=$E($P(Y(0,0)," "),1)_$E($P(Y(0,0)," ",2),1)
.S CATEGORY=$P(Y,U,2)
.S CAT=+Y
.S FL1=Y(0)
.S FL=$S(FL1="PD":116.2,FL1="SF":118,FL1="SO":118.3,FL1="TF":118.2,1:"")
.F D Q:STOP
SUB ..;Select category subentry
..W !!,"IEN from file #"_FL_" can be used with ` in front ",!,"instead of entering Name of Diet. Diet Name can also be entered.",!
..S SCREEN1=SCREEN K SCREEN
..S DIC=FL,DIC(0)="AEQMZ"
..D ^DIC
..I ($D(DTOUT))!($D(DUOUT))!(Y<1) S STOP=1 Q
..S DIET=+Y_";FH("_FL_","
..I ($D(DTOUT))!($D(DUOUT)) S STOP=1 Q
..D CHOICES
..I $G(PRODUCT)']"" W !,"No Product selected. So, no updating done at this time.",!
..Q:STOP
..D:$G(PRODUCT)]"" UPDATE
Q
;
CHOICES ;Prepare CHOICES variable for DIR call
; Input - screen (Required)
;
; Output - Array of choices
; 1 Regular
; 2 Clear Liqs
;Init variables
N CHOICES,OFF,TEXT,DSSCAT,DSSPRO,CNT,DIR,DIRUT,DUOUT,X,Y
S CHOICES="",SCREEN=SCREEN1
F OFF=1:1 S TEXT=$P($T(PRODUCTS+OFF^ECXNUTPP),";;",2) Q:TEXT="END" D
.S DSSCAT=$P(TEXT,U),DSSPRO=$P(TEXT,U,2)
.Q:DSSCAT'=SCREEN
.S CNT=$G(CNT)+1
.S CHOICES=$G(CHOICES)_CNT_":"_DSSPRO_";"
S DIR(0)="S^"_CHOICES
S DIR("A")="Select DSS Assigned Product"
D ^DIR
I $D(DIRUT)!$D(DUOUT) S STOP=1 Q
S PRODUCT=Y(0)
Q
;
UPDATE ;Update file (#728.45) assigned product field
N ECXFDA,ECXERR
S ECXFDA(728.45,"?1,",.01)=CATEGORY
S ECXFDA(728.451,"?+2,?1,",.01)=DIET
S ECXFDA(728.451,"?+2,?1,",1)=PRODUCT
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[HECXNUTPE 2140 printed Apr 09, 2024@20:55:10 Page 2
ECXNUTPE ;ALB/JRC - Nut Product Worksheet Edit ; 9/4/09 9:01am
+1 ;;3.0;DSS EXTRACTS;**92,112,119**;Dec 22, 1997;Build 19
+2 ;
EN ;entry point from menu option
+1 ;Declare variables
+2 NEW STOP,DIC,DIE,DTOUT,DUOUT,Y,DA,DR,SCREEN,SCREEN1,CATEGORY,DIET,PRODUCT,CAT,FL,FL1,DLAYGO
+3 SET STOP=0
+4 FOR
Begin DoDot:1
+5 ;Select diet category
+6 SET DIC="^ECX(728.45,"
SET DIC(0)="AEQMZL"
SET DLAYGO=728.45
+7 DO ^DIC
+8 IF ($DATA(DTOUT))!($DATA(DUOUT))!(Y<1)
SET STOP=1
QUIT
+9 WRITE " ",Y(0,0)
+10 SET SCREEN=$EXTRACT($PIECE(Y(0,0)," "),1)_$EXTRACT($PIECE(Y(0,0)," ",2),1)
+11 SET CATEGORY=$PIECE(Y,U,2)
+12 SET CAT=+Y
+13 SET FL1=Y(0)
+14 SET FL=$SELECT(FL1="PD":116.2,FL1="SF":118,FL1="SO":118.3,FL1="TF":118.2,1:"")
+15 FOR
Begin DoDot:2
SUB ;Select category subentry
+1 WRITE !!,"IEN from file #"_FL_" can be used with ` in front ",!,"instead of entering Name of Diet. Diet Name can also be entered.",!
+2 SET SCREEN1=SCREEN
KILL SCREEN
+3 SET DIC=FL
SET DIC(0)="AEQMZ"
+4 DO ^DIC
+5 IF ($DATA(DTOUT))!($DATA(DUOUT))!(Y<1)
SET STOP=1
QUIT
+6 SET DIET=+Y_";FH("_FL_","
+7 IF ($DATA(DTOUT))!($DATA(DUOUT))
SET STOP=1
QUIT
+8 DO CHOICES
+9 IF $GET(PRODUCT)']""
WRITE !,"No Product selected. So, no updating done at this time.",!
+10 if STOP
QUIT
+11 if $GET(PRODUCT)]""
DO UPDATE
End DoDot:2
if STOP
QUIT
End DoDot:1
if STOP
QUIT
+12 QUIT
+13 ;
CHOICES ;Prepare CHOICES variable for DIR call
+1 ; Input - screen (Required)
+2 ;
+3 ; Output - Array of choices
+4 ; 1 Regular
+5 ; 2 Clear Liqs
+6 ;Init variables
+7 NEW CHOICES,OFF,TEXT,DSSCAT,DSSPRO,CNT,DIR,DIRUT,DUOUT,X,Y
+8 SET CHOICES=""
SET SCREEN=SCREEN1
+9 FOR OFF=1:1
SET TEXT=$PIECE($TEXT(PRODUCTS+OFF^ECXNUTPP),";;",2)
if TEXT="END"
QUIT
Begin DoDot:1
+10 SET DSSCAT=$PIECE(TEXT,U)
SET DSSPRO=$PIECE(TEXT,U,2)
+11 if DSSCAT'=SCREEN
QUIT
+12 SET CNT=$GET(CNT)+1
+13 SET CHOICES=$GET(CHOICES)_CNT_":"_DSSPRO_";"
End DoDot:1
+14 SET DIR(0)="S^"_CHOICES
+15 SET DIR("A")="Select DSS Assigned Product"
+16 DO ^DIR
+17 IF $DATA(DIRUT)!$DATA(DUOUT)
SET STOP=1
QUIT
+18 SET PRODUCT=Y(0)
+19 QUIT
+20 ;
UPDATE ;Update file (#728.45) assigned product field
+1 NEW ECXFDA,ECXERR
+2 SET ECXFDA(728.45,"?1,",.01)=CATEGORY
+3 SET ECXFDA(728.451,"?+2,?1,",.01)=DIET
+4 SET ECXFDA(728.451,"?+2,?1,",1)=PRODUCT
+5 DO UPDATE^DIE("","ECXFDA","","ECXERR")
+6 IF $DATA(ECXERR)
Begin DoDot:1
+7 WRITE !!!,"Problem encountered during record update "
+8 WRITE !!,"Contact IRM"_" Error: "_$GET(ECXERR("DIERR",1,"TEXT",1))
End DoDot:1
+9 QUIT
