- 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 Apr 23, 2025@18:20:35 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
