[613] | 1 | PSORPTS ;BHAM ISC/SAB - OUTPUT REPORTS DRIVER OPTION ; 08/13/92 17:00
|
---|
| 2 | ;;7.0;OUTPATIENT PHARMACY;;DEC 1997
|
---|
| 3 | 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)
|
---|
| 4 | S DIK="^DOPT(""PSORPTS""," D IXALL^DIK
|
---|
| 5 | A S DIC="^DOPT(""PSORPTS"",",DIC(0)="QEAM" D ^DIC Q:Y<0 G @+Y
|
---|
| 6 | Q
|
---|
| 7 | 1 ;FORMULARY LISTING << TAKEN OUT BECAUSE OF CLASS REMOVAL - 8/29/85 MPH/BHAM>>
|
---|
| 8 | ;S DIC="^PSDRUG(",L=0,BY="[PSO DRUG LIST]",FLDS="[PSO DRUG LIST]" G EN1^DIP
|
---|
| 9 | W !,"FORMULARY LISTING NO LONGER AVAILABLE",! Q
|
---|
| 10 | 2 ;ALPHA DRUG LIST & SYNONYMS
|
---|
| 11 | 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
|
---|
| 12 | K ZZ,Z2 Q
|
---|
| 13 | 3 ;DRUG LIST BY SYNONYM
|
---|
| 14 | 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
|
---|
| 15 | K ZZ,Z2 Q
|
---|
| 16 | 4 ;MOST COMMONLY DISPENSED DRUG
|
---|
| 17 | G ^PSORPTS1
|
---|
| 18 | 5 ;INACTIVE DRUG LIST
|
---|
| 19 | S DIC="^PSDRUG(",L=0,FLDS="[PSO INACTIVE DRUG LIST]",DIS(0)="I $D(^PSDRUG(D0,""I"")),+^(""I"")" G EN1^DIP
|
---|
| 20 | 6 ;COST ANALYSIS REPORTS
|
---|
| 21 | G ^PSOCST
|
---|
| 22 | 7 ;PRESCRIPTIONS ON HOLD
|
---|
| 23 | I '$D(^PSRX("AH")) W $C(7),!?5,"NO PRESCRIPTIONS ON HOLD." Q
|
---|
| 24 | S DIC=52,L=0,BY="[PSO HOLD LIST]",FLDS="[PSO HOLD]" G EN1^DIP
|
---|
| 25 | ;S DIC="^PSRX(",L=0,BY="[PSO HOLD LIST]",FLDS="[PSO HOLD]" G EN1^DIP
|
---|
| 26 | 8 ;AMIS REPORT
|
---|
| 27 | G ^PSOAMIS
|
---|
| 28 | 9 ;NON-FORMULARY LIST
|
---|
| 29 | 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
|
---|
| 30 | 10 ;NARCOTIC RX'S LIST
|
---|
| 31 | W $C(7),!,"Please send output to a 132 columns printer !!",!!
|
---|
| 32 | S DIC="^PSRX(",L=0,FLDS="[PSO NARC LIST]",BY="[PSO NARC LIST]" G EN1^DIP
|
---|