Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ECXNUTPP

ECXNUTPP.m

Go to the documentation of this file. 
  1. ECXNUTPP ;ALB/JRC - Nut Production Worksheet Print ; 4/12/09 11:31pm
  1.  ;;3.0;DSS EXTRACTS;**92,119**;Dec 22, 1997;Build 19
  1.  ;
  1. EN ;entry point from option
  1.  ;Queue Report
  1.  N ZTDESC,ZTIO,ZTSAVE
  1.  S ZTIO=""
  1.  S ZTDESC="Nutrition Division Worksheet for DSS"
  1.  D EN^XUTMDEVQ("EN1^ECXNUTPP",ZTDESC,.ZTSAVE)
  1.  Q
  1. EN1 ;Tasked entry point
  1.  ;Declare variables
  1.  N STOP,PAGE,TDIET,TTDIET,LTYPE,LN
  1.  S (STOP,PAGE,LTYPE)=0,(TDIET)=""
  1.  K ^TMP($J)
  1.  F  S TDIET=$O(^ECX(728.45,"B",TDIET)) Q:TDIET=""!STOP  D
  1.  .S IEN=0,IEN=$O(^ECX(728.45,"B",TDIET,IEN))
  1.  .S TTDIET=$$GET1^DIQ(728.45,IEN,.01)
  1.  .D HEADER I STOP D EXIT Q
  1.  .D GETDATA I STOP D EXIT Q
  1.  .I '$O(^TMP($J,"ECX",0)) D  Q
  1.  ..W !
  1.  ..W !,"***********************************************************"
  1.  ..W !,"*  NOTHING TO REPORT FOR "_TTDIET_" CATEGORY",?58,"*"
  1.  ..W !,"***********************************************************"
  1.  ..D WAIT
  1.  .D DETAIL I STOP D EXIT Q
  1.  .D FOOTER I STOP D EXIT Q
  1.  .D WAIT I STOP D EXIT Q
  1.  .K ^TMP($J,"ECX")
  1.  D FILECHK
  1. EXIT K ^TMP($J,"ECX")
  1.  Q
  1. GETDATA ;Get data
  1.  ;Init variables
  1.  N IEN,DIET,EDIET,DIEN,IENS,PRODUCT
  1.  S (IEN,DIET,EDIET,DIEN,IENS,PRODUCT)=""
  1.  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
  1.  .S IENS=""_DIEN_","_IEN_","_""
  1.  .S PRODUCT=$$GET1^DIQ(728.451,IENS,1,"E")
  1.  .S EDIET=$$GET1^DIQ(728.451,IENS,.01,"E")
  1.  .S ^TMP($J,"ECX",IEN)=""
  1.  .S ^TMP($J,"ECX",IEN,DIEN)=EDIET_U_PRODUCT
  1.  Q
  1.  S PAGE=$G(PAGE)+1
  1.  S $P(LN,"=",15)=""
  1.  W @IOF
  1.  W ?1,"RUN DATE: ",$$FMTE^XLFDT(DT,"5H"),?70,"PAGE ",PAGE
  1.  W !,?23,"NUTRITION PRODUCT WORKSHEET"
  1.  W !!,?27,TTDIET
  1.  W !!,?1,$P(TTDIET," ",1),?36,"ASSIGNED"
  1.  W !,?1,$P(TTDIET," ",2),?36,"PRODUCT"
  1.  W !,?1,LN,?36,LN
  1.  Q
  1.  ;
  1. DETAIL ;Print detailed line
  1.  ;Input  :  ^TMP("ECXDSS",$J) full global reference
  1.  ;                    DIET - File 116.2, 118, 118.2, 118.3, NAME
  1.  ;                    PRODUCT - Assigned DSS product
  1.  ;Output  : None
  1.  ;
  1.  N NUMBER,RECORD,NODE
  1.  S (NUMBER,RECORD)=0,NODE=""
  1.  F  S NUMBER=$O(^TMP($J,"ECX",NUMBER)) Q:'NUMBER!STOP  D
  1.  .F  S RECORD=$O(^TMP($J,"ECX",NUMBER,RECORD)) Q:'RECORD!STOP  D
  1.  ..S NODE=$G(^TMP($J,"ECX",NUMBER,RECORD))
  1.  ..W !,?1,$P(NODE,U),?36,$P(NODE,U,2)
  1.  ..I $Y>(IOSL-5) D WAIT Q:STOP  D HEADER
  1.  .Q
  1.  Q
  1.  ;
  1. WAIT ;End of page logic
  1.  ;Input   ; None
  1.  ;Output  ; STOP - Flag indicating if printing should continue
  1.  ;                 1 = Stop     0 = Continue
  1.  ;
  1.  S STOP=0
  1.  ;CRT - Prompt for continue
  1.  I $E(IOST,1,2)="C-"&(IOSL'>24) D  Q
  1.  .F  Q:$Y>(IOSL-3)  W !
  1.  .N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1.  .S DIR(0)="E"
  1.  .D ^DIR
  1.  .S STOP=$S(Y'=1:1,1:0)
  1.  ;Background task - check taskman
  1.  S STOP=$$S^%ZTLOAD()
  1.  I STOP D
  1.  .W !,"*********************************************"
  1.  .W !,"*  PRINTING OF REPORT STOPPED AS REQUESTED  *"
  1.  .W !,"*********************************************"
  1.  Q
  1.  ;
  1.  N SCREEN
  1.  S SCREEN=$E($P(TTDIET," ",1),1,1)_$E($P(TTDIET," ",2),1,1)
  1.  D FHEADER
  1.  D DSSPRO
  1.  Q
  1.  ;
  1. FHEADER ;Footer header
  1.  W !,?1,"DSS PRODUCTS",!,?1,LN
  1.  Q
  1.  ;
  1. DSSPRO ;DSS standardized products
  1.  N OFF,TEXT,DSSCAT,DSSPRO
  1.  F OFF=1:1 S TEXT=$P($T(PRODUCTS+OFF),";;",2) Q:TEXT="END"!STOP  D
  1.  .S DSSCAT=$P(TEXT,U),DSSPRO=$P(TEXT,U,2)
  1.  .Q:DSSCAT'=SCREEN
  1.  .W !,?1,DSSPRO
  1.  .I $Y>(IOSL-5) D WAIT Q:STOP  D HEADER,FHEADER
  1.  Q
  1.  ;
  1. FILECHK ;check files for missing diets
  1.  N CNT,IEN,X1,X2,FILE,TYPE,NAME,TYP
  1.  D HEADER2
  1.  F TYPE="PD","SF","SO","TF" D
  1.  . S TYP=$O(^ECX(728.45,"B",TYPE,0))
  1.  . S CNT=0
  1.  . W !!!
  1.  . S FILE=$S(TYPE="PD":116.2,TYPE="SF":118,TYPE="TF":118.2,TYPE="SO":118.3)
  1.  . F IEN=0:0 S IEN=$O(^FH(FILE,IEN)) Q:'IEN  D
  1.  .. I '$D(^ECX(728.45,+$G(TYP),1,"B",IEN_";FH("_FILE_",")) D
  1.  ... S X1=$$GET1^DIQ(FILE,IEN,.01,"E")
  1.  ... S X2=$$GET1^DIQ(FILE,IEN,99,"E")
  1.  ...W !?3,X1,"   (",IEN,")",?50,TYPE,?56,X2 S CNT=CNT+1
  1.  ...I $Y>(IOSL-5) D HEADER2
  1.  . I CNT=0 W !?3,"NOTHING TO REPORT FOR "_TYPE_" DIET."
  1.  Q
  1. HEADER2 ;header for file check
  1.  S PAGE=$G(PAGE)+1
  1.  W @IOF
  1.  W !!,"THE FOLLOWING DIETS ARE MISSING FROM DSS WORKSHEETS",?70,"PAGE ",PAGE,!
  1.  W !?3,"DIET",?50,"DIET",?56,"INACTIVE"
  1.  W !,?50,"TYPE",?58,"FLAG"
  1.  W !?3,"----",?50,"----",?56,"--------",!
  1.  Q
  1. PRODUCTS ;Standardized assigned products for nutrition diets
  1.  ;;PD^REGULAR
  1.  ;;PD^FULL LIQS
  1.  ;;PD^CLEAR LIQS
  1.  ;;PD^PUREE DYSPH
  1.  ;;SF^SUPP FEED
  1.  ;;SF^SUPP FEED NC
  1.  ;;TF^TF LESS 1
  1.  ;;TF^TF MORE 1
  1.  ;;TF^TF MIX LESS 1
  1.  ;;TF^TF MIX MORE 1
  1.  ;;SO^ST ORDER
  1.  ;;SO^ST ORDER NC
  1.  ;;END