| 1 | PRCPAGU1 ;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 | ;
|
|---|
| 7 | DELTEMP(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 | ;
|
|---|
| 13 | OPTIONAL ; 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 | ;
|
|---|
| 24 | REPORTS ; 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 <*>"
|
|---|
| 57 | DQ ; 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
|
|---|
| 64 | Q D ^%ZISC Q
|
|---|
