PRCHCLN ;WISC/AKS-Routine to correct Food Groups in Item Master file ;7/7/93 09:35
;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
K ^TMP($J) N N,FLG,FGRP,PRC,%,HDRFLG,M,POP,PRCHDT,PRCHDY,PRCHPAGE,PRCHPDAT,X,Y,ZTDESC,ZTDTH,ZTRTN,ZTSAVE,C,PRCHPDAT
W !!,"This option will loop through your 'ITEM MASTER' file and correct any Food Group",!,"that it can i.e. from 01 to 1, 02 to 2 etc. If it finds any Food Group for which",!
W "the correct Food Group can not be determined, it will print the report."
S N="" F S N=$O(^PRC(441,N)) Q:N=""!(N'?1.N) I $P($G(^PRC(441,N,3)),U,7)]"" S FLG=0,FGRP=$P(^(3),U,7) S:((+FGRP>0)&(+FGRP<7)) $P(^PRC(441,N,3),U,7)=+FGRP,FLG=1 S:'FLG ^TMP($J,N)=FGRP
I '$D(^TMP($J)) W !!,"No items with 'Uncorrectable' Food Groups have been found." Q
I $D(^TMP($J)) S ZTRTN="EN^PRCHCLN" W !!,"Some items in your 'ITEM MASTER' file have invalid Food Groups that the system cannot correct. Select a device to print the list of those items."
W ! D SELDEV^PRCHUTL1 Q:POP Q:'$D(IO(0)) Q:IO(0)=IO
S M="Generate Invalid Food Groups report" D ENRDAT^PRCHUTL1 Q:X["^"
S ZTDTH=PRCHPDAT,ZTDESC="Report of items with invalid Food Group"
K ZTSAVE S ZTSAVE("PRC*")="",ZTSAVE("U")="",ZTSAVE("DUZ*")="",ZTSAVE("^TMP($J,")=""
D ^%ZTLOAD,ENK3^PRCHUTL1 Q
EN ;
D NOW^%DTC S Y=$P(%,"."),PRCHDT=% D DD^%DT S PRCHPDAT=Y S M=0,PRCHPAGE=0,PRCHDY=0,HDRFLG=0 F S M=$O(^TMP($J,M)) Q:M="" G Q:$$S^%ZTLOAD D:'HDRFLG!(PRCHDY>(IOSL-5)) HDR D
.W !," ",$J(M,8)," ---------------------- ",^TMP($J,M) S PRCHDY=PRCHDY+1
G Q
HDR S PRCHPAGE=PRCHPAGE+1 W @IOF,"Report Of Invalid Food Groups",?57,PRCHPDAT,?73,"PAGE ",PRCHPAGE,!
W "-------------------------------------------------------------------------------- ",!
W " ITEM NO. FOOD GROUP",! S PRCHDY=PRCHDY+3
S HDRFLG=1
QUIT
Q I $$S^%ZTLOAD W !,$$SQUE^PRCHUTL1($T(+0)),!
K ^TMP($J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHCLN 1948 printed Dec 13, 2024@02:06:06 Page 2
PRCHCLN ;WISC/AKS-Routine to correct Food Groups in Item Master file ;7/7/93 09:35
+1 ;;5.1;IFCAP;;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 KILL ^TMP($JOB)
NEW N,FLG,FGRP,PRC,%,HDRFLG,M,POP,PRCHDT,PRCHDY,PRCHPAGE,PRCHPDAT,X,Y,ZTDESC,ZTDTH,ZTRTN,ZTSAVE,C,PRCHPDAT
+4 WRITE !!,"This option will loop through your 'ITEM MASTER' file and correct any Food Group",!,"that it can i.e. from 01 to 1, 02 to 2 etc. If it finds any Food Group for which",!
+5 WRITE "the correct Food Group can not be determined, it will print the report."
+6 SET N=""
FOR
SET N=$ORDER(^PRC(441,N))
if N=""!(N'?1.N)
QUIT
IF $PIECE($GET(^PRC(441,N,3)),U,7)]""
SET FLG=0
SET FGRP=$PIECE(^(3),U,7)
if ((+FGRP>0)&(+FGRP<7))
SET $PIECE(^PRC(441,N,3),U,7)=+FGRP
SET FLG=1
if 'FLG
SET ^TMP($JOB,N)=FGRP
+7 IF '$DATA(^TMP($JOB))
WRITE !!,"No items with 'Uncorrectable' Food Groups have been found."
QUIT
+8 IF $DATA(^TMP($JOB))
SET ZTRTN="EN^PRCHCLN"
WRITE !!,"Some items in your 'ITEM MASTER' file have invalid Food Groups that the system cannot correct. Select a device to print the list of those items."
+9 WRITE !
DO SELDEV^PRCHUTL1
if POP
QUIT
if '$DATA(IO(0))
QUIT
if IO(0)=IO
QUIT
+10 SET M="Generate Invalid Food Groups report"
DO ENRDAT^PRCHUTL1
if X["^"
QUIT
+11 SET ZTDTH=PRCHPDAT
SET ZTDESC="Report of items with invalid Food Group"
+12 KILL ZTSAVE
SET ZTSAVE("PRC*")=""
SET ZTSAVE("U")=""
SET ZTSAVE("DUZ*")=""
SET ZTSAVE("^TMP($J,")=""
+13 DO ^%ZTLOAD
DO ENK3^PRCHUTL1
QUIT
EN ;
+1 DO NOW^%DTC
SET Y=$PIECE(%,".")
SET PRCHDT=%
DO DD^%DT
SET PRCHPDAT=Y
SET M=0
SET PRCHPAGE=0
SET PRCHDY=0
SET HDRFLG=0
FOR
SET M=$ORDER(^TMP($JOB,M))
if M=""
QUIT
if $$S^%ZTLOAD
GOTO Q
if 'HDRFLG!(PRCHDY>(IOSL-5))
DO HDR
Begin DoDot:1
+2 WRITE !," ",$JUSTIFY(M,8)," ---------------------- ",^TMP($JOB,M)
SET PRCHDY=PRCHDY+1
End DoDot:1
+3 GOTO Q
HDR SET PRCHPAGE=PRCHPAGE+1
WRITE @IOF,"Report Of Invalid Food Groups",?57,PRCHPDAT,?73,"PAGE ",PRCHPAGE,!
+1 WRITE "-------------------------------------------------------------------------------- ",!
+2 WRITE " ITEM NO. FOOD GROUP",!
SET PRCHDY=PRCHDY+3
+3 SET HDRFLG=1
+4 QUIT
Q IF $$S^%ZTLOAD
WRITE !,$$SQUE^PRCHUTL1($TEXT(+0)),!
+1 KILL ^TMP($JOB)
+2 QUIT
