ECXNUTDP.m

ECXNUTDP ;ALB/JRC - Nut Division Worksheet Print ; 2/18/09 1:47pm

 ;;3.0;DSS EXTRACTS;**92,104,119**;Dec 22, 1997;Build 19

 ;

EN ;entry point from option

 ;Queue Report

 N ZTDESC,ZTIO,ZTSAVE

 S ZTIO=""

 S ZTDESC="Nutrition Division Worksheet for DSS"

 D EN^XUTMDEVQ("EN1^ECXNUTDP",ZTDESC,.ZTSAVE)

 Q

EN1 ;Tasked entry point

 ;Declare variables

 N STOP,PAGENUM,LN,LTYPE

 S (STOP,PAGENUM,LTYPE)=0,LN=""

 K ^TMP($J)

 F LTYPE="119.71","119.72" D  I STOP D EXIT Q

 .D HEADER I STOP D EXIT Q

 .D GETDATA

 .I '$D(^TMP($J,"ECX",LTYPE)) D  Q

 ..W !

 ..W !,"***********************************************"

 ..W !,"*  NOTHING TO REPORT FOR "_$S(LTYPE=119.71:"PRODUCTION LOCATIONS",LTYPE=119.72:"DELIVERY LOCATIONS  ",1:"")_" *"

 ..W !,"***********************************************"

 ..D WAIT

 .D DETAIL I STOP D EXIT Q

 .D FOOTER I STOP D EXIT Q

 .D WAIT Q:STOP

 .K ^TMP($J)

EXIT K ^TMP("ECXDSS",$J)

 Q

GETDATA ;Get data

 ;Init variables

 N DIV,IEN,PLIEN,IENS,LOCATION,CNT,PDIV,FILE

 S (DIV,LOCATION,PDIV)="",(IEN,PLIEN,IENS,CNT)=0

 S DIV="" F  S DIV=$O(^ECX(728.46,"B",DIV)) Q:DIV=""  D

 . ;Q:LTYPE'=$E(DIV,6,11)

 . Q:LTYPE'=$E($P(DIV,"(",2),1,6)

 . S IEN=$O(^ECX(728.46,"B",DIV,0)) Q:'IEN  D

 .. ;S PLIEN=$P(DIV,";",1),FILE=$E(DIV,6,11),CNT=$G(CNT)+1

 .. S PLIEN=$P(DIV,";",1),FILE=$E($P(DIV,"(",2),1,6),CNT=$G(CNT)+1

 .. I FILE'=LTYPE Q

 .. S IENS=""_PLIEN_","_""

 .. S LOCATION=$$GET1^DIQ(FILE,""_IENS_","_"",.01,"E")

 .. S PDIV=$$GET1^DIQ(728.46,IEN,1,"I")

 .. S PDIV=$$RADDIV^ECXDEPT(PDIV)

 .. S ^TMP($J,"ECX",FILE)="1"

 .. S ^TMP($J,"ECX",FILE,PLIEN)=PLIEN_U_LOCATION_U_PDIV

 Q

HEADER ;print header

 N TYPE

 S PAGENUM=$G(PAGENUM)+1

 S $P(LN,"=",9)="",TYPE=$S(LTYPE=119.71:"PRODUCTION",LTYPE=119.72:"DELIVERY",1:"")

 W @IOF

 W ?1,"RUN DATE: ",$$FMTE^XLFDT(DT,"5H"),?70,"PAGE ",PAGENUM

 W !,?23,"NUTRITION DIVISION WORKSHEET"

 W !!,?27,TYPE_" LOCATIONS"

 W:TYPE="DELIVERY" !!,?2,TYPE

 W:TYPE="PRODUCTION" !!,?1,TYPE

 W ?26,TYPE,?50,"ASSIGNED"

 W !,?1,"LOCATION #",?26,"LOCATIONS",?50,"DIVISION"

 W !,?1,LN_"===",?26,LN,LN,?47,LN,LN

 Q

 ;

