source: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPRPH1.m@ 736

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

initial load of FOIAVistA 6/30/08 version

File size: 2.5 KB
Line 
1PRCPRPH1 ;WISC/RFJ-physical count form for prim and sec (cont);02 Feb 93 ; 3/22/99 11:30am
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7DQ ;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
38Q K ^TMP($J,"PRCPRPH"),^TMP($J,"PRCPRPHP") D ^%ZISC Q
39 ;
40 ;
41H 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
Note: See TracBrowser for help on using the repository browser.