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

PSADAI.m

Go to the documentation of this file.
  1. PSADAI ;BIR/LTL/,JMB/PDW-Drug Balances by Location ;7/23/97
  1. ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**15,53**; 10/24/97
  1. ;
  1. ;Reference to ^PS(59.4 are covered by IA #2505
  1. ;References to ^PSDRUG( are covered by IA #2095
  1. ;References to ^PRCP( are covered by IA #214
  1. ;References to ^PS(59 are covered by IA #212
  1. ;
  1. LOC S (PSACNT,PSAOUT)=0 D ^PSAUTL3 G:PSAOUT EXIT1
  1. S PSACNT=0,PSACHK=$O(PSALOC(""))
  1. I PSACHK="",'PSALOC W !,"There are no active pharmacy locations." G EXIT1
  1. I PSACHK'="",$G(PSASEL)="",PSALOC W !!,PSALOCN
  1. ;
  1. DEVICE W ! K IO("Q") S %ZIS="Q" D ^%ZIS I POP S DTOUT=1,Y=-1 W !,"No Device was selected or output printed." G EXIT1
  1. I $D(IO("Q")) S ZTRTN="START^PSADAI",ZTDESC="Drug Accountability - Drug Location Report",ZTSAVE("PSALOC(")="" D ^%ZTLOAD,HOME^%ZIS S Y=1 G EXIT1
  1. START S PSAOUT=0,PSALOCN="",$P(PSASLN,"-",80)=""
  1. S PSARPDT=$E($$HTFM^XLFDT($H),1,12),PSADT=$P(PSARPDT,".")
  1. S PSARPDT=$E(PSADT,4,5)_"/"_$E(PSADT,6,7)_"/"_$E(PSADT,2,3)_"@"_$P(PSARPDT,".",2)
  1. F S PSALOCN=$O(PSALOC(PSALOCN)) Q:PSALOCN="" D Q:PSAOUT
  1. .S PSAIEN=0 F S PSAIEN=+$O(PSALOC(PSALOCN,PSAIEN)) Q:'PSAIEN D Q:PSAOUT
  1. ..S PSAISIT=+$P(PSALOC(PSALOCN,PSAIEN),"^"),PSAOSIT=+$P(PSALOC(PSALOCN,PSAIEN),"^",2)
  1. ..S PSAISITN=$S($P($G(^PS(59.4,PSAISIT,0)),"^")'="":$P($G(^PS(59.4,PSAISIT,0)),"^"),1:"UNKNOWN")
  1. ..S PSAOSITN=$S($P($G(^PS(59,PSAOSIT,0)),"^")'="":$P($G(^PS(59,PSAOSIT,0)),"^"),1:"UNKNOWN")
  1. ..S PSASITES=$S(PSAISIT&(PSAOSIT):PSAISITN_" (IP) "_PSAOSITN_" (OP)",PSAISIT:PSAISITN_" (IP)",1:PSAOSITN_" (OP)")
  1. ..D COMPILE D:'PSAOUT DONE
  1. EXIT D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" K IO("Q") W:$E(IOST,1,2)="C-" @IOF
  1. EXIT1 K ^TMP($J,"PSADRG"),%ZIS,DIR,DIRUT,DTOUT
  1. K PSACHK,PSACNT,PSADRG,PSADT,PSAIEN,PSAINV,PSAISIT,PSAISITN,PSALEN,PSALINK,PSALNK,PSALOC,PSALOCA,PSALOCN,PSAOSIT,PSAOSITN
  1. K PSAOUT,PSAPG,PSARPDT,PSAS,PSASEL,PSASITES,PSASLN,PSASS,PSATMP,X,Y,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTDTH,ZTSK
  1. Q
  1. COMPILE ;Creates ^TMP(Drug Name)= current balance ^ dispense unit ^ total inventory (current balance in 50)
  1. K ^TMP($J,"PSADRG")
  1. S PSADRG=0 F S PSADRG=+$O(^PSD(58.8,PSAIEN,1,PSADRG)) Q:'PSADRG D
  1. .Q:'$D(^PSDRUG(PSADRG,0))
  1. .I $P($G(^PSD(58.8,PSAIEN,1,PSADRG,0)),"^",4)=0,$P($G(^PSD(58.8,PSAIEN,1,PSADRG,0)),"^",14)<DT Q ;*53 0 QT & inactive
  1. .S ^TMP($J,"PSADRG",$P(^PSDRUG(PSADRG,0),"^"))=$P($G(^PSD(58.8,PSAIEN,1,PSADRG,0)),"^",4)_"^"_$P($G(^PSDRUG(PSADRG,660)),"^",8)_"^"_$P($G(^PSDRUG(PSADRG,660.1)),"^")
  1. PRINT ;Prints body of report
  1. ;Finds longest length of inventory link(s).
  1. S (PSALNK,PSALEN)=0 F S PSALNK=+$O(^PSD(58.8,PSAIEN,4,PSALNK)) Q:'PSALNK D
  1. .S PSALINK(+$P($G(^PSD(58.8,PSAIEN,4,PSALNK,0)),"^"))=""
  1. .S PSAINV="INVENTORY LINK: "_$S($P($G(^PRCP(445,PSALNK,0)),"^")'="":$P($G(^PRCP(445,PSALNK,0)),"^"),1:"NONE")
  1. .S:PSALEN<$L(PSAINV) PSALEN=$L(PSAINV)
  1. S PSAPG=0,PSADRG="" D HDR
  1. ;If no data in ^TMP, prints message & exit routine.
  1. S PSATMP=$O(^TMP($J,"PSADRG","")) I PSATMP="" W !!,"<< NO DRUGS WERE FOUND. >>",! G DONE
  1. ;If data is found, prints drug name, current balance, & dispense unit
  1. F S PSADRG=$O(^TMP($J,"PSADRG",PSADRG)) Q:PSADRG="" D I PSAOUT W:$E(IOST,1,2)="C-" @IOF Q
  1. .D:$Y+4>IOSL HDR Q:PSAOUT
  1. .W !,PSADRG
  1. .S PSALEN=$L($P($P(^TMP($J,"PSADRG",PSADRG),"^"),".",2))
  1. .W ?(44+PSALEN),$J($FN($P(^TMP($J,"PSADRG",PSADRG),"^"),",",PSALEN),(10+PSALEN))
  1. .W:$P(^TMP($J,"PSADRG",PSADRG),"^",2)'="" ?61,$P(^TMP($J,"PSADRG",PSADRG),"^",2)
  1. .W ?69,$J($FN($P(^TMP($J,"PSADRG",PSADRG),"^",3),",",0),9)
  1. Q
  1. DONE ;Holds screen or ejects paper if sent to printer
  1. I $E(IOST,1,2)="C-" D
  1. .S PSAS=22-$Y F PSASS=1:1:PSAS W !
  1. .S DIR(0)="EA",DIR("A")="End of display! Enter RETURN to continue or '^' to exit:" D ^DIR K DIR S:'Y PSAOUT=1
  1. W:$E(IOST)'="C" @IOF
  1. Q
  1. HDR ;Print header
  1. S PSAPG=PSAPG+1
  1. I PSAPG=1,$E(IOST,1,2)="C-" W @IOF
  1. I PSAPG>1,$E(IOST)'="C" W @IOF
  1. I $E(IOST,1,2)="C-",PSAPG>1 D Q:PSAOUT
  1. .S PSAS=22-$Y F PSASS=1:1:PSAS W !
  1. .S DIR(0)="E" D ^DIR K DIR W:'$G(DIRUT) @IOF S:'Y PSAOUT=1
  1. W:$E(IOST)'="C" !!,PSARPDT W:$E(IOST,1,2)="C-" !
  1. W ?21,"D R U G A C C O U N T A B I L I T Y",?71,"Page ",$J(PSAPG,2)
  1. W !?24,"DRUG BALANCES BY LOCATION REPORT"
  1. W !?((80-$L(PSALOCN))/2),PSALOCN
  1. S PSALNK=0 F S PSALNK=$O(PSALINK(PSALNK)) Q:'PSALNK D
  1. .S PSAINV="INVENTORY LINK: "_$S($P($G(^PRCP(445,PSALNK,0)),"^")'="":$P($G(^PRCP(445,PSALNK,0)),"^"),1:"NONE")
  1. .W !?((80-$L(PSAINV))/2),PSAINV
  1. W !!?47,"CURRENT",?58,"DISPENSE",?72,"TOTAL"
  1. W !,"DRUG NAME",?47,"BALANCE",?60,"UNIT",?70,"INVENTORY",!,PSASLN
  1. Q