source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCSRIP.m@ 1464

PRCSRIP ;WISC/SAW/BMM-PRINT/DISPLAY ITEMS BY VENDOR FROM REPETITIVE ITEM LIST FILE ;8/18/94  14:24 ;

V ;;5.1;IFCAP;**13,81**;Oct 20, 2000

 ;Per VHA Directive 10-93-142, this routine should not be modified.

 ;

 ;BMM 2/22/05 per PRC*5.1*81 add code to display DM DOC ID and Date

 ;Needed fields for RILs originating in DynaMed

 ;

 S DIC="^PRCS(410.3,",DIC(0)="AEMQ",DIC("S")="S PRC(""SITE"")=+^(0),PRC(""CP"")=+$P(^(0),""-"",4) I $D(^PRC(420,""A"",DUZ,PRC(""SITE""),+PRC(""CP""),1))!($D(^(2)))"

 S DIC("A")="Select REPETITIVE ITEM LIST #: " D ^DIC K DIC("S") I Y'>0 G EXIT

 S D0=+Y G EXIT:$G(^PRCS(410.3,D0,0))=""

 ;

 ;See NOIS MON-0399-51726

 D SORT

 ;

 S %ZIS("B")="HOME",%ZIS="MQ" D ^%ZIS G EXIT:POP I $D(IO("Q")) S ZTRTN="QUE^PRCSRIP",ZTSAVE("D0")="" D ^%ZTLOAD G EXIT

