source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPAGRG.m@ 1710

Last change on this file since 1710 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.1 KB
RevLine 
[613]1PRCPAGRG ;WISC/RFJ-autogen print items with groups not selected ;01 Dec 92
2 ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7NOGROUP ; print groups not selected
8 N %,%H,%I,DESCNSN,GNM,ITEMDA,NOW,PAGE,SCREEN,X,Y
9 D NOW^%DTC S Y=% D DD^%DT S NOW=Y,PAGE=1,SCREEN=$$SCRPAUSE^PRCPUREP U IO D H
10 S GNM="" F S GNM=$O(^TMP($J,"PRCPAG","NOG",GNM)) Q:GNM=""!($G(PRCPFLAG)) D
11 . W !!?7,"GROUP: ",$S(GNM=" ":"<< GROUP NOT DEFINED >>",1:GNM),!
12 . S DESCNSN="" F S DESCNSN=$O(^TMP($J,"PRCPAG","NOG",GNM,DESCNSN)) Q:DESCNSN="" S ITEMDA=0 F S ITEMDA=$O(^TMP($J,"PRCPAG","NOG",GNM,DESCNSN,ITEMDA)) Q:'ITEMDA!($G(PRCPFLAG)) D
13 . . W !,ITEMDA,?7,$E($$DESCR^PRCPUX1(PRCP("I"),ITEMDA),1,54) W:PRCP("DPTYPE")="W" ?63,$$NSN^PRCPUX1(ITEMDA)
14 . . I $Y>(IOSL-5) D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG) D H
15 I $G(PRCPFLAG) Q
16 D END^PRCPUREP
17 Q
18 ;
19 ;
20H S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
21 W $C(13),"AUTO-GENERATION GROUPS AND ITEMS NOT SELECTED",?(80-$L(%)),%,!?5,"FOR INVENTORY POINT: ",PRCP("IN"),!,"MI#",?7,"DESCRIPTION" W:PRCP("DPTYPE")="W" ?63,"NSN" S %="",$P(%,"-",81)="" W !,%
22 Q
Note: See TracBrowser for help on using the repository browser.