PSSUTLPZ.m

PSSUTLPZ ;BIR/RTR-Pre release report utility routine ;02/14/00

 ;;1.0;PHARMACY DATA MANAGEMENT;**40**;9/30/97

 ;

TEXT ;Text for pre-release report

 W !!,"The current Orderable Item structure keeps Additives and Solutions matched to",!,"Orderable Items flagged for IV use. All Dispense Drugs are currently matched to",!,"Orderable Items that are not flagged for IV Use. This was done"

 W " to control "

 W !,"the finishing process of IV and Unit Dose orders entered through CPRS.",!,"The new Orderable Item structure will inactivate all IV flagged Orderable",!,"Items. All Additives and Solutions will be re-matched to non-IV flagged"

 W !,"Orderable Items, based on their Dispense Drug links.",!

 W ! K DIR S DIR(0)="E" D ^DIR K DIR I Y["^"!($D(DIRUT)) K Y S PSSOUT=1 Q

 K PSSTYPE

 K DIR S DIR(0)="S^A:ADDITIVES;S:SOLUTIONS;B:BOTH",DIR("A")="Print report for Additives, Solutions, or Both",DIR("B")="B"

 S DIR("?")=" ",DIR("?",1)="Enter 'A' to see how the Additives will be re-matched in the new Orderable"

 S DIR("?",2)="Item structure, enter 'S' to see how the Solutions will be re-matched in the",DIR("?",3)="new Orderable Item structure, enter 'B' to see both, enter '^' to exit."

 Q

INS ;Convert non-numeric Instructions to Nouns

 D CHECK I $G(PSSNOCON) K PSSNOCON Q

 K PSSNOCON

 W !!,"This option will move all non-numeric Instructions to the Noun field in the",!,"Dosage Form file. If you do this, you will then need to review the Nouns and decide to mark them for Inpatient, Outpatient or both."

 W ! K DIR S DIR(0)="Y",DIR("A")="Convert all non-numeric Instructions to Nouns",DIR("B")="Y" D ^DIR I Y'=1 W !!,"Nothing converted.",! G INSQ

 W !,"Converting.." H 1

 N PSSD,PSSI,PSSINS

 F PSSD=0:0 S PSSD=$O(^PS(50.606,PSSD)) Q:'PSSD  D:$O(^PS(50.606,PSSD,"INS",0))

 .F PSSI=0:0 S PSSI=$O(^PS(50.606,PSSD,"INS",PSSI)) Q:'PSSI  S PSSINS=$P($G(^PS(50.606,PSSD,"INS",PSSI,0)),"^") I PSSINS'="" D

 ..I PSSINS?.N!(PSSINS?.N1".".N) Q

 ..I $O(^PS(50.606,PSSD,"NOUN","B",PSSINS,0)) Q

 ..K DIC,DD,DO S DA(1)=PSSD,DIC="^PS(50.606,"_DA(1)_",""NOUN"",",DIC(0)="L",X=PSSINS D FILE^DICN W "." K DD,DO,DIC

 W !,"Finished converting Instructions to Nouns!"

INSQ W !

 Q

NOUN ;Enter/edit Nouns

 D CHECK I $G(PSSNOCON) K PSSNOCON G NOUNQ

 K PSSNOCON

 W ! K DIC S DIC(0)="QEAMZ",DIC="^PS(50.606," D ^DIC I Y<1!($D(DTOUT))!($D(DUOUT)) G NOUNQ

 S PSSDOSE=+Y

NOUNA W !!?2,"Dosage Form => ",$P($G(^PS(50.606,+PSSDOSE,0)),"^"),! K DIC S DA(1)=PSSDOSE,DIC="^PS(50.606,"_PSSDOSE_",""NOUN"",",DIC(0)="QEAMLZ" D  D ^DIC I Y<1!($D(DUOUT))!($D(DTOUT)) G NOUNC

 .S DIC("W")="W ""  ""_$P($G(^PS(50.606,PSSDOSE,""NOUN"",+Y,0)),""^"",2)"

 S PSSNOUN=+Y

 K DIE S DA(1)=PSSDOSE,DA=PSSNOUN,DR=".01;1;2",DIE="^PS(50.606,"_PSSDOSE_",""NOUN""," D ^DIE K DIE G:'$D(Y)&('$D(DTOUT)) NOUNA

