| 1 | PRCPRPH1 ;WISC/RFJ-physical count form for prim and sec (cont);02 Feb 93 ; 3/22/99 11:30am
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;
|
|---|
| 7 | DQ ;come here to print report
|
|---|
| 8 | K PRCPFLAG,^TMP($J,"PRCPRPHP")
|
|---|
| 9 | S ITEMDA=0 F S ITEMDA=$O(^PRCP(445,PRCP("I"),1,ITEMDA)) Q:'ITEMDA S GROUP=+$P($G(^(ITEMDA,0)),"^",21) D
|
|---|
| 10 | . I $D(^TMP($J,"PRCPRPH","NO",GROUP)) Q
|
|---|
| 11 | . I GROUP,'$D(GROUPALL),'$D(^TMP($J,"PRCPRPH","YES",GROUP)) Q
|
|---|
| 12 | . I 'GROUP,'$D(GROUPALL) Q
|
|---|
| 13 | . S %=$G(^PRCP(445,PRCP("I"),1,ITEMDA,0)),MAIN=+$P(%,"^",6),MAIN=$$STORELOC^PRCPESTO(MAIN) S:MAIN="?" MAIN=" ?"
|
|---|
| 14 | . S DESCR=$$DESCR^PRCPUX1(PRCP("I"),ITEMDA) S:DESCR="" DESCR=" "
|
|---|
| 15 | . S ^TMP($J,"PRCPRPHP",MAIN,GROUP,$E(DESCR,1,15),ITEMDA)=DESCR_"^"_$$UNIT^PRCPUX1(PRCP("I"),ITEMDA,"/")_"^"_$P(%,"^",7)
|
|---|
| 16 | D NOW^%DTC S Y=% D DD^%DT S NOW=Y,PAGE=1,SCREEN=$$SCRPAUSE^PRCPUREP U IO D H
|
|---|
| 17 | S MAIN="" F S MAIN=$O(^TMP($J,"PRCPRPHP",MAIN)) Q:MAIN=""!($G(PRCPFLAG)) D
|
|---|
| 18 | . W !!?5,"MAIN STORAGE LOCATION: ",MAIN
|
|---|
| 19 | . S GROUP="" F S GROUP=$O(^TMP($J,"PRCPRPHP",MAIN,GROUP)) Q:GROUP=""!($G(PRCPFLAG)) D
|
|---|
| 20 | . . W !?10,"GROUP CATEGORY: ",$$GROUPNM^PRCPEGRP(GROUP)
|
|---|
| 21 | . . S DESCR="" F S DESCR=$O(^TMP($J,"PRCPRPHP",MAIN,GROUP,DESCR)) Q:DESCR=""!($G(PRCPFLAG)) S ITEMDA=0 F S ITEMDA=$O(^TMP($J,"PRCPRPHP",MAIN,GROUP,DESCR,ITEMDA)) Q:'ITEMDA!($G(PRCPFLAG)) S D=^(ITEMDA) D
|
|---|
| 22 | . . . W !,$E($P(D,"^",1),1,40),?42,ITEMDA,?47,$J($P(D,"^",2),10)
|
|---|
| 23 | . . . I PRCPOH=1 W $J($P(D,"^",3),12)
|
|---|
| 24 | . . . W ?71,"_________"
|
|---|
| 25 | . . . S X=0 F Y=1:1 S X=$O(^PRCP(445,PRCP("I"),1,ITEMDA,1,X)) Q:'X S D=$G(^(X,0)) I D'="" D
|
|---|
| 26 | . . . . I Y=1 W !?20,"ADD STORAGE: "
|
|---|
| 27 | . . . . I $X>50 W !?20
|
|---|
| 28 | . . . . W $E($$STORELOC^PRCPESTO($P(D,"^")),1,15)," "
|
|---|
| 29 | . . . . I $Y>(IOSL-4) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
|
|---|
| 30 | . . . I $G(PRCPFLAG) Q
|
|---|
| 31 | . . . I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
|
|---|
| 32 | . . I $G(PRCPFLAG) Q
|
|---|
| 33 | . . I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
|
|---|
| 34 | . . I $G(ZTQUEUED),$$S^%ZTLOAD S PRCPFLAG=1 W !?10,"<<< TASKMANAGER JOB TERMINATED BY USER >>>"
|
|---|
| 35 | . I $G(PRCPFLAG) Q
|
|---|
| 36 | . I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
|
|---|
| 37 | I '$G(PRCPFLAG) D END^PRCPUREP
|
|---|
| 38 | Q K ^TMP($J,"PRCPRPH"),^TMP($J,"PRCPRPHP") D ^%ZISC Q
|
|---|
| 39 | ;
|
|---|
| 40 | ;
|
|---|
| 41 | H S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
|
|---|
| 42 | W $C(13),"PHYSICAL COUNT FORM: ",$E(PRCP("IN"),1,12),?(80-$L(%)),%
|
|---|
| 43 | S %="",$P(%,"-",81)="" W !,"DESCRIPTION",?42,"MI",?50,"UNIT/ISS"
|
|---|
| 44 | I PRCPOH=1 W ?62,"ON HAND"
|
|---|
| 45 | W ?71,"NEW COUNT",!,%
|
|---|
| 46 | Q
|
|---|
