- 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 Mar 13, 2025@20:57:52 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