QUE U IO S PRCSNO=$P(^PRCS(410.3,D0,0),"^") D NOW^%DTC S Y=% D DD^%DT S PRCSD=Y

 S (N,PRCSP,PRCSIT,PRCSTC,Z(1))=""

 I $G(ZTRTN)="QUE^PRCSRIP" D SORT ;See NOIS MON-0399-51726

 F J=0:1 S N=$O(^TMP($J,410.3,D0,1,"AC",N)) Q:N=""  D:'J HDRL D:IOSL-($Y#IOSL)<4 HOLD Q:Z(1)=U  D:IOSL-($Y#IOSL)<4 HDRL W !!,"VENDOR: ",$P(N,";")," (",$P(N,";",2),")",! D ITEML

 I 'J W !,"Items have not yet been entered for Repetitive Item List # ",PRCSNO

 I J D:IOSL-($Y#IOSL)<4 HOLD Q:Z(1)=U  D:IOSL-($Y#IOSL)<4 HDRL W !!,"TOTAL # OF ITEMS (ALL VENDORS): ",$J(PRCSIT,4),?40,"TOTAL COST (ALL VENDORS): ",$J(PRCSTC,9,2)

 I (IO'=IO(0))!($D(ZTQUEUED)) D ^%ZISC

 G EXIT

 ;

ITEML ;PRC*5.1*81 redirect to ITEML1D instead of ITEML1 if a DynaMed RIL

 ;

 N PRCVDF,PRCVDN

 S (N(1),PRCSC,PRCVDF,PRCVDN)=""

 ;check Inventory flag

 S PRCVDF=$$GET^XPAR("SYS","PRCV COTS INVENTORY",1,"Q")

 F K=0:1 S N(1)=$O(^TMP($J,410.3,D0,1,"AC",N,N(1))) Q:N(1)=""  D  Q:Z(1)=U

 . ;PRC*5.1*81 if flag=1 then DM RIL, use different display

 . S PRCVDN=$$GET1^DIQ(410.31,N(1)_","_D0_",",6)

 . I PRCVDF=1,PRCVDN'="" D ITEML1D(PRCVDN) Q

 . D ITEML1

 Q:Z(1)=U  D:IOSL-($Y#IOSL)<3 HDRL W !!,"TOTAL # OF ITEMS: ",$J(K,4),?25,"TOTAL COST: ",$J(PRCSC,9,2),! S L="",$P(L,"-",IOM)="-" W L S L=""

 S PRCSIT=PRCSIT+K,PRCSTC=PRCSTC+PRCSC Q

 ;

ITEML1 I IOSL-($Y#IOSL)<2 D HOLD Q:Z(1)=U  D HDRL W !!,"VENDOR: ",$P(N,";")," (",$P(N,";",2),")",!

 S X=^PRCS(410.3,D0,1,N(1),0) W !,$P(X,"^"),?12 W:$D(^PRC(441,$P(X,"^"),0)) $E($P(^(0),"^",2),1,42) W ?54,$S($P(X,"^",2)[".":$J($P(X,"^",2),9,2),1:$J($P(X,"^",2),9)),?66,$J($P(X,"^",4),9,2)

 I $D(^PRC(441,$P(X,"^"),2,+$P(X,"^",5),0)) W ?78,$S($D(^PRCD(420.5,+$P(^(0),"^",7),0)):$P(^(0),"^"),1:"")

 S PRCSC=PRCSC+($P(X,"^",2)*($P(X,"^",4))) Q

 ;

HOLD Q:IO'=IO(0)!($D(ZTQUEUED))  S Z(1)="" W !,"Press return to continue, uparrow (^) to exit: " R Z(1):DTIME S:'$T Z(1)=U Q

HDRL S PRCSP=PRCSP+1 W @IOF,"REPETITIVE ITEM LIST #: ",PRCSNO,?50,"DATE: ",PRCSD,"  PAGE ",PRCSP

 W !,"ITEM NO.",?12,"SHORT DESCRIPTION",?55,"QUANTITY",?66,"UNIT COST",?77,"U/P",! S L="",$P(L,"-",IOM)="-" W L S L=""

 Q

 ;

SORT ;See NOIS MON-0399-51726

 KILL ^TMP($J)

 N II,FF S II=0

 F  S II=$O(^PRCS(410.3,D0,1,II)) Q:'II  D  ;

 . S FF=$G(^PRCS(410.3,D0,1,II,0))

 . S ^TMP($J,410.3,D0,1,"AC",$P(FF,"^",3)_";"_$P(FF,"^",5),II)=""

 Q

 ;

EXIT K %,%DT,%ZIS,D0,DIC,I,J,K,L,N,PRCSC,PRCSD,PRCSIT,PRCSNO,PRCSP,PRCSTC

 K PRCS,X,Y,Z,IEN410,^TMP($J) Q

 ;

ITEML1D(PRCVDN) ;PRC*5.1*81

 ;display items from DynaMed RIL, include DM Doc ID and

 ;Date Needed

 ;PRCVDN is DM Doc ID

 ;

 N PRCVED,PRCVFMD

 I IOSL-($Y#IOSL)<2 D HOLD Q:Z(1)=U  D HDRL W !!,"VENDOR: ",$P(N,";")," (",$P(N,";",2),")",!

 S X=^PRCS(410.3,D0,1,N(1),0) W !,$P(X,"^"),?12 W:$D(^PRC(441,$P(X,"^"),0)) $E($P(^(0),"^",2),1,42) W ?54,$S($P(X,"^",2)[".":$J($P(X,"^",2),9,2),1:$J($P(X,"^",2),9)),?66,$J($P(X,"^",4),9,2)

 I $D(^PRC(441,$P(X,"^"),2,+$P(X,"^",5),0)) W ?78,$S($D(^PRCD(420.5,+$P(^(0),"^",7),0)):$P(^(0),"^"),1:"")

 ;S PRCVFMD=$$HL7TFM^XLFDT($P(X,"^",8))

 S PRCVED=$$FMTE^XLFDT($P(X,"^",8))

 W !,"DM DOC ID: ",$P(X,"^",7),?45,"DATE NEEDED BY: ",PRCVED

 S PRCSC=PRCSC+($P(X,"^",2)*($P(X,"^",4)))

 Q

 ;