NOUNC W ! K DIE S DA=PSSDOSE,DIE="^PS(50.606,",DR="10" D ^DIE K DIE G NOUN

NOUNQ W ! K DIC,DR,DIE,PSSDOSE,PSSNOUN

 Q

CHECK ;Check for running conversion

 S PSSNOCON=0

 S PSSYSIEN=$O(^PS(59.7,0))

 I $P($G(^PS(59.7,+$G(PSSYSIEN),80)),"^",3)=2 S PSSNOCON=1

 K PSSYSIEN I PSSNOCON W $C(7) W !!,"Cannot use this option, Dosage conversion is currently running!",!

 Q

TRAC ;

 N PSZZ,PSZZ1,PSZZ2,PSZSTA,PSZSTO,PSZWHO

 S PSZZ1=$O(^PS(59.7,0)),PSZZ2=$P($G(^PS(59.7,+$G(PSZZ1),80)),"^",3)

 I PSZZ2 D

 .S Y=$P($G(^PS(59.7,+$G(PSZZ1),80)),"^",4) I Y D DD^%DT S PSZSTA=$G(Y)

 .S Y=$P($G(^PS(59.7,+$G(PSZZ1),80)),"^",5) I Y D DD^%DT S PSZSTO=$G(Y)

 .K PSZWHOAR S DA=+$P($G(^PS(59.7,+$G(PSZZ1),80)),"^",6) I DA S DIC=200,DR=".01",DIQ(0)="E",DIQ="PSZWHOAR" D EN^DIQ1 S PSZWHO=$G(PSZWHOAR(200,DA,.01,"E")) K DIQ,PSZWHOAR,DR,DIC,DA

 H 1 W @IOF W !,?15,"Dosage Conversion Tracker Status",! F PSZZ=1:1:77 W "="

 I 'PSZZ2 W !,"The Dosage conversion has never been run!",! G TRACQ

 I PSZZ2=1 W !,"The Dosage conversion is queued to run at "_$G(PSZSTA),!,"It was queued by "_$G(PSZWHO),! G TRACQ

 I PSZZ2=2 W !,"The Dosage conversion is currently running.",!,"It started at "_$G(PSZSTA),! G TRACQ

 I PSZZ2=3 W !,"The Dosage conversion was last run by "_$G(PSZWHO),!,"It started on "_$G(PSZSTA)_" and ended on "_$G(PSZSTO),!

TRACQ W ! K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR W ! K DIR

 Q

FRE ;

 W ! K DIC S DIC(0)="QEAMZ",DIC("A")="Select Medication Instruction: ",DIC="^PS(51," D ^DIC K DIC I Y<1!($D(DTOUT))!($D(DUOUT)) G FREQ

 K DIE W ! S DA=+Y,DIE="^PS(51,",DR="31" D ^DIE G:$D(Y)!($D(DTOUT)) FREQ

 G FRE

FREQ W ! K DA,DIE,DR,DIC

 Q

FRRP ;

 W !!,"This report shows the MEDICATION INSTRUCTION file entries, along with the",!,"Synonym, Frequency and Expansion. Use the Edit Medication Instruction",!,"Frequency option to enter appropriate frequencies.",!

 K IOP,%ZIS,POP S %ZIS="QM" D ^%ZIS I $G(POP) W !!,"Nothing queued to print.",!! Q

 I $D(IO("Q")) S ZTRTN="ENF^PSSUTLPR",ZTDESC="Med Instruction Frequency report" D ^%ZTLOAD K %ZIS W !,"Report queued to print." Q

