PSORPTS.m

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

PSORPTS   ;BHAM ISC/SAB - OUTPUT REPORTS DRIVER OPTION ;21-Jan-2004 18:59;PLS

 +1       ;;7.0;OUTPATIENT PHARMACY;;DEC 1997

 +2       ; Modified - IHS/CIA/PLS - 01/21/04 - Added Crow Mods

 +3        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)

 +4        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       ;IHS/BAO/DMH   added next line to screen out discontinued (edit) status prescriptions  9/13/2003  dmh

 +3        SET DIS(0)="I $P($G(^PSRX(D0,""STA"")),""^"",1)'=15"

 +4        SET DIC="^PSRX("

           SET L=0

           SET FLDS="[PSO NARC LIST]"

           SET BY="[PSO NARC LIST]"

           GOTO EN1^DIP