33 lines
1.8 KiB
Mathematica
33 lines
1.8 KiB
Mathematica
|
PSORPTS ;BHAM ISC/SAB - OUTPUT REPORTS DRIVER OPTION ; 08/13/92 17:00
|
||
|
|
;;7.0;OUTPATIENT PHARMACY;;DEC 1997
|
||
|
|
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 !!",!!
|
||
|
|
S DIC="^PSRX(",L=0,FLDS="[PSO NARC LIST]",BY="[PSO NARC LIST]" G EN1^DIP
|