ECXNUTPP ;ALB/JRC - Nut Production Worksheet Print ; 4/12/09 11:31pm
;;3.0;DSS EXTRACTS;**92,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^ECXNUTPP",ZTDESC,.ZTSAVE)
Q
EN1 ;Tasked entry point
;Declare variables
N STOP,PAGE,TDIET,TTDIET,LTYPE,LN
S (STOP,PAGE,LTYPE)=0,(TDIET)=""
K ^TMP($J)
F S TDIET=$O(^ECX(728.45,"B",TDIET)) Q:TDIET=""!STOP D
.S IEN=0,IEN=$O(^ECX(728.45,"B",TDIET,IEN))
.S TTDIET=$$GET1^DIQ(728.45,IEN,.01)
.D HEADER I STOP D EXIT Q
.D GETDATA I STOP D EXIT Q
.I '$O(^TMP($J,"ECX",0)) D Q
..W !
..W !,"***********************************************************"
..W !,"* NOTHING TO REPORT FOR "_TTDIET_" CATEGORY",?58,"*"
..W !,"***********************************************************"
..D WAIT
.D DETAIL I STOP D EXIT Q
.D FOOTER I STOP D EXIT Q
.D WAIT I STOP D EXIT Q
.K ^TMP($J,"ECX")
D FILECHK
EXIT K ^TMP($J,"ECX")
Q
GETDATA ;Get data
;Init variables
N IEN,DIET,EDIET,DIEN,IENS,PRODUCT
S (IEN,DIET,EDIET,DIEN,IENS,PRODUCT)=""
F S IEN=$O(^ECX(728.45,"B",TDIET,IEN)) Q:'IEN F S DIET=$O(^ECX(728.45,IEN,1,"B",DIET)) Q:DIET="" F S DIEN=$O(^ECX(728.45,IEN,1,"B",DIET,DIEN)) Q:'DIEN D
.S IENS=""_DIEN_","_IEN_","_""
.S PRODUCT=$$GET1^DIQ(728.451,IENS,1,"E")
.S EDIET=$$GET1^DIQ(728.451,IENS,.01,"E")
.S ^TMP($J,"ECX",IEN)=""
.S ^TMP($J,"ECX",IEN,DIEN)=EDIET_U_PRODUCT
Q
S PAGE=$G(PAGE)+1
S $P(LN,"=",15)=""
W @IOF
W ?1,"RUN DATE: ",$$FMTE^XLFDT(DT,"5H"),?70,"PAGE ",PAGE
W !,?23,"NUTRITION PRODUCT WORKSHEET"
W !!,?27,TTDIET
W !!,?1,$P(TTDIET," ",1),?36,"ASSIGNED"
W !,?1,$P(TTDIET," ",2),?36,"PRODUCT"
W !,?1,LN,?36,LN
Q
;
DETAIL ;Print detailed line
;Input : ^TMP("ECXDSS",$J) full global reference
; DIET - File 116.2, 118, 118.2, 118.3, NAME
; PRODUCT - Assigned DSS product
;Output : None
;
N NUMBER,RECORD,NODE
S (NUMBER,RECORD)=0,NODE=""
F S NUMBER=$O(^TMP($J,"ECX",NUMBER)) Q:'NUMBER!STOP D
.F S RECORD=$O(^TMP($J,"ECX",NUMBER,RECORD)) Q:'RECORD!STOP D
..S NODE=$G(^TMP($J,"ECX",NUMBER,RECORD))
..W !,?1,$P(NODE,U),?36,$P(NODE,U,2)
..I $Y>(IOSL-5) D WAIT Q:STOP D HEADER
.Q
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 SCREEN
S SCREEN=$E($P(TTDIET," ",1),1,1)_$E($P(TTDIET," ",2),1,1)
D FHEADER
D DSSPRO
Q
;
W !,?1,"DSS PRODUCTS",!,?1,LN
Q
;
DSSPRO ;DSS standardized products
N OFF,TEXT,DSSCAT,DSSPRO
F OFF=1:1 S TEXT=$P($T(PRODUCTS+OFF),";;",2) Q:TEXT="END"!STOP D
.S DSSCAT=$P(TEXT,U),DSSPRO=$P(TEXT,U,2)
.Q:DSSCAT'=SCREEN
.W !,?1,DSSPRO
.I $Y>(IOSL-5) D WAIT Q:STOP D HEADER,FHEADER
Q
;
FILECHK ;check files for missing diets
N CNT,IEN,X1,X2,FILE,TYPE,NAME,TYP
D HEADER2
F TYPE="PD","SF","SO","TF" D
. S TYP=$O(^ECX(728.45,"B",TYPE,0))
. S CNT=0
. W !!!
. S FILE=$S(TYPE="PD":116.2,TYPE="SF":118,TYPE="TF":118.2,TYPE="SO":118.3)
. F IEN=0:0 S IEN=$O(^FH(FILE,IEN)) Q:'IEN D
.. I '$D(^ECX(728.45,+$G(TYP),1,"B",IEN_";FH("_FILE_",")) D
... S X1=$$GET1^DIQ(FILE,IEN,.01,"E")
... S X2=$$GET1^DIQ(FILE,IEN,99,"E")
...W !?3,X1," (",IEN,")",?50,TYPE,?56,X2 S CNT=CNT+1
...I $Y>(IOSL-5) D HEADER2
. I CNT=0 W !?3,"NOTHING TO REPORT FOR "_TYPE_" DIET."
Q
S PAGE=$G(PAGE)+1
W @IOF
W !!,"THE FOLLOWING DIETS ARE MISSING FROM DSS WORKSHEETS",?70,"PAGE ",PAGE,!
W !?3,"DIET",?50,"DIET",?56,"INACTIVE"
W !,?50,"TYPE",?58,"FLAG"
W !?3,"----",?50,"----",?56,"--------",!
Q
PRODUCTS ;Standardized assigned products for nutrition diets
;;PD^REGULAR
;;PD^FULL LIQS
;;PD^CLEAR LIQS
;;PD^PUREE DYSPH
;;SF^SUPP FEED
;;SF^SUPP FEED NC
;;TF^TF LESS 1
;;TF^TF MORE 1
;;TF^TF MIX LESS 1
;;TF^TF MIX MORE 1
;;SO^ST ORDER
;;SO^ST ORDER NC
;;END
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXNUTPP 4531 printed Dec 13, 2024@01:53:12 Page 2
ECXNUTPP ;ALB/JRC - Nut Production Worksheet Print ; 4/12/09 11:31pm
+1 ;;3.0;DSS EXTRACTS;**92,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^ECXNUTPP",ZTDESC,.ZTSAVE)
+6 QUIT
EN1 ;Tasked entry point
+1 ;Declare variables
+2 NEW STOP,PAGE,TDIET,TTDIET,LTYPE,LN
+3 SET (STOP,PAGE,LTYPE)=0
SET (TDIET)=""
+4 KILL ^TMP($JOB)
+5 FOR
SET TDIET=$ORDER(^ECX(728.45,"B",TDIET))
if TDIET=""!STOP
QUIT
Begin DoDot:1
+6 SET IEN=0
SET IEN=$ORDER(^ECX(728.45,"B",TDIET,IEN))
+7 SET TTDIET=$$GET1^DIQ(728.45,IEN,.01)
+8 DO HEADER
IF STOP
DO EXIT
QUIT
+9 DO GETDATA
IF STOP
DO EXIT
QUIT
+10 IF '$ORDER(^TMP($JOB,"ECX",0))
Begin DoDot:2
+11 WRITE !
+12 WRITE !,"***********************************************************"
+13 WRITE !,"* NOTHING TO REPORT FOR "_TTDIET_" CATEGORY",?58,"*"
+14 WRITE !,"***********************************************************"
+15 DO WAIT
End DoDot:2
QUIT
+16 DO DETAIL
IF STOP
DO EXIT
QUIT
+17 DO FOOTER
IF STOP
DO EXIT
QUIT
+18 DO WAIT
IF STOP
DO EXIT
QUIT
+19 KILL ^TMP($JOB,"ECX")
End DoDot:1
+20 DO FILECHK
EXIT KILL ^TMP($JOB,"ECX")
+1 QUIT
GETDATA ;Get data
+1 ;Init variables
+2 NEW IEN,DIET,EDIET,DIEN,IENS,PRODUCT
+3 SET (IEN,DIET,EDIET,DIEN,IENS,PRODUCT)=""
+4 FOR
SET IEN=$ORDER(^ECX(728.45,"B",TDIET,IEN))
if 'IEN
QUIT
FOR
SET DIET=$ORDER(^ECX(728.45,IEN,1,"B",DIET))
if DIET=""
QUIT
FOR
SET DIEN=$ORDER(^ECX(728.45,IEN,1,"B",DIET,DIEN))
if 'DIEN
QUIT
Begin DoDot:1
+5 SET IENS=""_DIEN_","_IEN_","_""
+6 SET PRODUCT=$$GET1^DIQ(728.451,IENS,1,"E")
+7 SET EDIET=$$GET1^DIQ(728.451,IENS,.01,"E")
+8 SET ^TMP($JOB,"ECX",IEN)=""
+9 SET ^TMP($JOB,"ECX",IEN,DIEN)=EDIET_U_PRODUCT
End DoDot:1
+10 QUIT
+1 SET PAGE=$GET(PAGE)+1
+2 SET $PIECE(LN,"=",15)=""
+3 WRITE @IOF
+4 WRITE ?1,"RUN DATE: ",$$FMTE^XLFDT(DT,"5H"),?70,"PAGE ",PAGE
+5 WRITE !,?23,"NUTRITION PRODUCT WORKSHEET"
+6 WRITE !!,?27,TTDIET
+7 WRITE !!,?1,$PIECE(TTDIET," ",1),?36,"ASSIGNED"
+8 WRITE !,?1,$PIECE(TTDIET," ",2),?36,"PRODUCT"
+9 WRITE !,?1,LN,?36,LN
+10 QUIT
+11 ;
DETAIL ;Print detailed line
+1 ;Input : ^TMP("ECXDSS",$J) full global reference
+2 ; DIET - File 116.2, 118, 118.2, 118.3, NAME
+3 ; PRODUCT - Assigned DSS product
+4 ;Output : None
+5 ;
+6 NEW NUMBER,RECORD,NODE
+7 SET (NUMBER,RECORD)=0
SET NODE=""
+8 FOR
SET NUMBER=$ORDER(^TMP($JOB,"ECX",NUMBER))
if 'NUMBER!STOP
QUIT
Begin DoDot:1
+9 FOR
SET RECORD=$ORDER(^TMP($JOB,"ECX",NUMBER,RECORD))
if 'RECORD!STOP
QUIT
Begin DoDot:2
+10 SET NODE=$GET(^TMP($JOB,"ECX",NUMBER,RECORD))
+11 WRITE !,?1,$PIECE(NODE,U),?36,$PIECE(NODE,U,2)
+12 IF $Y>(IOSL-5)
DO WAIT
if STOP
QUIT
DO HEADER
End DoDot:2
+13 QUIT
End DoDot:1
+14 QUIT
+15 ;
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
+20 ;
+1 NEW SCREEN
+2 SET SCREEN=$EXTRACT($PIECE(TTDIET," ",1),1,1)_$EXTRACT($PIECE(TTDIET," ",2),1,1)
+3 DO FHEADER
+4 DO DSSPRO
+5 QUIT
+6 ;
+1 WRITE !,?1,"DSS PRODUCTS",!,?1,LN
+2 QUIT
+3 ;
DSSPRO ;DSS standardized products
+1 NEW OFF,TEXT,DSSCAT,DSSPRO
+2 FOR OFF=1:1
SET TEXT=$PIECE($TEXT(PRODUCTS+OFF),";;",2)
if TEXT="END"!STOP
QUIT
Begin DoDot:1
+3 SET DSSCAT=$PIECE(TEXT,U)
SET DSSPRO=$PIECE(TEXT,U,2)
+4 if DSSCAT'=SCREEN
QUIT
+5 WRITE !,?1,DSSPRO
+6 IF $Y>(IOSL-5)
DO WAIT
if STOP
QUIT
DO HEADER
DO FHEADER
End DoDot:1
+7 QUIT
+8 ;
FILECHK ;check files for missing diets
+1 NEW CNT,IEN,X1,X2,FILE,TYPE,NAME,TYP
+2 DO HEADER2
+3 FOR TYPE="PD","SF","SO","TF"
Begin DoDot:1
+4 SET TYP=$ORDER(^ECX(728.45,"B",TYPE,0))
+5 SET CNT=0
+6 WRITE !!!
+7 SET FILE=$SELECT(TYPE="PD":116.2,TYPE="SF":118,TYPE="TF":118.2,TYPE="SO":118.3)
+8 FOR IEN=0:0
SET IEN=$ORDER(^FH(FILE,IEN))
if 'IEN
QUIT
Begin DoDot:2
+9 IF '$DATA(^ECX(728.45,+$GET(TYP),1,"B",IEN_";FH("_FILE_","))
Begin DoDot:3
+10 SET X1=$$GET1^DIQ(FILE,IEN,.01,"E")
+11 SET X2=$$GET1^DIQ(FILE,IEN,99,"E")
+12 WRITE !?3,X1," (",IEN,")",?50,TYPE,?56,X2
SET CNT=CNT+1
+13 IF $Y>(IOSL-5)
DO HEADER2
End DoDot:3
End DoDot:2
+14 IF CNT=0
WRITE !?3,"NOTHING TO REPORT FOR "_TYPE_" DIET."
End DoDot:1
+15 QUIT
+1 SET PAGE=$GET(PAGE)+1
+2 WRITE @IOF
+3 WRITE !!,"THE FOLLOWING DIETS ARE MISSING FROM DSS WORKSHEETS",?70,"PAGE ",PAGE,!
+4 WRITE !?3,"DIET",?50,"DIET",?56,"INACTIVE"
+5 WRITE !,?50,"TYPE",?58,"FLAG"
+6 WRITE !?3,"----",?50,"----",?56,"--------",!
+7 QUIT
PRODUCTS ;Standardized assigned products for nutrition diets
+1 ;;PD^REGULAR
+2 ;;PD^FULL LIQS
+3 ;;PD^CLEAR LIQS
+4 ;;PD^PUREE DYSPH
+5 ;;SF^SUPP FEED
+6 ;;SF^SUPP FEED NC
+7 ;;TF^TF LESS 1
+8 ;;TF^TF MORE 1
+9 ;;TF^TF MIX LESS 1
+10 ;;TF^TF MIX MORE 1
+11 ;;SO^ST ORDER
+12 ;;SO^ST ORDER NC
+13 ;;END