DETAIL ;Print detailed line

 ;Input  :  ^TMP("ECXDSS",$J) full global reference

 ;                    PLIEN    - File 119.71 or 119.72 IEN

 ;                    LOCATION - File 119.71 or 119.72 NAME

 ;                    DIVISION - Assigned production division

 ;Output  : None

 N TYPE,FILE,NODE,PIEN,CNT,X1,X2

 S TYPE=$S(LTYPE=119.71:"PRODUCTION",1:"DELIVERY LOCATIONS")

 S FILE=0 F  S FILE=$O(^TMP($J,"ECX",FILE)) Q:'FILE!STOP  D

 .S PIEN=0 F  S PIEN=$O(^TMP($J,"ECX",FILE,PIEN)) Q:'PIEN!STOP  D

 ..S NODE=^TMP($J,"ECX",FILE,PIEN)

 ..W !?3,$$RJ^XLFSTR($P(NODE,U),U,6),?26,$P(NODE,U,2),?50,$$RJ^XLFSTR($P(NODE,U,3),U,6)

 ..I $Y>(IOSL-5) D WAIT Q:STOP  D HEADER

 ..Q

 S CNT=0

 W !!,"The following "_TYPE_" are missing in the DSS Worksheets"

 W !!?3,TYPE,?26,"INACTIVE FLAG",!?3,"----",?26,"-------------",!

 F IEN=0:0 S IEN=$O(^FH(LTYPE,IEN)) Q:'IEN  D

 . I '$D(^ECX(728.46,"B",IEN_";FH("_LTYPE_",")) D

 .. S X1=$$GET1^DIQ(LTYPE,""_IEN_","_"",.01,"E")

 .. S X2=$$GET1^DIQ(LTYPE,IEN,99,"E")

 .. W !?3,X1,?26,X2 S CNT=CNT+1

 I CNT=0 W !!?3,"NOTHING TO REPORT... YOUR FILES ARE CLEAN!"

 Q

 ;

