VistA-WorldVistAEHR/r/OUTPATIENT_PHARMACY-PSO-APS.../PSORPTS.m

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