| 1 | PRCPRDCR ;WISC/RFJ-dietetics cost report ;27 May 93
|
|---|
| 2 | ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | D ^PRCPUSEL Q:'$G(PRCP("I"))
|
|---|
| 5 | N %,%H,%I,DATEEND,DATESTRT,INVPT,PRCPFLAG,PRCPIN,X,Y
|
|---|
| 6 | K X S X(1)="The Dietetic Cost Report is sorted by the inventory point (selectable), food group from the item master file, NSN, and date received (selectable)." D DISPLAY^PRCPUX2(40,79,.X)
|
|---|
| 7 | K X S X(1)="You can select multiple dietetic inventory points for printing this report. A dietetic inventory point is defined as a primary inventory point with the first two digits of the department number equal to '11'."
|
|---|
| 8 | D DISPLAY^PRCPUX2(5,40,.X)
|
|---|
| 9 | K ^TMP($J,"PRCPRDIE") S PRCPIN=PRCP("IN")
|
|---|
| 10 | S PRCPIN="" I $E($P($G(^PRCP(445,PRCP("I"),0)),"^",8),1,2)="11" S PRCPIN=PRCP("IN")
|
|---|
| 11 | F S INVPT=$$INVPT^PRCPUINV(PRC("SITE"),"P",0,1,PRCPIN) S:INVPT["^" PRCPFLAG=1 Q:'INVPT D
|
|---|
| 12 | . S PRCPIN=""
|
|---|
| 13 | . I $E($P($G(^PRCP(445,+INVPT,0)),"^",8),1,2)'="11" W !?2,"CANNOT BE SELECTED. FIRST TWO DIGITS OF DEPARTMENT NUMBER NOT EQUAL TO '11'." Q
|
|---|
| 14 | . S ^TMP($J,"PRCPRDIE",INVPT)=""
|
|---|
| 15 | I $G(PRCPFLAG) D Q Q
|
|---|
| 16 | I '$O(^TMP($J,"PRCPRDIE",0)) Q
|
|---|
| 17 | W !
|
|---|
| 18 | K X S X(1)="Select the range of RECEIPT DATES to display" W !! D DISPLAY^PRCPUX2(5,40,.X)
|
|---|
| 19 | D DATESEL^PRCPURS2("Receipt") I '$G(DATEEND) D Q Q
|
|---|
| 20 | W ! S %ZIS="Q" D ^%ZIS G:POP Q I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK D Q Q
|
|---|
| 21 | . S ZTDESC="Dietetic Cost Report",ZTRTN="DQ^PRCPRDCR"
|
|---|
| 22 | . S ZTSAVE("PRCP*")="",ZTSAVE("DATE*")="",ZTSAVE("^TMP($J,""PRCPRDIE"",")="",ZTSAVE("ZTREQ")="@"
|
|---|
| 23 | W !!,"<*> please wait <*>"
|
|---|
| 24 | DQ ; queue starts here
|
|---|
| 25 | D START^PRCPRDC0
|
|---|
| 26 | Q D ^%ZISC K ^TMP($J,"PRCPRDIE"),^TMP($J,"PRCPRDIET")
|
|---|
| 27 | Q
|
|---|