WAIT ;End of page logic

 ;Input   ; None

 ;Output  ; STOP - Flag indicating if printing should continue

 ;                 1 = Stop     0 = Continue

 ;

 S STOP=0

 ;CRT - Prompt for continue

 I $E(IOST,1,2)="C-"&(IOSL'>24) D  Q

 .F  Q:$Y>(IOSL-3)  W !

 .N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT

 .S DIR(0)="E"

 .D ^DIR

 .S STOP=$S(Y'=1:1,1:0)

 ;Background task - check taskman

 S STOP=$$S^%ZTLOAD()

 I STOP D

 .W !,"*********************************************"

 .W !,"*  PRINTING OF REPORT STOPPED AS REQUESTED  *"

 .W !,"*********************************************"

 Q

FOOTER ;Print footer

 N DIV,IEN

 S DIV="",IEN=0

 W !!!,?1,"INSTITUTION",!,"FILE/DIVISIONS",!,LN,LN

 F  S DIV=$O(^DG(40.8,"B",DIV)) Q:DIV=""!STOP  D

 .F  S IEN=$O(^DG(40.8,"B",DIV,IEN)) Q:'IEN!STOP  D  Q:STOP

 ..W !,?3,$$RJ^XLFSTR($$GETDIV^ECXDEPT(IEN),U,8)

 ..I $Y>(IOSL-5) D WAIT Q:STOP  D HEADER,FHEADER

 Q

FHEADER ;Footer header

 W !!!,?1,"INSTITUTION",!,"FILE/DIVISIONS",!,LN,LN

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ECXNUTDP   4198     printed  Mar 13, 2025@20:57:51                                                                                                                                                                                                    Page 2

ECXNUTDP  ;ALB/JRC - Nut Division Worksheet Print ; 2/18/09 1:47pm

 +1       ;;3.0;DSS EXTRACTS;**92,104,119**;Dec 22, 1997;Build 19

 +2       ;

EN        ;entry point from option

 +1       ;Queue Report

 +2        NEW ZTDESC,ZTIO,ZTSAVE

 +3        SET ZTIO=""

 +4        SET ZTDESC="Nutrition Division Worksheet for DSS"

 +5        DO EN^XUTMDEVQ("EN1^ECXNUTDP",ZTDESC,.ZTSAVE)

 +6        QUIT 

EN1       ;Tasked entry point

 +1       ;Declare variables

 +2        NEW STOP,PAGENUM,LN,LTYPE

 +3        SET (STOP,PAGENUM,LTYPE)=0

           SET LN=""

 +4        KILL ^TMP($JOB)

 +5        FOR LTYPE="119.71","119.72"

               Begin DoDot:1

 +6                DO HEADER

                   IF STOP

                       DO EXIT

                       QUIT 

 +7                DO GETDATA

 +8                IF '$DATA(^TMP($JOB,"ECX",LTYPE))

                       Begin DoDot:2

 +9                        WRITE !

 +10                       WRITE !,"***********************************************"

 +11                       WRITE !,"*  NOTHING TO REPORT FOR "_$SELECT(LTYPE=119.71:"PRODUCTION LOCATIONS",LTYPE=119.72:"DELIVERY LOCATIONS  ",1:"")_" *"

 +12                       WRITE !,"***********************************************"

 +13                       DO WAIT

                       End DoDot:2

                       QUIT 

 +14               DO DETAIL

                   IF STOP

                       DO EXIT

                       QUIT 

 +15               DO FOOTER

                   IF STOP

                       DO EXIT

                       QUIT 

 +16               DO WAIT

                   if STOP

                       QUIT 

 +17               KILL ^TMP($JOB)

               End DoDot:1

               IF STOP

                   DO EXIT

                   QUIT 

EXIT       KILL ^TMP("ECXDSS",$JOB)

 +1        QUIT 

GETDATA   ;Get data

 +1       ;Init variables

 +2        NEW DIV,IEN,PLIEN,IENS,LOCATION,CNT,PDIV,FILE

 +3        SET (DIV,LOCATION,PDIV)=""

           SET (IEN,PLIEN,IENS,CNT)=0

 +4        SET DIV=""

           FOR 

               SET DIV=$ORDER(^ECX(728.46,"B",DIV))

               if DIV=""

                   QUIT 

               Begin DoDot:1

 +5       ;Q:LTYPE'=$E(DIV,6,11)

 +6                if LTYPE'=$EXTRACT($PIECE(DIV,"(",2),1,6)

                       QUIT 

 +7                SET IEN=$ORDER(^ECX(728.46,"B",DIV,0))

                   if 'IEN

                       QUIT 

                   Begin DoDot:2

 +8       ;S PLIEN=$P(DIV,";",1),FILE=$E(DIV,6,11),CNT=$G(CNT)+1

 +9                    SET PLIEN=$PIECE(DIV,";",1)

                       SET FILE=$EXTRACT($PIECE(DIV,"(",2),1,6)

                       SET CNT=$GET(CNT)+1

 +10                   IF FILE'=LTYPE

                           QUIT 

 +11                   SET IENS=""_PLIEN_","_""

 +12                   SET LOCATION=$$GET1^DIQ(FILE,""_IENS_","_"",.01,"E")

 +13                   SET PDIV=$$GET1^DIQ(728.46,IEN,1,"I")

 +14                   SET PDIV=$$RADDIV^ECXDEPT(PDIV)

 +15                   SET ^TMP($JOB,"ECX",FILE)="1"

 +16                   SET ^TMP($JOB,"ECX",FILE,PLIEN)=PLIEN_U_LOCATION_U_PDIV

                   End DoDot:2

               End DoDot:1

 +17       QUIT 

HEADER    ;print header

 +1        NEW TYPE

 +2        SET PAGENUM=$GET(PAGENUM)+1

 +3        SET $PIECE(LN,"=",9)=""

           SET TYPE=$SELECT(LTYPE=119.71:"PRODUCTION",LTYPE=119.72:"DELIVERY",1:"")

 +4        WRITE @IOF

 +5        WRITE ?1,"RUN DATE: ",$$FMTE^XLFDT(DT,"5H"),?70,"PAGE ",PAGENUM

 +6        WRITE !,?23,"NUTRITION DIVISION WORKSHEET"

 +7        WRITE !!,?27,TYPE_" LOCATIONS"

 +8        if TYPE="DELIVERY"

               WRITE !!,?2,TYPE

 +9        if TYPE="PRODUCTION"

               WRITE !!,?1,TYPE

 +10       WRITE ?26,TYPE,?50,"ASSIGNED"

 +11       WRITE !,?1,"LOCATION #",?26,"LOCATIONS",?50,"DIVISION"

 +12       WRITE !,?1,LN_"===",?26,LN,LN,?47,LN,LN

 +13       QUIT 

 +14      ;

DETAIL    ;Print detailed line

 +1       ;Input  :  ^TMP("ECXDSS",$J) full global reference

 +2       ;                    PLIEN    - File 119.71 or 119.72 IEN

 +3       ;                    LOCATION - File 119.71 or 119.72 NAME

 +4       ;                    DIVISION - Assigned production division

 +5       ;Output  : None

 +6        NEW TYPE,FILE,NODE,PIEN,CNT,X1,X2

 +7        SET TYPE=$SELECT(LTYPE=119.71:"PRODUCTION",1:"DELIVERY LOCATIONS")

 +8        SET FILE=0

           FOR 

               SET FILE=$ORDER(^TMP($JOB,"ECX",FILE))

               if 'FILE!STOP

                   QUIT 

               Begin DoDot:1

 +9                SET PIEN=0

                   FOR 

                       SET PIEN=$ORDER(^TMP($JOB,"ECX",FILE,PIEN))

                       if 'PIEN!STOP

                           QUIT 

                       Begin DoDot:2

 +10                       SET NODE=^TMP($JOB,"ECX",FILE,PIEN)

 +11                       WRITE !?3,$$RJ^XLFSTR($PIECE(NODE,U),U,6),?26,$PIECE(NODE,U,2),?50,$$RJ^XLFSTR($PIECE(NODE,U,3),U,6)

 +12                       IF $Y>(IOSL-5)

                               DO WAIT

                               if STOP

                                   QUIT 

                               DO HEADER

 +13                       QUIT 

                       End DoDot:2

               End DoDot:1

 +14       SET CNT=0

 +15       WRITE !!,"The following "_TYPE_" are missing in the DSS Worksheets"

 +16       WRITE !!?3,TYPE,?26,"INACTIVE FLAG",!?3,"----",?26,"-------------",!

 +17       FOR IEN=0:0

               SET IEN=$ORDER(^FH(LTYPE,IEN))

               if 'IEN

                   QUIT 

               Begin DoDot:1

 +18               IF '$DATA(^ECX(728.46,"B",IEN_";FH("_LTYPE_","))

                       Begin DoDot:2

 +19                       SET X1=$$GET1^DIQ(LTYPE,""_IEN_","_"",.01,"E")

 +20                       SET X2=$$GET1^DIQ(LTYPE,IEN,99,"E")

 +21                       WRITE !?3,X1,?26,X2

                           SET CNT=CNT+1

                       End DoDot:2

               End DoDot:1

 +22       IF CNT=0

               WRITE !!?3,"NOTHING TO REPORT... YOUR FILES ARE CLEAN!"

 +23       QUIT 

 +24      ;

WAIT      ;End of page logic

 +1       ;Input   ; None

 +2       ;Output  ; STOP - Flag indicating if printing should continue

 +3       ;                 1 = Stop     0 = Continue

 +4       ;

 +5        SET STOP=0

 +6       ;CRT - Prompt for continue

 +7        IF $EXTRACT(IOST,1,2)="C-"&(IOSL'>24)

               Begin DoDot:1

 +8                FOR 

                       if $Y>(IOSL-3)

                           QUIT 

                       WRITE !

 +9                NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT

 +10               SET DIR(0)="E"

 +11               DO ^DIR

 +12               SET STOP=$SELECT(Y'=1:1,1:0)

               End DoDot:1

               QUIT 

 +13      ;Background task - check taskman

 +14       SET STOP=$$S^%ZTLOAD()

 +15       IF STOP

               Begin DoDot:1

 +16               WRITE !,"*********************************************"

 +17               WRITE !,"*  PRINTING OF REPORT STOPPED AS REQUESTED  *"

 +18               WRITE !,"*********************************************"

               End DoDot:1

 +19       QUIT 

FOOTER    ;Print footer

 +1        NEW DIV,IEN

 +2        SET DIV=""

           SET IEN=0

 +3        WRITE !!!,?1,"INSTITUTION",!,"FILE/DIVISIONS",!,LN,LN

 +4        FOR 

               SET DIV=$ORDER(^DG(40.8,"B",DIV))

               if DIV=""!STOP

                   QUIT 

               Begin DoDot:1

 +5                FOR 

                       SET IEN=$ORDER(^DG(40.8,"B",DIV,IEN))

                       if 'IEN!STOP

                           QUIT 

                       Begin DoDot:2

 +6                        WRITE !,?3,$$RJ^XLFSTR($$GETDIV^ECXDEPT(IEN),U,8)

 +7                        IF $Y>(IOSL-5)

                               DO WAIT

                               if STOP

                                   QUIT 

                               DO HEADER

                               DO FHEADER

                       End DoDot:2

                       if STOP

                           QUIT 

               End DoDot:1

 +8        QUIT 

FHEADER   ;Footer header

 +1        WRITE !!!,?1,"INSTITUTION",!,"FILE/DIVISIONS",!,LN,LN

 +2        QUIT