ENF ;

 U IO

 S PSSOUT=0,PSSDV=$S($E(IOST)="C":"C",1:"P"),PSSCT=1

 K PSSLINE,PSSF,PSSFR S $P(PSSLINE,"-",79)=""

 D ENFH

 S PSSF="" F  S PSSF=$O(^PS(51,"B",PSSF)) Q:PSSF=""!($G(PSSOUT))  F PSSFR=0:0 S PSSFR=$O(^PS(51,"B",PSSF,PSSFR)) Q:'PSSFR!($G(PSSOUT))  I $G(^PS(51,"B",PSSF,PSSFR))="" D

 .I ($Y+5)>IOSL D ENFH Q:$G(PSSOUT)

 .S PSSFNODE=$G(^PS(51,PSSFR,0)) Q:PSSFNODE=""

 .W !,$P(PSSFNODE,"^"),?11,$P(PSSFNODE,"^",3),?22,$P(PSSFNODE,"^",8),?30,$P(PSSFNODE,"^",2)

 I '$G(PSSOUT),$G(PSSDV)="C" W !!,"End of Report." K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR

 I $G(PSSDV)="C" W !

 E  W @IOF

 K PSSLINE,PSSOUT,PSSF,PSSFR,PSSCT,PSSDV D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"

 Q

ENFH ;

 I $G(PSSDV)="C",$G(PSSCT)'=1 W ! K DIR S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR K DIR I 'Y S PSSOUT=1 Q

 W @IOF W !?5,"MEDICATION INSTRUCTION FREQUENCY REPORT"_$S($G(PSSCT)=1:"",1:"  (cont.)"),?68,"PAGE: "_$G(PSSCT) S PSSCT=PSSCT+1

 W !!,"NAME",?10,"SYNONYM",?21,"FREQUENCY",?34,"EXPANSION",!,PSSLINE,!

 Q

