source: FOIAVistA/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPAGU1.m@ 1607

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

initial load of FOIAVistA 6/30/08 version
File size: 3.1 KB
Line 
1PRCPAGU1 ;WISC/RFJ-autogenerate utilities ;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 ;
7DELTEMP(V1,V2) ; delete temp stock level for invpt v1, item v2
8 I '$D(^PRCP(445,+V1,1,+V2,0)) Q
9 N D0,DA,DIE,DR,X,Y
10 S V1=+V1,V2=+V2,DIE="^PRCP(445,"_V1_",1,",DA(1)=V1,DA=V2,DR="9.5///@;9.6///@" D ^DIE Q
11 ;
12 ;
13OPTIONAL ; check for vendors with items only at optional reorder point
14 ; do not order optional reorder point if vendor not ordering
15 ; using standard reorder point
16 N DESCNSN,GNM,ITEMDA,VDA,VNM
17 S VNM="" F S VNM=$O(^TMP($J,"PRCPAG","OK",VNM)) Q:VNM="" S VDA=0 F S VDA=$O(^TMP($J,"PRCPAG","OK",VNM,VDA)) Q:'VDA I '$D(^TMP($J,"PRCPAG","V+",VDA,"STA")) D
18 . S GNM="" F S GNM=$O(^TMP($J,"PRCPAG","OK",VNM,VDA,GNM)) Q:GNM="" S DESCNSN="" F S DESCNSN=$O(^TMP($J,"PRCPAG","OK",VNM,VDA,GNM,DESCNSN)) Q:DESCNSN="" D
19 . . S ITEMDA=0 F S ITEMDA=$O(^TMP($J,"PRCPAG","OK",VNM,VDA,GNM,DESCNSN,ITEMDA)) Q:'ITEMDA S ^TMP($J,"PRCPAG","NOT",VNM,VDA,GNM,DESCNSN,ITEMDA)=^TMP($J,"PRCPAG","OK",VNM,VDA,GNM,DESCNSN,ITEMDA),TOTITEMS=TOTITEMS-1
20 . K ^TMP($J,"PRCPAG","OK",VNM,VDA)
21 Q
22 ;
23 ;
24REPORTS ; ask to print reports
25 N %,PRCPERR,PRCPFLAG,PRCPNOG,PRCPNOV,PRCPNOT
26 I $O(^TMP($J,"PRCPAG","ER",""))'="" D Q:$G(PRCPFLAG)
27 . S XP="Do you want to print errors occurring during auto-generation",XH="Enter 'YES' to print the error report, 'NO' to skip printing it, '^' to exit."
28 . W ! S %=$$YN^PRCPUYN(1)
29 . I %=2 Q
30 . I %=1 S PRCPERR=1 Q
31 . S PRCPFLAG=1
32 I $O(^TMP($J,"PRCPAG","NOV",""))'="" D Q:$G(PRCPFLAG)
33 . S XP="Do you want to print items with vendors not selected",XH="Enter 'YES' to print items with vendors not selected report,",XH(1)=" 'NO' to skip printing it, '^' to exit."
34 . W ! S %=$$YN^PRCPUYN(1)
35 . I %=2 Q
36 . I %=1 S PRCPNOV=1 Q
37 . S PRCPFLAG=1
38 I $O(^TMP($J,"PRCPAG","NOG",""))'="" D Q:$G(PRCPFLAG)
39 . S XP="Do you want to print items with groups not selected",XH="Enter 'YES' to print items with groups not selected report,",XH(1)=" 'NO' to skip printing it, '^' to exit."
40 . W ! S %=$$YN^PRCPUYN(1)
41 . I %=2 Q
42 . I %=1 S PRCPNOG=1 Q
43 . S PRCPFLAG=1
44 I $O(^TMP($J,"PRCPAG","NOT",""))'="" D Q:$G(PRCPFLAG)
45 . S XP="Do you want to print items which were not ordered",XH="Enter 'YES' to print the items not ordered, 'NO' to skip printing it, '^' to exit."
46 . W ! S %=$$YN^PRCPUYN(1)
47 . I %=2 Q
48 . I %=1 S PRCPNOT=1 Q
49 . S PRCPFLAG=1
50 ;
51 I $O(^TMP($J,"PRCPAG","OK",""))="",'$G(PRCPERR),'$G(PRCPNOG),'$G(PRCPNOV),'$G(PRCPNOT) Q
52 S %ZIS="Q" D ^%ZIS Q:POP I $D(IO("Q")) D D ^%ZISC Q
53 . S ZTDESC="Auto-Generate "_PRCP("IN"),ZTRTN="DQ^PRCPAGU1"
54 . S ZTSAVE("PRCP*")="",ZTSAVE("^TMP($J,")="",ZTSAVE("ZTREQ")="@"
55 . D ^%ZTLOAD K IO("Q"),ZTSK
56 W !!,"<*> please wait <*>"
57DQ ; queue comes here to print reports
58 K PRCPFLAG
59 I $O(^TMP($J,"PRCPAG","OK",""))'="" D ORDER^PRCPAGRO I $G(PRCPFLAG) D Q Q
60 I $G(PRCPERR) D ERROR^PRCPAGRE I $G(PRCPFLAG) D Q Q
61 I $G(PRCPNOV) D NOVEND^PRCPAGRV I $G(PRCPFLAG) D Q Q
62 I $G(PRCPNOG) D NOGROUP^PRCPAGRG I $G(PRCPFLAG) D Q Q
63 I $G(PRCPNOT) D ITEMSNOT^PRCPAGRI
64Q D ^%ZISC Q
Note: See TracBrowser for help on using the repository browser.