source: FOIAVistA/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSACON.m@ 1267

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

initial load of FOIAVistA 6/30/08 version

File size: 3.2 KB
Line 
1PSACON ;BIR/LTL-Display Connected Drug and Procurement History ;7/23/97
2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**15**; 10/24/97
3 ;References to $$DESCR^PRCPUX1 are covered by IA #259
4 ;References to ^DIC(51.5 are covered by IA #1931
5 ;References to $$NSN^PRCPUX1 are covered by IA #259
6 ;References to $$UNITCODE^PRCPUX1 are covered by IA #259
7 ;References to $$UNITVAL^PRCPUX1 are covered by IA #259
8 ;References to $$VENNAME^PRCPUX1 are covered by IA #259
9 ;References to ^PSDRUG( are covered by IA #2095
10 ;References to ^PRC( are covered by IA #214
11 ;References to ^PRCP( are covered by IA #214
12 ;
13 N DA,DIC,DTOUT,DUOUT,PSA,PSACON,PSAW,X,Y
14 D DT^DICRW
15 F S DIC="^PSDRUG(",DIC(0)="AEMQZ",DIC("S")="I $S('$D(^(""I"")):1,+^(""I"")>DT:1,1:0)",DIC("W")="W:'$O(^(441,0)) ?65,""NOT CONNECTED""" W ! D ^DIC K DA,DIC G:Y<0 END S PSA=+Y D G:Y<0 END G:$G(PSAW) ^PSACONW D:$G(PSACON) ^PSACON1 D ^PSACON2
16 .W @IOF,!!,$P($G(^PSDRUG(+PSA,0)),U),!!,?25,"** FROM THE DRUG FILE **",!!
17 .W "FSN: ",$P($G(^PSDRUG(+PSA,0)),U,6),?40,"NDC: ",$P($G(^PSDRUG(+PSA,2)),U,4),!!
18 .S PSA(5)=$S($P($G(^PSDRUG(+PSA,660)),U,5):$P($G(^(660)),U,5),1:1)
19 .S PSA(6)=$P($G(^DIC(51.5,+$P($G(^PSDRUG(+PSA,660)),U,2),0)),U)
20 .W "PACKAGING: ",PSA(5),"/",PSA(6)
21 .S PSA(8)=$P($G(^PSDRUG(+PSA,660)),U,8)
22 .W ?20,"PRICE: $",$P($G(^PSDRUG(+PSA,660)),U,3),"/",PSA(6)
23 .W ?40,"PRICE/DISPENSE UNIT: $",$P($G(^PSDRUG(+PSA,660)),U,6),"/",PSA(8)
24 .S PSA(15)=$O(^PSDRUG(+PSA,441,0)),PSA(1)=$G(^(+PSA(15),0))
25 .;more than one item linked
26 .D:$O(^PSDRUG(+PSA,441,PSA(15))) Q:Y<0 K DIC,DA
27 ..W !!,"There is more than one item linked to this drug.",!
28 ..S DIC="^PSDRUG(+PSA,441,",DIC(0)="AEQ",DA(1)=+PSA
29 ..S DIC("W")="W ?10,$$DESCR^PRCPUX1(0,$G(^(0)))"
30 ..D ^DIC Q:Y<0 S PSA(1)=$G(^PSDRUG(+PSA,441,+Y,0)) K DIC,DA
31 .I 'PSA(1) S Y=-1 Q
32 .D:PSA(1) Q:$D(DTOUT)!($D(DUOUT))
33 ..W !!?25,"<< FROM THE ITEM MASTER FILE >>",!!
34 ..S PSA(11)=$G(^PRC(441,+PSA(1),0))
35 ..W "ITEM #: ",PSA(1),?15,$$DESCR^PRCPUX1(0,PSA(1)),!!
36 ..W "NSN: ",$$NSN^PRCPUX1(PSA(1))
37 ..I $P($G(^PRC(440,+$P(PSA(11),U,8),0)),U,11)="S" S PSAW=$O(^PRCP(445,"AC","W","")) Q
38 ..S PSA(3)=$O(^PRC(441,+PSA(1),2,0))
39 ..I PSA(3)&('$O(^PRC(441,+PSA(1),2,+PSA(3)))) D Q
40 ...W ?40,"ONLY VENDOR: ",$E($$VENNAME^PRCPUX1(+PSA(3)_"PRC(440"),1,28),!!
41 ...S PSA(33)=$G(^PRC(441,+PSA(1),2,+PSA(3),0))
42 ...W "VENDOR STOCK #: ",$P(PSA(33),U,4)
43 ...W ?40,"NDC: ",$P(PSA(33),U,5),!!
44 ...W "PACKAGING: ",$$UNITVAL^PRCPUX1($P(PSA(33),U,8),$P(PSA(33),U,7))
45 ...W ?20,"PRICE: $",$P(PSA(33),U,2),"/",$$UNITCODE^PRCPUX1($P(PSA(33),U,7))
46 ...W ?40,"PRICE/DISPENSE UNIT: $",$P(PSA(33),U,2)/PSA(5)
47 ...W !!,"MINIMUM ORDER: ",$P(PSA(33),U,12)
48 ...S Y=$P(PSA(33),U,6) X ^DD("DD")
49 ...S Y=$E(Y,1,4)_$S($L(Y)=10:$E(Y,7,10),$L(Y)=11:$E(Y,8,11),1:"")
50 ...W ?20,"PRICE DATE: ",Y
51 ...W ?40,"REQUIRED ORDER MULTIPLE: ",$P(PSA(33),U,11),!!
52 ..W !!,"LAST VENDOR ORDERED: ",$$VENNAME^PRCPUX1($P(PSA(11),U,4)_"PRC(440"),!!
53 ..W "MANDATORY SOURCE: ",$$VENNAME^PRCPUX1($P(PSA(11),U,8)_"PRC(440"),!
54 ..K IO("Q") N %ZIS,IOP,POP S %ZIS="Q",%ZIS("A")="For Vendor listing, please select DEVICE: " D ^%ZIS I POP S DTOUT=1,Y=-1 W !,"NO DEVICE SELECTED OR OUTPUT PRINTED!" Q
55 ..I $D(IO("Q")) N ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTDTH,ZTSK S ZTRTN="^PSACON1",ZTDESC="DRUG VENDORS",ZTSAVE("PSA*")="" D ^%ZTLOAD,HOME^%ZIS S Y=1 Q
56 ..S (DTOUT,PSACON)=1 Q
57END K PSAOUT Q
Note: See TracBrowser for help on using the repository browser.