source: WorldVistAEHR/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSACON1.m@ 1714

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

initial load of WorldVistAEHR

File size: 1.8 KB
Line 
1PSACON1 ;BIR/LTL-Display Connected Drug and Procurement History - CONT'D ;7/23/97
2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;; 10/24/97
3 ;This routine is call by PSACON.
4 ;
5VEN N PSALN,PSAPG,PSARPDT S (PSA(7),PSAPG,PSAOUT)=0
6 S Y=DT X ^DD("DD") S PSARPDT=Y D HEADER
7 F S PSA(7)=$O(^PRC(441,+PSA(1),2,PSA(7))) Q:'PSA(7) S ^TMP("PSA",$J,(9999999-$P($G(^PRC(441,+PSA(1),2,+PSA(7),0)),U,6)),PSA(7))=$G(^PRC(441,+PSA(1),2,+PSA(7),0))
8 S (PSA(7),PSA(77))=0
9 F S PSA(7)=$O(^TMP("PSA",$J,PSA(7))) Q:PSAOUT!('PSA(7)) D:$Y+4>IOSL HEADER Q:PSAOUT F S PSA(77)=$O(^TMP("PSA",$J,+PSA(7),PSA(77))) Q:PSAOUT!('PSA(77)) D
10 .S PSA(66)=$G(^TMP("PSA",$J,+PSA(7),+PSA(77)))
11 .S PSA(4)=$$UNITCODE^PRCPUX1($P($G(PSA(66)),U,7))
12 .W !!,$E($$VENNAME^PRCPUX1(PSA(77)_"PRC(440"),1,20)
13 .W ?22,$P($G(PSA(66)),U,8),"/",PSA(4)
14 .W ?32,"$",$J($P($G(PSA(66)),U,2),7,2),"/",PSA(4)
15 .W ?45,"$",$J($P($G(PSA(66)),U,2)/PSA(5),7,3),"/",PSA(8)
16 .S Y=$P($G(PSA(66)),U,6) X ^DD("DD")
17 .W ?60,Y
18 .I $O(^PRC(440,+PSA(77),4,0)) S PSA(55)=0 F S PSA(55)=$O(^PRC(440,+PSA(77),4,PSA(55))) Q:'PSA(55) S:$P($G(^PRC(440,+PSA(77),4,+PSA(55),0)),U,2)'<DT PSA(44)=1
19 .W:$G(PSA(44)) ?73,"YES" K PSA(44)
20 I $E(IOST)'="C" W @IOF
21 I $E(IOST,1,2)="C-",'PSAOUT S DIR(0)="EA",DIR("A")="END OF LIST! Press <RET> to return to the option." W ! D ^DIR K DIR S:Y<1 PSAOUT=1
22 D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" K IO("Q") D HOME^%ZIS
23 K ^TMP("PSA",$J) Q
24HEADER I $E(IOST,1,2)'="P-",PSAPG S DIR(0)="E" D ^DIR K DIR I 'Y S PSAOUT=1 Q
25 I $$S^%ZTLOAD W !!,"Task #",$G(ZTSK),", ",$G(ZTDESC)," was stopped by ",$P($G(^VA(200,+$G(DUZ),0)),U),"." S PSAOUT=1 Q
26 W:$Y @IOF S $P(PSALN,"-",81)="",PSAPG=PSAPG+1
27 W !,$E($$DESCR^PRCPUX1(0,PSA(1)),1,45),?50,PSARPDT,?70,"PAGE: ",PSAPG,!,PSALN,!,"VENDOR",?23,"PKG",?32,"COST/PKG",?45,"COST/UNIT",?60,"PRICE DATE CONTRACT",!,PSALN
28 Q
Note: See TracBrowser for help on using the repository browser.