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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSORPTS 1837 printed Nov 22, 2024@17:44:10 Page 2
PSORPTS ;BHAM ISC/SAB - OUTPUT REPORTS DRIVER OPTION ; 08/13/92 17:00
+1 ;;7.0;OUTPATIENT PHARMACY;;DEC 1997
+2 if $DATA(^DOPT("PSORPTS",10))
GOTO A
SET ^DOPT("PSORPTS",0)="REPORT^1N"
FOR I=1:1
SET X=$TEXT(@I)
if X=""
QUIT
SET ^DOPT("PSORPTS",I,0)=$PIECE(X,";",2,99)
+3 SET DIK="^DOPT(""PSORPTS"","
DO IXALL^DIK
A SET DIC="^DOPT(""PSORPTS"","
SET DIC(0)="QEAM"
DO ^DIC
if Y<0
QUIT
GOTO @+Y
+1 QUIT
1 ;FORMULARY LISTING << TAKEN OUT BECAUSE OF CLASS REMOVAL - 8/29/85 MPH/BHAM>>
+1 ;S DIC="^PSDRUG(",L=0,BY="[PSO DRUG LIST]",FLDS="[PSO DRUG LIST]" G EN1^DIP
+2 WRITE !,"FORMULARY LISTING NO LONGER AVAILABLE",!
QUIT
2 ;ALPHA DRUG LIST & SYNONYMS
+1 SET DIC="^PSDRUG("
SET L=0
SET BY=.01
SET (FR,TO)=""
SET FLDS="[PSO ALPHA DRUG LIST]"
SET 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"
DO EN1^DIP
+2 KILL ZZ,Z2
QUIT
3 ;DRUG LIST BY SYNONYM
+1 SET DIC="^PSDRUG("
SET L=0
SET BY="9,.01"
SET FR=""
SET TO=""
SET FLDS="[PSO SYNONYM LIST]"
SET 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"
DO EN1^DIP
+2 KILL ZZ,Z2
QUIT
4 ;MOST COMMONLY DISPENSED DRUG
+1 GOTO ^PSORPTS1
5 ;INACTIVE DRUG LIST
+1 SET DIC="^PSDRUG("
SET L=0
SET FLDS="[PSO INACTIVE DRUG LIST]"
SET DIS(0)="I $D(^PSDRUG(D0,""I"")),+^(""I"")"
GOTO EN1^DIP
6 ;COST ANALYSIS REPORTS
+1 GOTO ^PSOCST
7 ;PRESCRIPTIONS ON HOLD
+1 IF '$DATA(^PSRX("AH"))
WRITE $CHAR(7),!?5,"NO PRESCRIPTIONS ON HOLD."
QUIT
+2 SET DIC=52
SET L=0
SET BY="[PSO HOLD LIST]"
SET FLDS="[PSO HOLD]"
GOTO EN1^DIP
+3 ;S DIC="^PSRX(",L=0,BY="[PSO HOLD LIST]",FLDS="[PSO HOLD]" G EN1^DIP
8 ;AMIS REPORT
+1 GOTO ^PSOAMIS
9 ;NON-FORMULARY LIST
+1 SET DIC="^PSDRUG("
SET L=0
SET FLDS="[PSO N/F LIST]"
SET BY=.01
SET FR=""
SET TO=""
SET DIS(0)="I $P(^PSDRUG(D0,0),""^"",9)"
SET DIS(1)="S ZZ=$S($D(^PSDRUG(D0,""I"")):+^(""I""),1:0) I 'ZZ"
GOTO EN1^DIP
10 ;NARCOTIC RX'S LIST
+1 WRITE $CHAR(7),!,"Please send output to a 132 columns printer !!",!!
+2 SET DIC="^PSRX("
SET L=0
SET FLDS="[PSO NARC LIST]"
SET BY="[PSO NARC LIST]"
GOTO EN1^DIP
