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
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
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
W !!!,?1,"INSTITUTION",!,"FILE/DIVISIONS",!,LN,LN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXNUTDP 4198 printed Dec 13, 2024@01:53:10 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
+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
+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
+1 WRITE !!!,?1,"INSTITUTION",!,"FILE/DIVISIONS",!,LN,LN
+2 QUIT
