| [613] | 1 | PRCHDP4 ;WISC/RSD/RHD-DISPLAY P.O.(CONT.) ;12/1/93 09:49
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | EN ;ONLINE DISPLAY OF DELIVERY SCHEDULE
|
|---|
| 5 | S PRCHONL=1,PRCHQUIT=0
|
|---|
| 6 | ;
|
|---|
| 7 | EN2 ;ENTRY POINT USED TO EITHER PRINT OR DISPLAY DELIVERY SCHEDULE
|
|---|
| 8 | Q:'$D(D0) S PRCHPONO=$P(^PRC(442,D0,0),U,1),PRCHQUIT="" G:PRCHPONO="" EXDELV K ^TMP($J,"MDEL")
|
|---|
| 9 | F PRCHI=0:0 S PRCHI=$O(^PRC(442.8,"B",PRCHPONO,PRCHI)) Q:'PRCHI I $D(^PRC(442.8,PRCHI,0)) S Y(0)=^(0) D BLD
|
|---|
| 10 | G:'$D(^TMP($J,"MDEL")) EXDELV S L=100
|
|---|
| 11 | F I=0:0 S I=$O(^TMP($J,"MDEL",I)) Q:'I Q:PRCHQUIT S PRCHX=^(I) D PRT1 S PRCHZ="" F J=0:0 S J=$O(^TMP($J,"MDEL",I,J)) Q:'J Q:PRCHQUIT S PRCHY="" F K=0:0 S PRCHY=$O(^TMP($J,"MDEL",I,J,PRCHY)) Q:PRCHY="" S PRCHX=^(PRCHY) D PRT2
|
|---|
| 12 | ;
|
|---|
| 13 | EXDELV W ! K ^TMP($J,"MDEL"),PRCHI,PRCHONL,PRCHPONO,PRCHQUIT,PRCHX,PRCHY,PRCHZ,I,J,K,X,Y,Z,L
|
|---|
| 14 | Q
|
|---|
| 15 | ;
|
|---|
| 16 | BLD S I=+$P(Y(0),U,2) I '$D(^TMP($J,"MDEL",I)) S X=$G(^PRC(442,D0,2,I,0)),J=$O(^PRC(442,D0,2,I,1,0)),K=$S($D(^(+J,0)):^(0),1:""),^TMP($J,"MDEL",I)=$P(X,U,5)_U_+$P(X,U,2)_U_$E(K,1,40)_U_+X
|
|---|
| 17 | ; <<< FOR NOIS PTB-0695-20438
|
|---|
| 18 | ;
|
|---|
| 19 | ; S I=+$P(Y(0),U,2) I '$D(^TMP($J,"MDEL",I)) S J=+$O(^PRC(442,D0,2,"B",I,0)),X=$G(^PRC(442,D0,2,J,0)),J=$O(^PRC(442,D0,2,J,1,0)),K=$S($D(^(+J,0)):^(0),1:""),^TMP($J,"MDEL",I)=+$P(X,U,5)_U_+$P(X,U,2)_U_$E(K,1,40)
|
|---|
| 20 | ;
|
|---|
| 21 | S Y=$P(Y(0),U,3),Y=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3),Z=$P($G(^PRCS(410.8,+$P(Y(0),U,4),0)),U,1) S:Z="" Z=" "
|
|---|
| 22 | S ^TMP($J,"MDEL",I,+$P(Y(0),U,3),Z)=Y_U_$P(Y(0),U,5)
|
|---|
| 23 | Q
|
|---|
| 24 | ;
|
|---|
| 25 | PRT1 D:L>(IOSL-3) PAUSE Q:PRCHQUIT W !,$J($P(PRCHX,U,4),4),?5,$J($P(PRCHX,U),4),?11,$P(PRCHX,U,3),?54,$J($P(PRCHX,U,2),6),! S L=L+2
|
|---|
| 26 | ; <<< FOR NOIS PTB-0695-20438
|
|---|
| 27 | Q
|
|---|
| 28 | ;
|
|---|
| 29 | PRT2 D:L>(IOSL-2) PAUSE Q:PRCHQUIT
|
|---|
| 30 | I PRCHZ'=$P(PRCHX,U,1) S PRCHZ=$P(PRCHX,U,1) W ?31,PRCHZ
|
|---|
| 31 | W ?41,PRCHY,?73,$J($P(PRCHX,U,2),6),!
|
|---|
| 32 | S L=L+1
|
|---|
| 33 | Q
|
|---|
| 34 | ;
|
|---|
| 35 | H W:$Y>0 @IOF W !!,?10,"**** P.O. "_$P(PRCHPONO,"-",2)_" DELIVERY SCHEDULE ****"
|
|---|
| 36 | W:L'=100 ?55,"(CONTINUED)" W !!
|
|---|
| 37 | W "LI#",?5,"IMF# DESCRIPTION",?53,"QTY.ORD",!,?31,"DEL.DATE LOCATION",?72,"DELV.QTY",!
|
|---|
| 38 | S L=5
|
|---|
| 39 | Q
|
|---|
| 40 | ;
|
|---|
| 41 | PAUSE I 'PRCHONL D H Q
|
|---|
| 42 | W !?8,"ENTER '^' TO HALT: " S PRCHQUIT=0 R X:DTIME S:X["^" PRCHQUIT=1 Q:PRCHQUIT D H
|
|---|
| 43 | Q
|
|---|