SLS ;Called from PSSORUTL

 K PSSJZUNT

 I $P($G(PSSX(PSSA,PL3)),"^",2)'["/" S $P(PSSX(PSSA,PL3),"^",5)=$P($G(PSSX(PSSA,PL3)),"^")_$P($G(PSSX(PSSA,PL3)),"^",2) Q

 N PSSJ,PSSJ1,PSSJ2,PSSI,PSSJA,PSSJA1,PSSJB,PSSJB1,PSSWZI,PSSWZSL,PSSWZND,PSSWZSL1,PSSWZSL2,PSSWZSL3,PSSWZSL4,PSSWZSL5,PSSWZ50

 S PSSJ=$P($G(PSSX(PSSA,PL3)),"^"),PSSI=$P($G(PSSX(PSSA,PL3)),"^",2)

 S PSSWZSL=0,PSSWZI=+$P($G(PSSX(PSSA,PL3)),"^",6),PSSWZ50=$P($G(^PSDRUG(PSSWZI,"DOS")),"^")

 S PSSWZND=$$PSJST^PSNAPIS(+$P($G(^PSDRUG(PSSWZI,"ND")),"^"),+$P($G(^PSDRUG(PSSWZI,"ND")),"^",3)) S PSSWZND=+$P($G(PSSWZND),"^",2) ;I $G(PSSWZND),$G(PSSWZ50),+$G(PSSWZND)'=+$G(PSSWZ50) S PSSWZSL=1

 S PSSJA=$P(PSSI,"/"),PSSJB=$P(PSSI,"/",2),PSSJA1=+$G(PSSJA),PSSJB1=+$G(PSSJB)

 I '$G(PSSWZND) S $P(PSSX(PSSA,PL3),"^",5)=$P(PSSX(PSSA,PL3),"^") G SLSQ

 S PSSWZSL2=PSSWZ50/PSSWZND,PSSWZSL3=PSSWZSL2*+$P($G(PSSX(PSSA,PL3)),"^",3) S PSSWZSL4=PSSWZSL3*$S($G(PSSJB1):PSSJB1,1:1) S PSSWZSL5=$S('$G(PSSJB1):PSSWZSL4_$G(PSSJB),1:PSSWZSL4_$P(PSSJB,PSSJB1,2))

 S PSSJ2=$S('$G(PSSJA1):PSSJ,1:($G(PSSJA1)*PSSJ))_$S($G(PSSJA1):$P(PSSJA,PSSJA1,2),1:PSSJA)_"/"_$G(PSSWZSL5)

 S PSSJZUNT=$P(PSSI,"/")_"/"_$G(PSSWZSL4)_$S('$G(PSSJB1):$G(PSSJB),1:$P(PSSJB,PSSJB1,2)) S $P(PSSX(PSSA,PL3),"^",2)=PSSJZUNT

 S $P(PSSX(PSSA,PL3),"^",5)=PSSJ2

SLSQ Q

 ;

ADDRP ;

 D ^DIR K DIR S PSSTYPE=Y I Y["^"!($D(DIRUT)) K PSSTYPE W ! Q

 W !!?3,"*** THIS REPORT IS DESIGNED FOR 132 COLUMNS ***",!

 K IOP,%ZIS,POP S %ZIS="QM" D ^%ZIS I $G(POP) W !,"Nothing queued to print.",! K PSSTYPE W ! Q

 I '$G(DT) S DT=$$DT^XLFDT

 S X1=DT,X2=-365 D C^%DTC S PSSYRX=$G(X) K X,X1,X2

 I $D(IO("Q")) S ZTRTN="ADD^PSSREMCH",ZTDESC="Orderable Item re-matching report",ZTSAVE("PSSTYPE")="",ZTSAVE("PSSYRX")="" D ^%ZTLOAD K %ZIS W !,"Report queued to print." G END^PSSREMCH

 G ADD^PSSREMCH

PSSUTLPZ  ;BIR/RTR-Pre release report utility routine ;02/14/00

 +1       ;;1.0;PHARMACY DATA MANAGEMENT;**40**;9/30/97

 +2       ;

TEXT      ;Text for pre-release report

 +1        WRITE !!,"The current Orderable Item structure keeps Additives and Solutions matched to",!,"Orderable Items flagged for IV use. All Dispense Drugs are currently matched to",!,"Orderable Items that are not flagged for IV Use. This was done"

 +2        WRITE " to control "

 +3        WRITE !,"the finishing process of IV and Unit Dose orders entered through CPRS.",!,"The new Orderable Item structure will inactivate all IV flagged Orderable",!,"Items. All Additives and Solutions will be re-matched to non-IV flagged"

 +4        WRITE !,"Orderable Items, based on their Dispense Drug links.",!

 +5        WRITE !

           KILL DIR

           SET DIR(0)="E"

           DO ^DIR

           KILL DIR

           IF Y["^"!($DATA(DIRUT))

               KILL Y

               SET PSSOUT=1

               QUIT 

 +6        KILL PSSTYPE

 +7        KILL DIR

           SET DIR(0)="S^A:ADDITIVES;S:SOLUTIONS;B:BOTH"

           SET DIR("A")="Print report for Additives, Solutions, or Both"

           SET DIR("B")="B"

 +8        SET DIR("?")=" "

           SET DIR("?",1)="Enter 'A' to see how the Additives will be re-matched in the new Orderable"

 +9        SET DIR("?",2)="Item structure, enter 'S' to see how the Solutions will be re-matched in the"

           SET DIR("?",3)="new Orderable Item structure, enter 'B' to see both, enter '^' to exit."

 +10       QUIT 

INS       ;Convert non-numeric Instructions to Nouns

 +1        DO CHECK

           IF $GET(PSSNOCON)

               KILL PSSNOCON

               QUIT 

 +2        KILL PSSNOCON

 +3        WRITE !!,"This option will move all non-numeric Instructions to the Noun field in the",!,"Dosage Form file. If you do this, you will then need to review the Nouns and decide to mark them for Inpatient, Outpatient or both."

 +4        WRITE !

           KILL DIR

           SET DIR(0)="Y"

           SET DIR("A")="Convert all non-numeric Instructions to Nouns"

           SET DIR("B")="Y"

           DO ^DIR

           IF Y'=1

               WRITE !!,"Nothing converted.",!

               GOTO INSQ

 +5        WRITE !,"Converting.."

           HANG 1

 +6        NEW PSSD,PSSI,PSSINS

 +7        FOR PSSD=0:0

               SET PSSD=$ORDER(^PS(50.606,PSSD))

               IF 'PSSD

                   QUIT 

               IF $ORDER(^PS(50.606,PSSD,"INS",0))

                   Begin DoDot:1

 +8                    FOR PSSI=0:0

                           SET PSSI=$ORDER(^PS(50.606,PSSD,"INS",PSSI))

                           IF 'PSSI

                               QUIT 

                           SET PSSINS=$PIECE($GET(^PS(50.606,PSSD,"INS",PSSI,0)),"^")

                           IF PSSINS'=""

                               Begin DoDot:2

 +9                                IF PSSINS?.N!(PSSINS?.N1".".N)

                                       QUIT 

 +10                               IF $ORDER(^PS(50.606,PSSD,"NOUN","B",PSSINS,0))

                                       QUIT 

 +11                               KILL DIC,DD,DO

                                   SET DA(1)=PSSD

                                   SET DIC="^PS(50.606,"_DA(1)_",""NOUN"","

                                   SET DIC(0)="L"

                                   SET X=PSSINS

                                   DO FILE^DICN

                                   WRITE "."

                                   KILL DD,DO,DIC

                               End DoDot:2

                   End DoDot:1

 +12       WRITE !,"Finished converting Instructions to Nouns!"

INSQ       WRITE !

 +1        QUIT 

NOUN      ;Enter/edit Nouns

 +1        DO CHECK

           IF $GET(PSSNOCON)

               KILL PSSNOCON

               GOTO NOUNQ

 +2        KILL PSSNOCON

 +3        WRITE !

           KILL DIC

           SET DIC(0)="QEAMZ"

           SET DIC="^PS(50.606,"

           DO ^DIC

           IF Y<1!($DATA(DTOUT))!($DATA(DUOUT))

               GOTO NOUNQ

 +4        SET PSSDOSE=+Y

NOUNA      WRITE !!?2,"Dosage Form => ",$PIECE($GET(^PS(50.606,+PSSDOSE,0)),"^"),!

           KILL DIC

           SET DA(1)=PSSDOSE

           SET DIC="^PS(50.606,"_PSSDOSE_",""NOUN"","

           SET DIC(0)="QEAMLZ"

           Begin DoDot:1

 +1            SET DIC("W")="W ""  ""_$P($G(^PS(50.606,PSSDOSE,""NOUN"",+Y,0)),""^"",2)"

           End DoDot:1

           DO ^DIC

           IF Y<1!($DATA(DUOUT))!($DATA(DTOUT))

               GOTO NOUNC

 +2        SET PSSNOUN=+Y

 +3        KILL DIE

           SET DA(1)=PSSDOSE

           SET DA=PSSNOUN

           SET DR=".01;1;2"

           SET DIE="^PS(50.606,"_PSSDOSE_",""NOUN"","

           DO ^DIE

           KILL DIE

           IF '$DATA(Y)&('$DATA(DTOUT))

               GOTO NOUNA

NOUNC      WRITE !

           KILL DIE

           SET DA=PSSDOSE

           SET DIE="^PS(50.606,"

           SET DR="10"

           DO ^DIE

           KILL DIE

           GOTO NOUN

NOUNQ      WRITE !

           KILL DIC,DR,DIE,PSSDOSE,PSSNOUN

 +1        QUIT 

CHECK     ;Check for running conversion

 +1        SET PSSNOCON=0

 +2        SET PSSYSIEN=$ORDER(^PS(59.7,0))

 +3        IF $PIECE($GET(^PS(59.7,+$GET(PSSYSIEN),80)),"^",3)=2

               SET PSSNOCON=1

 +4        KILL PSSYSIEN

           IF PSSNOCON

               WRITE $CHAR(7)

               WRITE !!,"Cannot use this option, Dosage conversion is currently running!",!

 +5        QUIT 

TRAC      ;

 +1        NEW PSZZ,PSZZ1,PSZZ2,PSZSTA,PSZSTO,PSZWHO

 +2        SET PSZZ1=$ORDER(^PS(59.7,0))

           SET PSZZ2=$PIECE($GET(^PS(59.7,+$GET(PSZZ1),80)),"^",3)

 +3        IF PSZZ2

               Begin DoDot:1

 +4                SET Y=$PIECE($GET(^PS(59.7,+$GET(PSZZ1),80)),"^",4)

                   IF Y

                       DO DD^%DT

                       SET PSZSTA=$GET(Y)

 +5                SET Y=$PIECE($GET(^PS(59.7,+$GET(PSZZ1),80)),"^",5)

                   IF Y

                       DO DD^%DT

                       SET PSZSTO=$GET(Y)

 +6                KILL PSZWHOAR

                   SET DA=+$PIECE($GET(^PS(59.7,+$GET(PSZZ1),80)),"^",6)

                   IF DA

                       SET DIC=200

                       SET DR=".01"

                       SET DIQ(0)="E"

                       SET DIQ="PSZWHOAR"

                       DO EN^DIQ1

                       SET PSZWHO=$GET(PSZWHOAR(200,DA,.01,"E"))

                       KILL DIQ,PSZWHOAR,DR,DIC,DA

               End DoDot:1

 +7        HANG 1

           WRITE @IOF

           WRITE !,?15,"Dosage Conversion Tracker Status",!

           FOR PSZZ=1:1:77

               WRITE "="

 +8        IF 'PSZZ2

               WRITE !,"The Dosage conversion has never been run!",!

               GOTO TRACQ

 +9        IF PSZZ2=1

               WRITE !,"The Dosage conversion is queued to run at "_$GET(PSZSTA),!,"It was queued by "_$GET(PSZWHO),!

               GOTO TRACQ

 +10       IF PSZZ2=2

               WRITE !,"The Dosage conversion is currently running.",!,"It started at "_$GET(PSZSTA),!

               GOTO TRACQ

 +11       IF PSZZ2=3

               WRITE !,"The Dosage conversion was last run by "_$GET(PSZWHO),!,"It started on "_$GET(PSZSTA)_" and ended on "_$GET(PSZSTO),!

TRACQ      WRITE !

           KILL DIR

           SET DIR(0)="E"

           SET DIR("A")="Press Return to continue"

           DO ^DIR

           WRITE !

           KILL DIR

 +1        QUIT 

FRE       ;

 +1        WRITE !

           KILL DIC

           SET DIC(0)="QEAMZ"

           SET DIC("A")="Select Medication Instruction: "

           SET DIC="^PS(51,"

           DO ^DIC

           KILL DIC

           IF Y<1!($DATA(DTOUT))!($DATA(DUOUT))

               GOTO FREQ

 +2        KILL DIE

           WRITE !

           SET DA=+Y

           SET DIE="^PS(51,"

           SET DR="31"

           DO ^DIE

           IF $DATA(Y)!($DATA(DTOUT))

               GOTO FREQ

 +3        GOTO FRE

FREQ       WRITE !

           KILL DA,DIE,DR,DIC

 +1        QUIT 

FRRP      ;

 +1        WRITE !!,"This report shows the MEDICATION INSTRUCTION file entries, along with the",!,"Synonym, Frequency and Expansion. Use the Edit Medication Instruction",!,"Frequency option to enter appropriate frequencies.",!

 +2        KILL IOP,%ZIS,POP

           SET %ZIS="QM"

           DO ^%ZIS

           IF $GET(POP)

               WRITE !!,"Nothing queued to print.",!!

               QUIT 

 +3        IF $DATA(IO("Q"))

               SET ZTRTN="ENF^PSSUTLPR"

               SET ZTDESC="Med Instruction Frequency report"

               DO ^%ZTLOAD

               KILL %ZIS

               WRITE !,"Report queued to print."

               QUIT 

ENF       ;

 +1        USE IO

 +2        SET PSSOUT=0

           SET PSSDV=$SELECT($EXTRACT(IOST)="C":"C",1:"P")

           SET PSSCT=1

 +3        KILL PSSLINE,PSSF,PSSFR

           SET $PIECE(PSSLINE,"-",79)=""

 +4        DO ENFH

 +5        SET PSSF=""

           FOR 

               SET PSSF=$ORDER(^PS(51,"B",PSSF))

               IF PSSF=""!($GET(PSSOUT))

                   QUIT 

               FOR PSSFR=0:0

                   SET PSSFR=$ORDER(^PS(51,"B",PSSF,PSSFR))

                   IF 'PSSFR!($GET(PSSOUT))

                       QUIT 

                   IF $GET(^PS(51,"B",PSSF,PSSFR))=""

                       Begin DoDot:1

 +6                        IF ($Y+5)>IOSL

                               DO ENFH

                               IF $GET(PSSOUT)

                                   QUIT 

 +7                        SET PSSFNODE=$GET(^PS(51,PSSFR,0))

                           IF PSSFNODE=""

                               QUIT 

 +8                        WRITE !,$PIECE(PSSFNODE,"^"),?11,$PIECE(PSSFNODE,"^",3),?22,$PIECE(PSSFNODE,"^",8),?30,$PIECE(PSSFNODE,"^",2)

                       End DoDot:1

 +9        IF '$GET(PSSOUT)

               IF $GET(PSSDV)="C"

                   WRITE !!,"End of Report."

                   KILL DIR

                   SET DIR(0)="E"

                   SET DIR("A")="Press Return to continue"

                   DO ^DIR

                   KILL DIR

 +10       IF $GET(PSSDV)="C"

               WRITE !

 +11      IF '$TEST

               WRITE @IOF

 +12       KILL PSSLINE,PSSOUT,PSSF,PSSFR,PSSCT,PSSDV

           DO ^%ZISC

           IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +13       QUIT 

ENFH      ;

 +1        IF $GET(PSSDV)="C"

               IF $GET(PSSCT)'=1

                   WRITE !

                   KILL DIR

                   SET DIR(0)="E"

                   SET DIR("A")="Press Return to continue, '^' to exit"

                   DO ^DIR

                   KILL DIR

                   IF 'Y

                       SET PSSOUT=1

                       QUIT 

 +2        WRITE @IOF

           WRITE !?5,"MEDICATION INSTRUCTION FREQUENCY REPORT"_$SELECT($GET(PSSCT)=1:"",1:"  (cont.)"),?68,"PAGE: "_$GET(PSSCT)

           SET PSSCT=PSSCT+1

 +3        WRITE !!,"NAME",?10,"SYNONYM",?21,"FREQUENCY",?34,"EXPANSION",!,PSSLINE,!

 +4        QUIT 

SLS       ;Called from PSSORUTL

 +1        KILL PSSJZUNT

 +2        IF $PIECE($GET(PSSX(PSSA,PL3)),"^",2)'["/"

               SET $PIECE(PSSX(PSSA,PL3),"^",5)=$PIECE($GET(PSSX(PSSA,PL3)),"^")_$PIECE($GET(PSSX(PSSA,PL3)),"^",2)

               QUIT 

 +3        NEW PSSJ,PSSJ1,PSSJ2,PSSI,PSSJA,PSSJA1,PSSJB,PSSJB1,PSSWZI,PSSWZSL,PSSWZND,PSSWZSL1,PSSWZSL2,PSSWZSL3,PSSWZSL4,PSSWZSL5,PSSWZ50

 +4        SET PSSJ=$PIECE($GET(PSSX(PSSA,PL3)),"^")

           SET PSSI=$PIECE($GET(PSSX(PSSA,PL3)),"^",2)

 +5        SET PSSWZSL=0

           SET PSSWZI=+$PIECE($GET(PSSX(PSSA,PL3)),"^",6)

           SET PSSWZ50=$PIECE($GET(^PSDRUG(PSSWZI,"DOS")),"^")

 +6       ;I $G(PSSWZND),$G(PSSWZ50),+$G(PSSWZND)'=+$G(PSSWZ50) S PSSWZSL=1

           SET PSSWZND=$$PSJST^PSNAPIS(+$PIECE($GET(^PSDRUG(PSSWZI,"ND")),"^"),+$PIECE($GET(^PSDRUG(PSSWZI,"ND")),"^",3))

           SET PSSWZND=+$PIECE($GET(PSSWZND),"^",2)

 +7        SET PSSJA=$PIECE(PSSI,"/")

           SET PSSJB=$PIECE(PSSI,"/",2)

           SET PSSJA1=+$GET(PSSJA)

           SET PSSJB1=+$GET(PSSJB)

 +8        IF '$GET(PSSWZND)

               SET $PIECE(PSSX(PSSA,PL3),"^",5)=$PIECE(PSSX(PSSA,PL3),"^")

               GOTO SLSQ

 +9        SET PSSWZSL2=PSSWZ50/PSSWZND

           SET PSSWZSL3=PSSWZSL2*+$PIECE($GET(PSSX(PSSA,PL3)),"^",3)

           SET PSSWZSL4=PSSWZSL3*$SELECT($GET(PSSJB1):PSSJB1,1:1)

           SET PSSWZSL5=$SELECT('$GET(PSSJB1):PSSWZSL4_$GET(PSSJB),1:PSSWZSL4_$PIECE(PSSJB,PSSJB1,2))

 +10       SET PSSJ2=$SELECT('$GET(PSSJA1):PSSJ,1:($GET(PSSJA1)*PSSJ))_$SELECT($GET(PSSJA1):$PIECE(PSSJA,PSSJA1,2),1:PSSJA)_"/"_$GET(PSSWZSL5)

 +11       SET PSSJZUNT=$PIECE(PSSI,"/")_"/"_$GET(PSSWZSL4)_$SELECT('$GET(PSSJB1):$GET(PSSJB),1:$PIECE(PSSJB,PSSJB1,2))

           SET $PIECE(PSSX(PSSA,PL3),"^",2)=PSSJZUNT

 +12       SET $PIECE(PSSX(PSSA,PL3),"^",5)=PSSJ2

SLSQ       QUIT 

 +1       ;

ADDRP     ;

 +1        DO ^DIR

           KILL DIR

           SET PSSTYPE=Y

           IF Y["^"!($DATA(DIRUT))

               KILL PSSTYPE

               WRITE !

               QUIT 

 +2        WRITE !!?3,"*** THIS REPORT IS DESIGNED FOR 132 COLUMNS ***",!

 +3        KILL IOP,%ZIS,POP

           SET %ZIS="QM"

           DO ^%ZIS

           IF $GET(POP)

               WRITE !,"Nothing queued to print.",!

               KILL PSSTYPE

               WRITE !

               QUIT 

 +4        IF '$GET(DT)

               SET DT=$$DT^XLFDT

 +5        SET X1=DT

           SET X2=-365

           DO C^%DTC

           SET PSSYRX=$GET(X)

           KILL X,X1,X2

 +6        IF $DATA(IO("Q"))

               SET ZTRTN="ADD^PSSREMCH"

               SET ZTDESC="Orderable Item re-matching report"

               SET ZTSAVE("PSSTYPE")=""

               SET ZTSAVE("PSSYRX")=""

               DO ^%ZTLOAD

               KILL %ZIS

               WRITE !,"Report queued to print."

               GOTO END^PSSREMCH

 +7        GOTO ADD^PSSREMCH