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

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

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1PRCSRIP ;WISC/SAW/BMM-PRINT/DISPLAY ITEMS BY VENDOR FROM REPETITIVE ITEM LIST FILE ;8/18/94 14:24 ;
2V ;;5.1;IFCAP;**13,81**;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;BMM 2/22/05 per PRC*5.1*81 add code to display DM DOC ID and Date
6 ;Needed fields for RILs originating in DynaMed
7 ;
8 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)))"
9 S DIC("A")="Select REPETITIVE ITEM LIST #: " D ^DIC K DIC("S") I Y'>0 G EXIT
10 S D0=+Y G EXIT:$G(^PRCS(410.3,D0,0))=""
11 ;
12 ;See NOIS MON-0399-51726
13 D SORT
14 ;
15 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
16QUE U IO S PRCSNO=$P(^PRCS(410.3,D0,0),"^") D NOW^%DTC S Y=% D DD^%DT S PRCSD=Y
17 S (N,PRCSP,PRCSIT,PRCSTC,Z(1))=""
18 I $G(ZTRTN)="QUE^PRCSRIP" D SORT ;See NOIS MON-0399-51726
19 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
20 I 'J W !,"Items have not yet been entered for Repetitive Item List # ",PRCSNO
21 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)
22 I (IO'=IO(0))!($D(ZTQUEUED)) D ^%ZISC
23 G EXIT
24 ;
25ITEML ;PRC*5.1*81 redirect to ITEML1D instead of ITEML1 if a DynaMed RIL
26 ;
27 N PRCVDF,PRCVDN
28 S (N(1),PRCSC,PRCVDF,PRCVDN)=""
29 ;check Inventory flag
30 S PRCVDF=$$GET^XPAR("SYS","PRCV COTS INVENTORY",1,"Q")
31 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
32 . ;PRC*5.1*81 if flag=1 then DM RIL, use different display
33 . S PRCVDN=$$GET1^DIQ(410.31,N(1)_","_D0_",",6)
34 . I PRCVDF=1,PRCVDN'="" D ITEML1D(PRCVDN) Q
35 . D ITEML1
36 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=""
37 S PRCSIT=PRCSIT+K,PRCSTC=PRCSTC+PRCSC Q
38 ;
39ITEML1 I IOSL-($Y#IOSL)<2 D HOLD Q:Z(1)=U D HDRL W !!,"VENDOR: ",$P(N,";")," (",$P(N,";",2),")",!
40 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)
41 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:"")
42 S PRCSC=PRCSC+($P(X,"^",2)*($P(X,"^",4))) Q
43 ;
44HOLD 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
45HDRL S PRCSP=PRCSP+1 W @IOF,"REPETITIVE ITEM LIST #: ",PRCSNO,?50,"DATE: ",PRCSD," PAGE ",PRCSP
46 W !,"ITEM NO.",?12,"SHORT DESCRIPTION",?55,"QUANTITY",?66,"UNIT COST",?77,"U/P",! S L="",$P(L,"-",IOM)="-" W L S L=""
47 Q
48 ;
49SORT ;See NOIS MON-0399-51726
50 KILL ^TMP($J)
51 N II,FF S II=0
52 F S II=$O(^PRCS(410.3,D0,1,II)) Q:'II D ;
53 . S FF=$G(^PRCS(410.3,D0,1,II,0))
54 . S ^TMP($J,410.3,D0,1,"AC",$P(FF,"^",3)_";"_$P(FF,"^",5),II)=""
55 Q
56 ;
57EXIT K %,%DT,%ZIS,D0,DIC,I,J,K,L,N,PRCSC,PRCSD,PRCSIT,PRCSNO,PRCSP,PRCSTC
58 K PRCS,X,Y,Z,IEN410,^TMP($J) Q
59 ;
60ITEML1D(PRCVDN) ;PRC*5.1*81
61 ;display items from DynaMed RIL, include DM Doc ID and
62 ;Date Needed
63 ;PRCVDN is DM Doc ID
64 ;
65 N PRCVED,PRCVFMD
66 I IOSL-($Y#IOSL)<2 D HOLD Q:Z(1)=U D HDRL W !!,"VENDOR: ",$P(N,";")," (",$P(N,";",2),")",!
67 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)
68 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:"")
69 ;S PRCVFMD=$$HL7TFM^XLFDT($P(X,"^",8))
70 S PRCVED=$$FMTE^XLFDT($P(X,"^",8))
71 W !,"DM DOC ID: ",$P(X,"^",7),?45,"DATE NEEDED BY: ",PRCVED
72 S PRCSC=PRCSC+($P(X,"^",2)*($P(X,"^",4)))
73 Q
74 ;
Note: See TracBrowser for help on using the repository browser.