source: WorldVistAEHR/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSALOG1H.m@ 701

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

initial load of WorldVistAEHR

File size: 2.4 KB
Line 
1PSALOG1H ;BIR/LTL,JMB-Unposted Procurement History - CONT'D ;7/23/97
2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;; 10/24/97
3 ;This routine prints the pharmacy procurement history High Cost Items
4 ;report for a selected month. It is called by PSALOG.
5 ;
6HIGH S PSAPG=0 D HDR
7 ;If the "PSA" array does not exist, the "PSAC" array cannot be created.
8 I '$D(^TMP("PSA",$J)) W !!,"No items were found for the selected month." G END^PSALOG0
9 ;If the "PSA" array exists, the "PSAC" does not exit, and the user
10 ;requested the Item Totals report, the routine attempted to create
11 ;the "PSAC" array and found no data.
12 I $D(^TMP("PSA",$J)),'$D(^TMP("PSAC",$J)),$G(PSATOTAL) W !!,"No items were found for the selected month." G END^PSALOG0
13 ;If the "PSA" array exists, the "PSAC" does not exit, and the user
14 ;did not request the Item Totals report, create the "PSAC" array.
15 I $D(^TMP("PSA",$J)),'$D(^TMP("PSAC",$J)),'$G(PSATOTAL) D CREATE
16 I '$D(^TMP("PSAC",$J)) W !!,"No items were found for the selected month." G END^PSALOG0
17 S PSAINVO=0 F S PSAINVO=+$O(^TMP("PSAC",$J,PSAINVO)) Q:'PSAINVO!(PSAOUT) D
18 .D:$Y+4>IOSL HDR Q:PSAOUT
19 .S PSAITEM="" F S PSAITEM=$O(^TMP("PSAC",$J,PSAINVO,PSAITEM)) Q:PSAITEM="" D
20 ..Q:$G(^TMP("PSAC",$J,PSAINVO,PSAITEM))<PSALOW
21 ..W !,$E(PSAITEM,1,56)
22 ..S X=$P($G(^TMP("PSAC",$J,PSAINVO,PSAITEM)),"^"),X2="2$" D COMMA^%DTC
23 ..W ?58,X,"(",$P($G(^TMP("PSAC",$J,PSAINVO,PSAITEM)),"^",2),")",!
24 G END^PSALOG0
25HDR I $E(IOST,1,2)="C-",PSAPG D Q:PSAOUT
26 .S PSASS=22-$Y F PSAKK=1:1:PSASS W !
27 .S DIR(0)="E" D ^DIR K DIR S:'Y PSAOUT=1
28 I $$S^%ZTLOAD W !!,"Task #",$G(ZTSK),", ",$G(ZTDESC)," was stopped by ",$P($G(^VA(200,+$G(DUZ),0)),"^"),"." S PSAOUT=1 Q
29 W:$Y @IOF S PSAPG=PSAPG+1
30 W:$E(IOST)'="C" !!,PSARPDT W:$E(IOST,1,2)="C-" !
31 W ?20,"DRUG ACCOUNTABILITY/INVENTORY INTERFACE",?72,"PAGE ",$J(PSAPG,2)
32 W !?((80-(65+$L(PSALOW)))/2),"UNPOSTED PHARMACY PROCUREMENTS FOR "_PSAMOYR_" HIGH COST ITEMS OVER $",PSALOW
33 W !!?1,"ITEM NAME",?61,"TOTAL ITEM COST",!,PSADLN
34 Q
35CREATE ;Create the "PSAC" array.
36 S PSACP=0 F S PSACP=$O(^TMP("PSA",$J,PSACP)) Q:'PSACP D
37 .S PSAITEM="" F S PSAITEM=$O(^TMP("PSA",$J,PSACP,PSAITEM)) Q:PSAITEM']"" S PSAIEN=0 F S PSAIEN=$O(^TMP("PSA",$J,PSACP,PSAITEM,PSAIEN)) Q:'PSAIEN D
38 ..S PSATMP=$G(^TMP("PSA",$J,PSACP,PSAITEM,PSAIEN))
39 ..S PSATOTO=$G(PSATOTO)+($P(PSATMP,"^",2)*$P(PSATMP,"^",9))
40 ..I '$O(^TMP("PSA",$J,PSACP,PSAITEM,PSAIEN)) S ^TMP("PSAC",$J,(999999999-PSATOTO),PSAITEM)=PSATOTO_"^"_PSACP K PSATOTO
41 Q
Note: See TracBrowser for help on using the repository browser.