source: WorldVistAEHR/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSALOG2.m@ 837

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

initial load of WorldVistAEHR
File size: 4.6 KB
Line 
1PSALOG2 ;BIR/LTL-Post Drug Procurement History ;7/23/97
2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**15**; 10/24/97
3 ;This routine compiles a report of warehouse drugs.
4 ;
5 ;References to $$DESCR^PRCPUX1 are covered by IA #259
6 ;References to $$INVNAME^PRCPUX1 are covered by IA #259
7 ;References to ^PRC( are covered by IA #214
8 ;References to ^PRCS( are covered by IA #198
9 ;References to ^PRCP( are covered by IA #214
10 ;
11 N PSA,PSAB,PSAC,PSAION,PSAOUT,X,X2,X3,Y,PSAPG,DIR,DIRUT,DTOUT,DUOUT,%DT,PSALN
12 S %DT="AEP",%DT("A")="Please select month: ",%DT("B")="T-1M"
13 D ^%DT S PSA(11)=$E(Y,1,5),PSA(12)=$E(PSA(11),4,5),PSAOUT=0
14 I Y<0 S PSAOUT=1 G END
15 X ^DD("DD") S PSA(13)=$E(Y,1,3)_" '"_$E(PSA(11),2,3)
16 K IO("Q") N %ZIS,IOP,POP S %ZIS="Q" W ! D ^%ZIS S PSAION=$G(ION)
17 I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED!" S PSAOUT=1 G END
18 I $D(IO("Q")) N ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTDTH,ZTSK S ZTRTN="GO^PSALOG2",ZTDESC="Monthly warehoused drug report",ZTSAVE("PSA*")="" D ^%ZTLOAD,HOME^%ZIS S PSAOUT=1 G END
19GO S PSA=$O(^PRCP(445,"AC","W","")),(PSA(1),PSAPG)=0 D HEADER
20 F S PSA(1)=$O(^PRCP(445,+PSA,1,PSA(1))) Q:'PSA(1) I $P($G(^PRC(441,+PSA(1),0)),U,3)=6505 W:$E($G(IOST))="C" "." S ^TMP("PSA",$J,$P($G(^PRC(441,+PSA(1),0)),U,2))=$G(^(0))
21 S PSA(2)=0
22 F S PSA(2)=$O(^TMP("PSA",$J,PSA(2))) Q:PSA(2)']"" S PSA(3)=$P($G(^TMP("PSA",$J,PSA(2))),U) D:$O(^PRCP(445.2,"AD",PSA,PSA(3),""))
23 .S PSA(4)=0
24 .F S PSA(4)=$O(^PRCP(445.2,"AD",+PSA,PSA(3),PSA(4))) Q:'PSA(4) D:$P($G(^PRCP(445.2,+PSA(4),0)),U,4)?1"R"&($E($P($G(^(0)),U,17),1,5)=PSA(11))
25 ..S ^TMP("PSAB",$J,$P($G(^PRCP(445.2,+PSA(4),0)),U,18),$P($G(^(0)),U,5),PSA(4))=$G(^(0))
26 S (PSA(4),PSAB,PSAB(1))=0
27 F PSAC=0:1 S PSAB=$O(^TMP("PSAB",$J,PSAB)) Q:'PSAB D:PSAC HEADER G:PSAOUT END W !!,"PRIMARY INVENTORY: ",$$INVNAME^PRCPUX1(PSAB) F S PSA(4)=$O(^TMP("PSAB",$J,PSAB,PSA(4))) Q:'PSA(4)!(PSAOUT) D G:PSAOUT END
28 .W !!,"ITEM #: ",PSA(4),?15,$$DESCR^PRCPUX1(PSAB,PSA(4)),!!,"QTY",?9,"QTY",?19,"PKG",?29,"UNIT",?40,"TOTAL",?51,"DATE",?61,"TRANSACTION",!,"ORD",?9,"REC",?29,"COST",?40,"COST"
29 .F S PSAB(1)=$O(^TMP("PSAB",$J,+PSAB,+PSA(4),PSAB(1))) Q:'PSAB(1)!(PSAOUT) S PSA(5)=$G(^TMP("PSAB",$J,+PSAB,+PSA(4),+PSAB(1))) D D:$Y+6>IOSL HEADER Q:PSAOUT
30 ..Q:'$P(PSA(5),U,19)
31 ..S PSA(22)=0,PSA(33)=$O(^PRCS(410,"B",$P(PSA(5),U,19),""))
32 ..F S PSA(22)=$O(^PRCS(410,+PSA(33),"IT",PSA(22))) Q:'PSA(22) S:$P($G(^PRCS(410,+PSA(33),"IT",PSA(22),0)),U,5)=PSA(4) PSA(44)=$P($G(^(0)),U,2)
33 ..W !!,$J($G(PSA(44)),3)
34 ..S PSA(99)=$G(PSA(99))+PSA(44) K PSA(44)
35 ..S PSA(8)=-$P(PSA(5),U,7),PSA(9)=$G(PSA(9))+PSA(8) W ?9,$J(PSA(8),3)
36 ..W ?18,$P(PSA(5),U,6)
37 ..S (X,PSA(7))=$P(PSA(5),U,9),X2="2$" D COMMA^%DTC W X
38 ..S X=-$P(PSA(5),U,7)*PSA(7),X2="2$",PSA(10)=$G(PSA(10))+X D COMMA^%DTC W X
39 ..S Y=$P($P(PSA(5),U,17),".") X ^DD("DD") W ?50,$S($L(Y)=11:$E(Y,1,6),$L(Y)=10:$E(Y,1,5),1:"UNKNOWN")
40 ..W ?59,$P(PSA(5),U,19)
41 ..I '$O(^TMP("PSAB",$J,+PSAB,+PSA(4),+PSAB(1))) W !,PSALN,!,$J(PSA(99),3),?9,$J(PSA(9),3) S X=$G(PSA(10)),X2="2$" D COMMA^%DTC W ?16,"<TOTALS>",?34,X S ^TMP("PSAC",$J,(999999999-PSA(10)),+PSA(4))=PSA(10)_U_PSAB K PSA(9),PSA(10),PSA(99)
42 I '$D(^TMP("PSAB",$J)) W !,"Sorry, no procurements for that month!",! S PSAOUT=1
43 I $D(ZTQUEUED),$D(^TMP("PSAB",$J)) S PSA(44)=500 D LOOP2^PSALOG3
44END W:$E(IOST)'="C" @IOF
45 I $E(IOST,1,2)="C-",'$G(PSAOUT) W ! S DIR(0)="EA",DIR("A")="END OF REPORT! Press <RET> to return to the menu." D ^DIR K DIR
46 D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" K IO("Q")
47 K ^TMP("PSA",$J),^TMP("PSAB",$J) I $G(PSAOUT) K ^TMP("PSAC",$J) Q
48 S DIR(0)="Y",DIR("A")="Would you like a list of high dollar items",DIR("B")="Yes",DIR("?")="If yes, I'll let you pick a cut-off dollar amount and sort from high to low" W ! D ^DIR K DIR I 'Y S PSAOUT=1 G END
49 S DIR(0)="N",DIR("A")="Please enter the lowest amount you are interested in listing",DIR("B")=1000,DIR("?")="Enter the lowest dollar amount that you want included, without $" W ! D ^DIR K DIR S:Y PSA(44)=Y I 'Y S PSAOUT=1 G END
50 K IO("Q") N %ZIS,IOP,POP,X3 S %ZIS="Q",%ZIS("B")=$G(PSAION) W ! D ^%ZIS
51 I POP W !,"NO DEVICE SELECTED OR OUTPUT PRINTED!" S PSAOUT=1 G END
52 I $D(IO("Q")) N ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTDTH,ZTSK S ZTRTN="LOOP2^PSALOG3",ZTDESC="High Dollar Drug Report",ZTSAVE("^TMP(""PSAC"",$J,")="",ZTSAVE("PSA*")="",ZTSAVE("PSALN")="" D ^%ZTLOAD,HOME^%ZIS S PSAOUT=1 G END
53 D LOOP2^PSALOG3 G END
54HEADER I $E(IOST,1,2)'="P-",PSAPG S DIR(0)="E" D ^DIR K DIR I 'Y S PSAOUT=1 Q
55 I $$S^%ZTLOAD W !!,"Task #",$G(ZTSK),", ",$G(ZTDESC)," was stopped by ",$P($G(^VA(200,+$G(DUZ),0)),U),"." S PSAOUT=1 Q
56 W:$Y @IOF S $P(PSALN,"-",81)="",PSAPG=PSAPG+1
57 W !,?2,"WAREHOUSE DRUG PROCUREMENTS FOR ",PSA(13),?70,"PAGE: ",PSAPG,!,PSALN
58 Q
Note: See TracBrowser for help on using the repository browser.