Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSALOG1H

PSALOG1H.m

Go to the documentation of this file.
  1. PSALOG1H ;BIR/LTL,JMB-Unposted Procurement History - CONT'D ;7/23/97
  1. ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;; 10/24/97
  1. ;This routine prints the pharmacy procurement history High Cost Items
  1. ;report for a selected month. It is called by PSALOG.
  1. ;
  1. HIGH S PSAPG=0 D HDR
  1. ;If the "PSA" array does not exist, the "PSAC" array cannot be created.
  1. I '$D(^TMP("PSA",$J)) W !!,"No items were found for the selected month." G END^PSALOG0
  1. ;If the "PSA" array exists, the "PSAC" does not exit, and the user
  1. ;requested the Item Totals report, the routine attempted to create
  1. ;the "PSAC" array and found no data.
  1. I $D(^TMP("PSA",$J)),'$D(^TMP("PSAC",$J)),$G(PSATOTAL) W !!,"No items were found for the selected month." G END^PSALOG0
  1. ;If the "PSA" array exists, the "PSAC" does not exit, and the user
  1. ;did not request the Item Totals report, create the "PSAC" array.
  1. I $D(^TMP("PSA",$J)),'$D(^TMP("PSAC",$J)),'$G(PSATOTAL) D CREATE
  1. I '$D(^TMP("PSAC",$J)) W !!,"No items were found for the selected month." G END^PSALOG0
  1. S PSAINVO=0 F S PSAINVO=+$O(^TMP("PSAC",$J,PSAINVO)) Q:'PSAINVO!(PSAOUT) D
  1. .D:$Y+4>IOSL HDR Q:PSAOUT
  1. .S PSAITEM="" F S PSAITEM=$O(^TMP("PSAC",$J,PSAINVO,PSAITEM)) Q:PSAITEM="" D
  1. ..Q:$G(^TMP("PSAC",$J,PSAINVO,PSAITEM))<PSALOW
  1. ..W !,$E(PSAITEM,1,56)
  1. ..S X=$P($G(^TMP("PSAC",$J,PSAINVO,PSAITEM)),"^"),X2="2$" D COMMA^%DTC
  1. ..W ?58,X,"(",$P($G(^TMP("PSAC",$J,PSAINVO,PSAITEM)),"^",2),")",!
  1. G END^PSALOG0
  1. HDR I $E(IOST,1,2)="C-",PSAPG D Q:PSAOUT
  1. .S PSASS=22-$Y F PSAKK=1:1:PSASS W !
  1. .S DIR(0)="E" D ^DIR K DIR S:'Y PSAOUT=1
  1. I $$S^%ZTLOAD W !!,"Task #",$G(ZTSK),", ",$G(ZTDESC)," was stopped by ",$P($G(^VA(200,+$G(DUZ),0)),"^"),"." S PSAOUT=1 Q
  1. W:$Y @IOF S PSAPG=PSAPG+1
  1. W:$E(IOST)'="C" !!,PSARPDT W:$E(IOST,1,2)="C-" !
  1. W ?20,"DRUG ACCOUNTABILITY/INVENTORY INTERFACE",?72,"PAGE ",$J(PSAPG,2)
  1. W !?((80-(65+$L(PSALOW)))/2),"UNPOSTED PHARMACY PROCUREMENTS FOR "_PSAMOYR_" HIGH COST ITEMS OVER $",PSALOW
  1. W !!?1,"ITEM NAME",?61,"TOTAL ITEM COST",!,PSADLN
  1. Q
  1. CREATE ;Create the "PSAC" array.
  1. S PSACP=0 F S PSACP=$O(^TMP("PSA",$J,PSACP)) Q:'PSACP D
  1. .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
  1. ..S PSATMP=$G(^TMP("PSA",$J,PSACP,PSAITEM,PSAIEN))
  1. ..S PSATOTO=$G(PSATOTO)+($P(PSATMP,"^",2)*$P(PSATMP,"^",9))
  1. ..I '$O(^TMP("PSA",$J,PSACP,PSAITEM,PSAIEN)) S ^TMP("PSAC",$J,(999999999-PSATOTO),PSAITEM)=PSATOTO_"^"_PSACP K PSATOTO
  1. Q