Routine: PSNFRMLY

PSNFRMLY ;BIR/WRT-formulary report routine ;09/26/98 11:08

 ;;4.0; NATIONAL DRUG FILE;**5**; 30 Oct 98

 W !!,"This report gives you a printed copy of formulary drugs from your local file",!,"with synonyms marked as trade names. You"

 W " will be asked if you want to include",!,"supply items. You are asked to type in a title for this report.",!,"You are then asked to print by Generic Name/Tradename or VA Class Code."

 W !,"If you choose to print by VA Class Code, it"

 W " will ask you to pick a range",!,"of VA Drug Class Codes."

 W " Only active drugs will print. Drugs with",!,"a future inactive date will print as well."

 W !,"You may queue the report to print, if you wish.",!! D SUPPLY Q:$D(DIRUT)

HEADER R !,"Enter title for report: HOSPITAL// ",PSNANS:DTIME S:'$T PSNANS="^" S:PSNANS']"" PSNANS="HOSPITAL" G:"^"[$E(PSNANS) KILL

 I $D(PSNANS),PSNANS?.E1C.E K PSNANS G HEADER

 I $D(PSNANS),$L(PSNANS)>30 W !,"Your answer must 30 characters or less.",! K PSNANS G HEADER

 I $D(PSNANS),"@"[$E(PSNANS) W !,"You cannot delete. This is a free text field. Please enter the name that you",!,"want to print at the top of this report.",! K PSNANS G HEADER

 I $D(PSNANS),"?"[$E(PSNANS) W !!,"Enter the name you want to print. This name will print at the top of this report",!,"along with the word ""FORMULARY""." D UPAR^PSNHELP K PSNANS G HEADER

 I $D(PSNANS) I PSNANS'="^" D ASKEM I $D(PSNANSR),PSNANSR="^" K PSNANS,PSNANSR

BEGIN K ^TMP($J) S DIC="^PSDRUG(",L=0,FLDS="[PSNFRMPRT]",BY="@VA CLASSIFICATION",DHD="@@",DIOEND="D ENQ1^PSNHFRM1" D EN1^DIP

 D KILL Q

HEAD1 I "Cc"[$E(PSNANSR) W !,PSNANS_" FORMULARY   (BY VA CLASS)",!

KILL K PSNANS,PSNANSR,PSNB,^TMP($J,"PSNDT"),PSNDATE

ASKEM W !!,"You may print by DRUG GENERIC NAME/TRADENAME or VA CLASS CODE.",!,"Enter a <RET> or ""G"" to print by DRUG GENERIC NAME/TRADENAME or",!,"""C"" for VA CLASS CODE."

 W !!,"Print by:" R !,?3,"DRUG GENERIC NAME/TRADENAME// ",PSNANSR:DTIME S:'$T PSNANSR="^" Q:PSNANSR="^"  S:PSNANSR']"" PSNANSR="Gg"

 I "?"[$E(PSNANSR) W !!,?5,"Enter a ""<RET>"" or ""Gg"" to print by local generic name/tradename.",!?5,"Enter a ""C"" to print by VA Drug Class Code",!?5,"You may enter an ""^"" to exit." K PSNANSR G ASKEM

 I "^"[$E(PSNANSR) Q

 I "CcGg"'[$E(PSNANSR) G ASKEM

 I $D(PSNANSR),PSNANSR?.E1C.E K PSNANSR G ASKEM

 I "Cc"[$E(PSNANSR) W ?40,"CLASS",! D BEGIN

 I $D(PSNANSR),"Gg"[$E(PSNANSR) W ?40,"GENERIC/TRADE",! K ^TMP($J) S PSNANS=PSNANS_" FORMULARY" D ^PSNHFRM

SUPPLY K DIR S DIR(0)="Y",DIR("B")="NO",DIR("A")="Do you wish to include supply items" D ^DIR K DIR Q:$D(DIRUT)

 I Y(0)="YES" S SF=1

 I Y(0)="NO" S SF=0

PSNFRMLY  ;BIR/WRT-formulary report routine ;09/26/98 11:08

 +1       ;;4.0; NATIONAL DRUG FILE;**5**; 30 Oct 98

 +2        WRITE !!,"This report gives you a printed copy of formulary drugs from your local file",!,"with synonyms marked as trade names. You"

 +3        WRITE " will be asked if you want to include",!,"supply items. You are asked to type in a title for this report.",!,"You are then asked to print by Generic Name/Tradename or VA Class Code."

 +4        WRITE !,"If you choose to print by VA Class Code, it"

 +5        WRITE " will ask you to pick a range",!,"of VA Drug Class Codes."

 +6        WRITE " Only active drugs will print. Drugs with",!,"a future inactive date will print as well."

 +7        WRITE !,"You may queue the report to print, if you wish.",!!

           DO SUPPLY

           IF $DATA(DIRUT)

               QUIT

HEADER     READ !,"Enter title for report: HOSPITAL// ",PSNANS:DTIME

           IF '$TEST

               SET PSNANS="^"

           IF PSNANS']""

               SET PSNANS="HOSPITAL"

           IF "^"[$EXTRACT(PSNANS)

               GOTO KILL

 +1        IF $DATA(PSNANS)

               IF PSNANS?.E1C.E

                   KILL PSNANS

                   GOTO HEADER

 +2        IF $DATA(PSNANS)

               IF $LENGTH(PSNANS)>30

                   WRITE !,"Your answer must 30 characters or less.",!

                   KILL PSNANS

                   GOTO HEADER

 +3        IF $DATA(PSNANS)

               IF "@"[$EXTRACT(PSNANS)

                   WRITE !,"You cannot delete. This is a free text field. Please enter the name that you",!,"want to print at the top of this report.",!

                   KILL PSNANS

                   GOTO HEADER

 +4        IF $DATA(PSNANS)

               IF "?"[$EXTRACT(PSNANS)

                   WRITE !!,"Enter the name you want to print. This name will print at the top of this report",!,"along with the word ""FORMULARY""."

                   DO UPAR^PSNHELP

                   KILL PSNANS

                   GOTO HEADER

 +5        IF $DATA(PSNANS)

               IF PSNANS'="^"

                   DO ASKEM

                   IF $DATA(PSNANSR)

                       IF PSNANSR="^"

                           KILL PSNANS,PSNANSR

 +6        QUIT

BEGIN      KILL ^TMP($JOB)

           SET DIC="^PSDRUG("

           SET L=0

           SET FLDS="[PSNFRMPRT]"

           SET BY="@VA CLASSIFICATION"

           SET DHD="@@"

           SET DIOEND="D ENQ1^PSNHFRM1"

           DO EN1^DIP

 +1        DO KILL

           QUIT

HEAD1      IF "Cc"[$EXTRACT(PSNANSR)

               WRITE !,PSNANS_" FORMULARY   (BY VA CLASS)",!

 +1        QUIT

KILL       KILL PSNANS,PSNANSR,PSNB,^TMP($JOB,"PSNDT"),PSNDATE

 +1        QUIT

ASKEM      WRITE !!,"You may print by DRUG GENERIC NAME/TRADENAME or VA CLASS CODE.",!,"Enter a <RET> or ""G"" to print by DRUG GENERIC NAME/TRADENAME or",!,"""C"" for VA CLASS CODE."

 +1        WRITE !!,"Print by:"

           READ !,?3,"DRUG GENERIC NAME/TRADENAME// ",PSNANSR:DTIME

           IF '$TEST

               SET PSNANSR="^"

           IF PSNANSR="^"

               QUIT

           IF PSNANSR']""

               SET PSNANSR="Gg"

 +2        IF "?"[$EXTRACT(PSNANSR)

               WRITE !!,?5,"Enter a ""<RET>"" or ""Gg"" to print by local generic name/tradename.",!?5,"Enter a ""C"" to print by VA Drug Class Code",!?5,"You may enter an ""^"" to exit."

               KILL PSNANSR

               GOTO ASKEM

 +3        IF "^"[$EXTRACT(PSNANSR)

               QUIT

 +4        IF "CcGg"'[$EXTRACT(PSNANSR)

               GOTO ASKEM

 +5        IF $DATA(PSNANSR)

               IF PSNANSR?.E1C.E

                   KILL PSNANSR

                   GOTO ASKEM

 +6        IF "Cc"[$EXTRACT(PSNANSR)

               WRITE ?40,"CLASS",!

               DO BEGIN

 +7        IF $DATA(PSNANSR)

               IF "Gg"[$EXTRACT(PSNANSR)

                   WRITE ?40,"GENERIC/TRADE",!

                   KILL ^TMP($JOB)

                   SET PSNANS=PSNANS_" FORMULARY"

                   DO ^PSNHFRM

 +8        QUIT

SUPPLY     KILL DIR

           SET DIR(0)="Y"

           SET DIR("B")="NO"

           SET DIR("A")="Do you wish to include supply items"

           DO ^DIR

           KILL DIR

           IF $DATA(DIRUT)

               QUIT

 +1        IF Y(0)="YES"

               SET SF=1

 +2        IF Y(0)="NO"

               SET SF=0

 +3        QUIT

PSNFRMLY.m