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)
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
Q
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)",!
Q
KILL K PSNANS,PSNANSR,PSNB,^TMP($J,"PSNDT"),PSNDATE
Q
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
Q
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
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSNFRMLY 2644 printed Nov 22, 2024@17:34:05 Page 2
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
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
