| [613] | 1 | PSACON2 ;BIR/LTL-Display Connected Drug and Procurement History - CONT'D ;7/23/97
|
|---|
| 2 | ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**15**; 10/24/97
|
|---|
| 3 | ;This routine is called by PSACON.
|
|---|
| 4 | ;
|
|---|
| 5 | ;References to $$UNITCODE^PRCPUX1 are covered by IA #259
|
|---|
| 6 | ;References to $$VENNAME^PRCPUX1 are covered by IA #259
|
|---|
| 7 | ;References to ^PSDRUG( are covered by IA #2095
|
|---|
| 8 | ;References to ^PRC( are covered by IA #214
|
|---|
| 9 | ;
|
|---|
| 10 | Q:'$O(^PRC(441,+PSA(1),4,0))!($G(PSAOUT))
|
|---|
| 11 | HIS K PSACON N DIRUT,PSADT,PSAOUT,PSAB,PSAD,PSAQ S (PSA(9),PSAOUT)=0
|
|---|
| 12 | I PSA(1) F S PSA(9)=$O(^PRC(441,+PSA(1),4,PSA(9))) Q:'PSA(9) S:$O(^PRC(441,+PSA(1),4,+PSA(9),1,0)) PSA(10)=1
|
|---|
| 13 | I $G(PSA(10)) S DIR(0)="Y",DIR("A")="Procurement history exists, would you like to review",DIR("B")="Yes" W ! D ^DIR K DIR D:Y I Y<1 S PSAOUT=1 G END G:$D(DIRUT) END
|
|---|
| 14 | .S DIR(0)="D",DIR("A")="How far back in time would you like to go",DIR("B")="T-6M" W ! D ^DIR K DIR Q:$D(DIRUT) S PSA(13)=+Y
|
|---|
| 15 | .X ^DD("DD") S PSADT=Y
|
|---|
| 16 | .D NOW^%DTC S X1=X,X2=PSA(13) D ^%DTC S PSAD=$S(X/30>0:X/30,1:1)
|
|---|
| 17 | .S PSA(9)=$O(^PRC(441,+PSA(1),4,0)),Y=1
|
|---|
| 18 | I '$O(^PRC(441,+PSA(1),4,PSA(9))) G DEV
|
|---|
| 19 | S DIC="^PRC(441,+PSA(1),4,",DIC(0)="AEMQZ",DIC("W")="W:'$O(^(1,0)) "" NO HISTORY""",DA(1)=PSA(1) W ! D ^DIC K DIC S PSA(9)=+Y I Y<0 S PSAOUT=1 G END
|
|---|
| 20 | I '$O(^PRC(441,+PSA(1),4,+PSA(9),1,0)) W !,"Sorry, no history for that particular Control Point.",! G END
|
|---|
| 21 | DEV K IO("Q") N %ZIS,IOP,POP S %ZIS="Q",%ZIS("A")="For procurement history, please select DEVICE: " W ! D ^%ZIS I POP W !,"NO DEVICE SELECTED OR OUTPUT PRINTED!" S PSAOUT=1 G END
|
|---|
| 22 | I $D(IO("Q")) N ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTDTH,ZTSK S ZTRTN="LOOP^PSACON2",ZTDESC="Drug Procurement History",ZTSAVE("PSA*")="" D ^%ZTLOAD,HOME^%ZIS S PSAOUT=1 G END
|
|---|
| 23 | LOOP N PSALN,PSAPG,PSARPDT S (PSAPG,PSA(11))=0,Y=1 D HEADER
|
|---|
| 24 | F S PSA(11)=$O(^PRC(441,+PSA(1),4,+PSA(9),1,PSA(11))),PSA(14)=$P($G(^PRC(442,+PSA(11),1)),U,15) Q:'PSA(11)!(PSAOUT) D:$Y+4>IOSL HEADER G:'Y END D:PSA(14)'<PSA(13)
|
|---|
| 25 | .W !,$E($P($G(^PRC(442,+PSA(11),0)),U),5,10)
|
|---|
| 26 | .W ?8,$E($$VENNAME^PRCPUX1($P($G(^PRC(442,+PSA(11),1)),U)_"PRC(440"),1,20)
|
|---|
| 27 | .S Y=PSA(14) X ^DD("DD") W ?32,Y
|
|---|
| 28 | .S PSA(12)=$O(^PRC(442,+PSA(11),2,"AE",+PSA(1),""))
|
|---|
| 29 | .W ?45,$J($P($G(^PRC(442,+PSA(11),2,+PSA(12),0)),U,2),3) S PSAQ=$G(PSAQ)+$P($G(^(0)),U,2)
|
|---|
| 30 | .W " ",$$UNITCODE^PRCPUX1($P($G(^PRC(442,+PSA(11),2,+PSA(12),0)),U,3))
|
|---|
| 31 | .W ?55,"$",$J($P($G(^PRC(442,+PSA(11),2,+PSA(12),2)),U),9,2) S PSAB=$G(PSAB)+$P($G(^(2)),U)
|
|---|
| 32 | .W ?70,$P($G(^PRC(442,+PSA(11),2,+PSA(12),2)),U,8),! S Y=1
|
|---|
| 33 | .I '$O(^PRC(441,+PSA(1),4,+PSA(9),1,PSA(11))) S X=$G(PSAQ)/PSAD,X2=1,X3=5 D COMMA^%DTC W PSALN,!!,"Average ordered/month: ",X,?34,"TOTAL ORD: ",$J($G(PSAQ),3),?50,"TOTAL $: " S X=PSAB,X2="0$",X3=5 D COMMA^%DTC W X
|
|---|
| 34 | END W:$E(IOST)'="C" @IOF
|
|---|
| 35 | I $E(IOST,1,2)="C-",'PSAOUT S DIR(0)="EA",DIR("A")="END OF HISTORY! Press <RET> to return to the option." W ! D ^DIR K DIR
|
|---|
| 36 | D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" K IO("Q")
|
|---|
| 37 | K PSA,PSACON
|
|---|
| 38 | Q
|
|---|
| 39 | HEADER I $E(IOST,1,2)'="P-",PSAPG S DIR(0)="E" D ^DIR K DIR I 'Y S PSAOUT=1 Q
|
|---|
| 40 | I $$S^%ZTLOAD W !!,"Task #",$G(ZTSK),", ",$G(ZTDESC)," was stopped by ",$P($G(^VA(200,+$G(DUZ),0)),U),"." S PSAOUT=1 Q
|
|---|
| 41 | W:$Y @IOF S $P(PSALN,"-",81)="",PSAPG=PSAPG+1 W !,$E($P($G(^PSDRUG(+PSA,0)),U),1,40)
|
|---|
| 42 | W "=> from ",$G(PSADT),?60,"PAGE: ",PSAPG,!,PSALN,!,"PO #",?10,"VENDOR",?33,"PO DATE",?45,"QTY ORD",?57,"COST",?70,"QTY RECD",!,PSALN,!
|
|---|
| 43 | Q
|
|---|
