| [613] | 1 | PSALOG1H ;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 | ;
|
|---|
| 6 | HIGH 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
|
|---|
| 25 | HDR 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
|
|---|
| 35 | CREATE ;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
|
|---|
