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

PSORPTS.m

Go to the documentation of this file.
PSORPTS ;BHAM ISC/SAB - OUTPUT REPORTS DRIVER OPTION ;21-Jan-2004 18:59;PLS
 ;;7.0;OUTPATIENT PHARMACY;;DEC 1997
 ; Modified - IHS/CIA/PLS - 01/21/04 - Added Crow Mods
 G A:$D(^DOPT("PSORPTS",10)) S ^DOPT("PSORPTS",0)="REPORT^1N" F I=1:1 S X=$T(@I) Q:X=""  S ^DOPT("PSORPTS",I,0)=$P(X,";",2,99)
 S DIK="^DOPT(""PSORPTS""," D IXALL^DIK
A S DIC="^DOPT(""PSORPTS"",",DIC(0)="QEAM" D ^DIC Q:Y<0  G @+Y
 Q
1 ;FORMULARY LISTING << TAKEN OUT BECAUSE OF CLASS REMOVAL - 8/29/85 MPH/BHAM>>
 ;S DIC="^PSDRUG(",L=0,BY="[PSO DRUG LIST]",FLDS="[PSO DRUG LIST]" G EN1^DIP
 W !,"FORMULARY LISTING NO LONGER AVAILABLE",! Q
2 ;ALPHA DRUG LIST & SYNONYMS
 S DIC="^PSDRUG(",L=0,BY=.01,(FR,TO)="",FLDS="[PSO ALPHA DRUG LIST]",DIS(0)="S ZZ=$S($D(^PSDRUG(D0,""I"")):^(""I""),1:0),Z2=$S($F($P($G(^(2)),""^"",3),""O""):0,1:1) I 'ZZ,'Z2" D EN1^DIP
 K ZZ,Z2 Q
3 ;DRUG LIST BY SYNONYM
 S DIC="^PSDRUG(",L=0,BY="9,.01",FR="",TO="",FLDS="[PSO SYNONYM LIST]",DIS(0)="S ZZ=$S($D(^PSDRUG(D0,""I"")):^(""I""),1:0),Z2=$S($F($P($G(^(2)),""^"",3),""O""):0,1:1) I 'ZZ,'Z2" D EN1^DIP
 K ZZ,Z2 Q
4 ;MOST COMMONLY DISPENSED DRUG
 G ^PSORPTS1
5 ;INACTIVE DRUG LIST
 S DIC="^PSDRUG(",L=0,FLDS="[PSO INACTIVE DRUG LIST]",DIS(0)="I $D(^PSDRUG(D0,""I"")),+^(""I"")" G EN1^DIP
6 ;COST ANALYSIS REPORTS
 G ^PSOCST
7 ;PRESCRIPTIONS ON HOLD
 I '$D(^PSRX("AH")) W $C(7),!?5,"NO PRESCRIPTIONS ON HOLD." Q
 S DIC=52,L=0,BY="[PSO HOLD LIST]",FLDS="[PSO HOLD]" G EN1^DIP
 ;S DIC="^PSRX(",L=0,BY="[PSO HOLD LIST]",FLDS="[PSO HOLD]" G EN1^DIP
8 ;AMIS REPORT
 G ^PSOAMIS
9 ;NON-FORMULARY LIST
 S DIC="^PSDRUG(",L=0,FLDS="[PSO N/F LIST]",BY=.01,FR="",TO="",DIS(0)="I $P(^PSDRUG(D0,0),""^"",9)",DIS(1)="S ZZ=$S($D(^PSDRUG(D0,""I"")):+^(""I""),1:0) I 'ZZ" G EN1^DIP
10 ;NARCOTIC RX'S LIST
 W $C(7),!,"Please send output to a 132 columns printer !!",!!
 ;IHS/BAO/DMH   added next line to screen out discontinued (edit) status prescriptions  9/13/2003  dmh
 S DIS(0)="I $P($G(^PSRX(D0,""STA"")),""^"",1)'=15"
 S DIC="^PSRX(",L=0,FLDS="[PSO NARC LIST]",BY="[PSO NARC LIST]" G EN1^DIP