PSNLOOK.m

PSNLOOK ;BIR/WRT-Look up into drug file ; 06/19/03 15:00

 ;;4.0; NATIONAL DRUG FILE;**2,3,5,11,22,27,62,70,169**; 30 Oct 98;Build 8

 ;

 ; Reference to ^PSDRUG supported by DBIA# 2192

 ; Reference to ^PS(50.606 supported by DBIA# 2174

 ;

 ;USE PSNLK*

BEGIN ;

 D ASK

 N PSNLKDA,PSNLKIND,PSNLKCL,PSNLKNOD,PSNLKVPN,PSNLKID,PSNLKVDU,PSNLKTR,PSNLKDAV,PSNLKGK,PSNLKPMI,PSNLKQQ,DIC,X,Y,DLAYGO,DTOUT,DUOUT,DIR,DIRUT,DIROUT,%DT

 N PSNLKMAP,PSNLKENG,PSNLKDF,PSNLKSTR,PSNLKUN,PSNLKFRM,PSNLKUNT,PSNLKNFN,PSNLKBB,PSNLKAND,PSNLKGR,PSNLKIST,PSNLKIUT,PSNLKSEV,PSNLKCSF,PSNLKSP,PSNLKNND,PSNLKCC,PSNLKSCL,PSNLKZ,PSNLKRE,PSNLKWRT,PSNZZFS

 N PSNLKL1,PSNLKL2,PSNLKIUN,PSNZZFSA

SELD ;Select Drug

 K PSNLKDA,PSNLKIND,PSNLKCL,PSNLKNOD,PSNLKVPN,PSNLKID,PSNLKVDU,PSNLKTR,PSNLKDAV,PSNLKGK,PSNLKPMI,PSNLKQQ,DIC,X,Y,DLAYGO,DTOUT,DUOUT,DIR,DIRUT,DIROUT,%DT

 K PSNLKMAP,PSNLKENG,PSNLKDF,PSNLKSTR,PSNLKUN,PSNLKFRM,PSNLKUNT,PSNLKNFN,PSNLKBB,PSNLKAND,PSNLKGR,PSNLKIST,PSNLKIUT,PSNLKSEV,PSNLKCSF,PSNLKSP,PSNLKNND,PSNLKCC,PSNLKSCL,PSNLKZ,PSNLKRE,PSNLKWRT,PSNZZFS

 K PSNLKL1,PSNLKL2,PSNLKIUN,PSNZZFSA

 W ! K DIC S DIC=50,DIC(0)="QEAM" D ^DIC I Y<0!($D(DTOUT))!($D(DUOUT)) Q

 S PSNLKDA=+Y K Y

 S PSNLKIND=$P($G(^PSDRUG(PSNLKDA,"I")),"^") I PSNLKIND,PSNLKIND<DT  S Y=PSNLKIND D DD^%DT W !!,"This drug has an Inactive date of "_$G(Y),! D MESS G SELD

 D DSPLY

 D HG

 G SELD

 ;

ASK W !!,"This option will allow you to look up entries in your local DRUG file. It will",!,"display National Drug File software match information.",!

 Q

DSPLY W @IOF W !?14,"DRUG Generic Name:  ",$P($G(^PSDRUG(PSNLKDA,0)),"^") I $D(^PSDRUG(PSNLKDA,"ND")) S PSNLKCL=$P(^("ND"),"^",6)

 I $D(^PSDRUG(PSNLKDA,"ND")),$P(^PSDRUG(PSNLKDA,"ND"),"^",2)]"" S PSNLKNOD=^PSDRUG(PSNLKDA,"ND") D DSPLY1,DSPLY2,PRODF,DSP,ING,SV,DSP1,RESTN Q

 W !?8,"*** NO NATIONAL DRUG FILE INFORMATION ***",!

 Q

DSPLY1 W !?5,"VA Product Name: ",$P(PSNLKNOD,"^",2)

 W !?5,"VA Generic Name: ",$P($G(^PSNDF(50.6,$P(PSNLKNOD,"^"),0)),"^")

 Q

DSPLY2 ;

 S (PSNLKVPN,PSNLKID,PSNLKVDU,PSNLKTR)=""

 K X S PSNLKDAV=$P(PSNLKNOD,"^"),PSNLKGK=$P(PSNLKNOD,"^",3),X=$$PROD2^PSNAPIS(PSNLKDAV,PSNLKGK) I $P(X,"^")]"" S PSNLKVPN=$P(X,"^"),PSNLKID=$P(X,"^",2),PSNLKTR=$P(X,"^",3),PSNLKVDU=$P(X,"^",4)

 K PSNLKPMI I X]"" S PSNLKQQ=$P(^PSNDF(50.68,PSNLKGK,1),"^",5) D GCN

 K X

 Q

GCN I PSNLKQQ']"" S PSNLKPMI="None" Q

 ;

GCN1 ; 

 I $D(^PS(50.623,"B",PSNLKQQ)) S PSNLKMAP=$O(^PS(50.623,"B",PSNLKQQ,0)),PSNLKENG=$P(^PS(50.623,PSNLKMAP,0),"^",2),PSNLKPMI=$P(^PS(50.621,+PSNLKENG,0),"^") Q

 S PSNLKPMI="None"

 Q

DSPLY3 W ?50,"Transmit To CMOP: "

 I PSNLKTR=1 W "YES"

 I PSNLKTR=0 W "NO"

 Q

PRODF ;

 S X=$$PROD0^PSNAPIS(PSNLKDAV,PSNLKGK)

 S PSNLKDF=+$P(X,"^",2),PSNLKSTR=$P(X,"^",3),PSNLKUN=+$P(X,"^",4),PSNLKFRM=$S($G(PSNLKDF):$P($G(^PS(50.606,PSNLKDF,0)),"^"),1:""),PSNLKUNT=$S($G(PSNLKUN):$P($G(^PS(50.607,PSNLKUN,0)),"^"),1:""),PSNLKNFN=$P(^PSNDF(50.68,PSNLKGK,0),"^",6)

 K X

 Q

ING F PSNLKBB=0:0 S PSNLKBB=$O(^PSNDF(50.68,PSNLKGK,2,PSNLKBB)) Q:'PSNLKBB  D

 .I $D(^PSNDF(50.68,PSNLKGK,2,PSNLKBB,0)) S PSNLKAND=$G(^PSNDF(50.68,PSNLKGK,2,PSNLKBB,0)),PSNLKGR=$P(^PS(50.416,$P(PSNLKAND,"^",1),0),"^"),PSNLKIST=$P(PSNLKAND,"^",2),PSNLKIUT=$P(PSNLKAND,"^",3) K PSNLKIUN D ING1,IN2

 Q

IN2 W ?3,PSNLKGR,?50,"Str: ",PSNLKIST W:PSNLKIUT ?65,"Unt: ",$G(PSNLKIUN) W !

 Q

ING1 S:$P(^PS(50.416,$P(PSNLKAND,"^"),0),"^",2) PSNLKGR=$P($G(^PS(50.416,$P(^PS(50.416,$P(PSNLKAND,"^"),0),"^",2),0)),"^") I PSNLKIUT S PSNLKIUN=$P(^PS(50.607,PSNLKIUT,0),"^")

 Q

SC I $O(^PSNDF(50.68,PSNLKGK,4,0)) W !,"Secondary Class(es): ",! F PSNLKCC=0:0 S PSNLKCC=$O(^PSNDF(50.68,PSNLKGK,4,PSNLKCC)) Q:'PSNLKCC  S PSNLKZ=$P($G(^PSNDF(50.68,PSNLKGK,4,PSNLKCC,0)),"^") I PSNLKZ D

 .S PSNLKSCL=$P($G(^PS(50.605,PSNLKZ,0)),"^") D SC1

 Q

SC1 W "   ",PSNLKSCL

 Q

SV S PSNLKSEV=$G(^PSNDF(50.68,PSNLKGK,7)) I PSNLKSEV]"" S PSNLKCSF=$P(PSNLKSEV,"^"),PSNLKSP=$P(PSNLKSEV,"^",2) S:PSNLKSP="M" PSNLKSP="Multi" S:PSNLKSP="S" PSNLKSP="Single" D SV1

 Q

SV1 S PSNZZFSA=PSNLKGK_"," S PSNZZFS=$$GET1^DIQ(50.68,PSNZZFSA,19) I $G(PSNZZFS)="" S PSNZZFS="None"

 S PSNLKNND=$P(^PSNDF(50.68,PSNLKGK,7),"^",3)

 Q

DSP W !,"Dosage Form: ",PSNLKFRM_$S('$G(PSNLKDF):"",$P($G(^PS(50.606,PSNLKDF,1)),"^")=1:"  (Exclude from Dosing Cks)",1:"")

 S PSNLKL1=$L(PSNLKSTR),PSNLKL2=$S($G(PSNLKUN):$L(PSNLKUNT),1:0)

 I (PSNLKL1+PSNLKL2)<62 W !,"Strength: ",PSNLKSTR W:$G(PSNLKUN) " Units: "_PSNLKUNT G PSDZZ

 W !,"Strength: ",PSNLKSTR

 I $G(PSNLKUN) D

 .W !,"Units: " I PSNLKL2<72 W PSNLKUNT Q

 .W !,PSNLKUNT

PSDZZ ;

 W !,"National Formulary Name: ",PSNLKNFN,!,"VA Print Name: ",PSNLKVPN,!,"VA Product Identifier: ",PSNLKID D DSPLY3 W !,"VA Dispense Unit: ",PSNLKVDU I $D(PSNLKPMI) W !,"PMIS: ",PSNLKPMI

 W !,"Active Ingredients: ",!

 Q

DSP1 D HG W "Primary Drug Class: ",$P(^PS(50.605,PSNLKCL,0),"^") D SC W !,"CS Federal Schedule: ",$G(PSNLKCSF)_"  "_$G(PSNZZFS),!,"Single/Multi Source Product: ",$G(PSNLKSP)

 I $G(PSNLKNND)]"" W !,"Inactivation Date: " S Y=PSNLKNND D DD^%DT W Y K Y

 W !,"Max Single Dose: ",$P(PSNLKSEV,"^",4),?45,"Min Single Dose: ",$P(PSNLKSEV,"^",5)

 W !,"Max Daily Dose: ",$P(PSNLKSEV,"^",6),?45,"Min Daily Dose: ",$P(PSNLKSEV,"^",7),!,"Max Cumulative Dose: ",$P(PSNLKSEV,"^",8)

 W !,"National Formulary Indicator: " I $D(^PSNDF(50.68,PSNLKGK,5)) W:$P(^PSNDF(50.68,PSNLKGK,5),"^")=0 "No" W:$P(^PSNDF(50.68,PSNLKGK,5),"^")=1 "Yes"

 W !

 I $G(^PSNDF(50.68,PSNLKGK,8)) W !,"Exclude Drg-Drg Interaction Ck: Yes (No check for Drug-Drug Interactions)"

 D OVER

 W !

 Q

RESTN I $O(^PSNDF(50.68,PSNLKGK,6,0)) W !,"Restriction: " F PSNLKRE=0:0 S PSNLKRE=$O(^PSNDF(50.68,PSNLKGK,6,PSNLKRE)) Q:'PSNLKRE  S PSNLKWRT=$G(^PSNDF(50.68,PSNLKGK,6,PSNLKRE,0)) W !,PSNLKWRT

 Q

HG ;

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

 W @IOF

 Q

MESS ;

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

 Q

 ;

OVER ;

 W !,"Override DF Exclude from Dosage Checks: "_$S($P($G(^PSNDF(50.68,PSNLKGK,9)),"^")=1:"Yes",$P($G(^PSNDF(50.68,PSNLKGK,9)),"^")=0:"No",1:"") I $P($G(^PSNDF(50.68,PSNLKGK,9)),"^")=1 D

 .I '$G(PSNLKDF) Q

 .I '$D(^PS(50.606,PSNLKDF,0)) Q

 .I $P($G(^PS(50.606,PSNLKDF,1)),"^")=1 W " (Dosage Checks shall be performed)" Q

 .I $P($G(^PS(50.606,PSNLKDF,1)),"^")=0 W " (No Dosage Checks performed)"

 Q

PSNLOOK   ;BIR/WRT-Look up into drug file ; 06/19/03 15:00

 +1       ;;4.0; NATIONAL DRUG FILE;**2,3,5,11,22,27,62,70,169**; 30 Oct 98;Build 8

 +2       ;

 +3       ; Reference to ^PSDRUG supported by DBIA# 2192

 +4       ; Reference to ^PS(50.606 supported by DBIA# 2174

 +5       ;

 +6       ;USE PSNLK*

BEGIN     ;

 +1        DO ASK

 +2        NEW PSNLKDA,PSNLKIND,PSNLKCL,PSNLKNOD,PSNLKVPN,PSNLKID,PSNLKVDU,PSNLKTR,PSNLKDAV,PSNLKGK,PSNLKPMI,PSNLKQQ,DIC,X,Y,DLAYGO,DTOUT,DUOUT,DIR,DIRUT,DIROUT,%DT

 +3        NEW PSNLKMAP,PSNLKENG,PSNLKDF,PSNLKSTR,PSNLKUN,PSNLKFRM,PSNLKUNT,PSNLKNFN,PSNLKBB,PSNLKAND,PSNLKGR,PSNLKIST,PSNLKIUT,PSNLKSEV,PSNLKCSF,PSNLKSP,PSNLKNND,PSNLKCC,PSNLKSCL,PSNLKZ,PSNLKRE,PSNLKWRT,PSNZZFS

 +4        NEW PSNLKL1,PSNLKL2,PSNLKIUN,PSNZZFSA

SELD      ;Select Drug

 +1        KILL PSNLKDA,PSNLKIND,PSNLKCL,PSNLKNOD,PSNLKVPN,PSNLKID,PSNLKVDU,PSNLKTR,PSNLKDAV,PSNLKGK,PSNLKPMI,PSNLKQQ,DIC,X,Y,DLAYGO,DTOUT,DUOUT,DIR,DIRUT,DIROUT,%DT

 +2        KILL PSNLKMAP,PSNLKENG,PSNLKDF,PSNLKSTR,PSNLKUN,PSNLKFRM,PSNLKUNT,PSNLKNFN,PSNLKBB,PSNLKAND,PSNLKGR,PSNLKIST,PSNLKIUT,PSNLKSEV,PSNLKCSF,PSNLKSP,PSNLKNND,PSNLKCC,PSNLKSCL,PSNLKZ,PSNLKRE,PSNLKWRT,PSNZZFS

 +3        KILL PSNLKL1,PSNLKL2,PSNLKIUN,PSNZZFSA

 +4        WRITE !

           KILL DIC

           SET DIC=50

           SET DIC(0)="QEAM"

           DO ^DIC

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

               QUIT 

 +5        SET PSNLKDA=+Y

           KILL Y

 +6        SET PSNLKIND=$PIECE($GET(^PSDRUG(PSNLKDA,"I")),"^")

           IF PSNLKIND

               IF PSNLKIND<DT

                   SET Y=PSNLKIND

                   DO DD^%DT

                   WRITE !!,"This drug has an Inactive date of "_$GET(Y),!

                   DO MESS

                   GOTO SELD

 +7        DO DSPLY

 +8        DO HG

 +9        GOTO SELD

 +10      ;

ASK        WRITE !!,"This option will allow you to look up entries in your local DRUG file. It will",!,"display National Drug File software match information.",!

 +1        QUIT 

DSPLY      WRITE @IOF

           WRITE !?14,"DRUG Generic Name:  ",$PIECE($GET(^PSDRUG(PSNLKDA,0)),"^")

           IF $DATA(^PSDRUG(PSNLKDA,"ND"))

               SET PSNLKCL=$PIECE(^("ND"),"^",6)

 +1        IF $DATA(^PSDRUG(PSNLKDA,"ND"))

               IF $PIECE(^PSDRUG(PSNLKDA,"ND"),"^",2)]""

                   SET PSNLKNOD=^PSDRUG(PSNLKDA,"ND")

                   DO DSPLY1

                   DO DSPLY2

                   DO PRODF

                   DO DSP

                   DO ING

                   DO SV

                   DO DSP1

                   DO RESTN

                   QUIT 

 +2        WRITE !?8,"*** NO NATIONAL DRUG FILE INFORMATION ***",!

 +3        QUIT 

DSPLY1     WRITE !?5,"VA Product Name: ",$PIECE(PSNLKNOD,"^",2)

 +1        WRITE !?5,"VA Generic Name: ",$PIECE($GET(^PSNDF(50.6,$PIECE(PSNLKNOD,"^"),0)),"^")

 +2        QUIT 

DSPLY2    ;

 +1        SET (PSNLKVPN,PSNLKID,PSNLKVDU,PSNLKTR)=""

 +2        KILL X

           SET PSNLKDAV=$PIECE(PSNLKNOD,"^")

           SET PSNLKGK=$PIECE(PSNLKNOD,"^",3)

           SET X=$$PROD2^PSNAPIS(PSNLKDAV,PSNLKGK)

           IF $PIECE(X,"^")]""

               SET PSNLKVPN=$PIECE(X,"^")

               SET PSNLKID=$PIECE(X,"^",2)

               SET PSNLKTR=$PIECE(X,"^",3)

               SET PSNLKVDU=$PIECE(X,"^",4)

 +3        KILL PSNLKPMI

           IF X]""

               SET PSNLKQQ=$PIECE(^PSNDF(50.68,PSNLKGK,1),"^",5)

               DO GCN

 +4        KILL X

 +5        QUIT 

GCN        IF PSNLKQQ']""

               SET PSNLKPMI="None"

               QUIT 

 +1       ;

GCN1      ; 

 +1        IF $DATA(^PS(50.623,"B",PSNLKQQ))

               SET PSNLKMAP=$ORDER(^PS(50.623,"B",PSNLKQQ,0))

               SET PSNLKENG=$PIECE(^PS(50.623,PSNLKMAP,0),"^",2)

               SET PSNLKPMI=$PIECE(^PS(50.621,+PSNLKENG,0),"^")

               QUIT 

 +2        SET PSNLKPMI="None"

 +3        QUIT 

DSPLY3     WRITE ?50,"Transmit To CMOP: "

 +1        IF PSNLKTR=1

               WRITE "YES"

 +2        IF PSNLKTR=0

               WRITE "NO"

 +3        QUIT 

PRODF     ;

 +1        SET X=$$PROD0^PSNAPIS(PSNLKDAV,PSNLKGK)

 +2        SET PSNLKDF=+$PIECE(X,"^",2)

           SET PSNLKSTR=$PIECE(X,"^",3)

           SET PSNLKUN=+$PIECE(X,"^",4)

           SET PSNLKFRM=$SELECT($GET(PSNLKDF):$PIECE($GET(^PS(50.606,PSNLKDF,0)),"^"),1:"")

           SET PSNLKUNT=$SELECT($GET(PSNLKUN):$PIECE($GET(^PS(50.607,PSNLKUN,0)),"^"),1:"")

           SET PSNLKNFN=$PIECE(^PSNDF(50.68,PSNLKGK,0),"^",6)

 +3        KILL X

 +4        QUIT 

ING        FOR PSNLKBB=0:0

               SET PSNLKBB=$ORDER(^PSNDF(50.68,PSNLKGK,2,PSNLKBB))

               IF 'PSNLKBB

                   QUIT 

               Begin DoDot:1

 +1                IF $DATA(^PSNDF(50.68,PSNLKGK,2,PSNLKBB,0))

                       SET PSNLKAND=$GET(^PSNDF(50.68,PSNLKGK,2,PSNLKBB,0))

                       SET PSNLKGR=$PIECE(^PS(50.416,$PIECE(PSNLKAND,"^",1),0),"^")

                       SET PSNLKIST=$PIECE(PSNLKAND,"^",2)

                       SET PSNLKIUT=$PIECE(PSNLKAND,"^",3)

                       KILL PSNLKIUN

                       DO ING1

                       DO IN2

               End DoDot:1

 +2        QUIT 

IN2        WRITE ?3,PSNLKGR,?50,"Str: ",PSNLKIST

           IF PSNLKIUT

               WRITE ?65,"Unt: ",$GET(PSNLKIUN)

           WRITE !

 +1        QUIT 

ING1       IF $PIECE(^PS(50.416,$PIECE(PSNLKAND,"^"),0),"^",2)

               SET PSNLKGR=$PIECE($GET(^PS(50.416,$PIECE(^PS(50.416,$PIECE(PSNLKAND,"^"),0),"^",2),0)),"^")

           IF PSNLKIUT

               SET PSNLKIUN=$PIECE(^PS(50.607,PSNLKIUT,0),"^")

 +1        QUIT 

SC         IF $ORDER(^PSNDF(50.68,PSNLKGK,4,0))

               WRITE !,"Secondary Class(es): ",!

               FOR PSNLKCC=0:0

                   SET PSNLKCC=$ORDER(^PSNDF(50.68,PSNLKGK,4,PSNLKCC))

                   IF 'PSNLKCC

                       QUIT 

                   SET PSNLKZ=$PIECE($GET(^PSNDF(50.68,PSNLKGK,4,PSNLKCC,0)),"^")

                   IF PSNLKZ

                       Begin DoDot:1

 +1                        SET PSNLKSCL=$PIECE($GET(^PS(50.605,PSNLKZ,0)),"^")

                           DO SC1

                       End DoDot:1

 +2        QUIT 

SC1        WRITE "   ",PSNLKSCL

 +1        QUIT 

SV         SET PSNLKSEV=$GET(^PSNDF(50.68,PSNLKGK,7))

           IF PSNLKSEV]""

               SET PSNLKCSF=$PIECE(PSNLKSEV,"^")

               SET PSNLKSP=$PIECE(PSNLKSEV,"^",2)

               IF PSNLKSP="M"

                   SET PSNLKSP="Multi"

               IF PSNLKSP="S"

                   SET PSNLKSP="Single"

               DO SV1

 +1        QUIT 

SV1        SET PSNZZFSA=PSNLKGK_","

           SET PSNZZFS=$$GET1^DIQ(50.68,PSNZZFSA,19)

           IF $GET(PSNZZFS)=""

               SET PSNZZFS="None"

 +1        SET PSNLKNND=$PIECE(^PSNDF(50.68,PSNLKGK,7),"^",3)

 +2        QUIT 

DSP        WRITE !,"Dosage Form: ",PSNLKFRM_$SELECT('$GET(PSNLKDF):"",$PIECE($GET(^PS(50.606,PSNLKDF,1)),"^")=1:"  (Exclude from Dosing Cks)",1:"")

 +1        SET PSNLKL1=$LENGTH(PSNLKSTR)

           SET PSNLKL2=$SELECT($GET(PSNLKUN):$LENGTH(PSNLKUNT),1:0)

 +2        IF (PSNLKL1+PSNLKL2)<62

               WRITE !,"Strength: ",PSNLKSTR

               IF $GET(PSNLKUN)

                   WRITE " Units: "_PSNLKUNT

               GOTO PSDZZ

 +3        WRITE !,"Strength: ",PSNLKSTR

 +4        IF $GET(PSNLKUN)

               Begin DoDot:1

 +5                WRITE !,"Units: "

                   IF PSNLKL2<72

                       WRITE PSNLKUNT

                       QUIT 

 +6                WRITE !,PSNLKUNT

               End DoDot:1

PSDZZ     ;

 +1        WRITE !,"National Formulary Name: ",PSNLKNFN,!,"VA Print Name: ",PSNLKVPN,!,"VA Product Identifier: ",PSNLKID

           DO DSPLY3

           WRITE !,"VA Dispense Unit: ",PSNLKVDU

           IF $DATA(PSNLKPMI)

               WRITE !,"PMIS: ",PSNLKPMI

 +2        WRITE !,"Active Ingredients: ",!

 +3        QUIT 

DSP1       DO HG

           WRITE "Primary Drug Class: ",$PIECE(^PS(50.605,PSNLKCL,0),"^")

           DO SC

           WRITE !,"CS Federal Schedule: ",$GET(PSNLKCSF)_"  "_$GET(PSNZZFS),!,"Single/Multi Source Product: ",$GET(PSNLKSP)

 +1        IF $GET(PSNLKNND)]""

               WRITE !,"Inactivation Date: "

               SET Y=PSNLKNND

               DO DD^%DT

               WRITE Y

               KILL Y

 +2        WRITE !,"Max Single Dose: ",$PIECE(PSNLKSEV,"^",4),?45,"Min Single Dose: ",$PIECE(PSNLKSEV,"^",5)

 +3        WRITE !,"Max Daily Dose: ",$PIECE(PSNLKSEV,"^",6),?45,"Min Daily Dose: ",$PIECE(PSNLKSEV,"^",7),!,"Max Cumulative Dose: ",$PIECE(PSNLKSEV,"^",8)

 +4        WRITE !,"National Formulary Indicator: "

           IF $DATA(^PSNDF(50.68,PSNLKGK,5))

               IF $PIECE(^PSNDF(50.68,PSNLKGK,5),"^")=0

                   WRITE "No"

               IF $PIECE(^PSNDF(50.68,PSNLKGK,5),"^")=1

                   WRITE "Yes"

 +5        WRITE !

 +6        IF $GET(^PSNDF(50.68,PSNLKGK,8))

               WRITE !,"Exclude Drg-Drg Interaction Ck: Yes (No check for Drug-Drug Interactions)"

 +7        DO OVER

 +8        WRITE !

 +9        QUIT 

RESTN      IF $ORDER(^PSNDF(50.68,PSNLKGK,6,0))

               WRITE !,"Restriction: "

               FOR PSNLKRE=0:0

                   SET PSNLKRE=$ORDER(^PSNDF(50.68,PSNLKGK,6,PSNLKRE))

                   IF 'PSNLKRE

                       QUIT 

                   SET PSNLKWRT=$GET(^PSNDF(50.68,PSNLKGK,6,PSNLKRE,0))

                   WRITE !,PSNLKWRT

 +1        QUIT 

HG        ;

 +1        WRITE !

           KILL DIR

           SET DIR(0)="E"

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

           DO ^DIR

           KILL DIR

 +2        WRITE @IOF

 +3        QUIT 

MESS      ;

 +1        WRITE !

           KILL DIR

           SET DIR(0)="E"

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

           DO ^DIR

           KILL DIR

 +2        QUIT 

 +3       ;

OVER      ;

 +1        WRITE !,"Override DF Exclude from Dosage Checks: "_$SELECT($PIECE($GET(^PSNDF(50.68,PSNLKGK,9)),"^")=1:"Yes",$PIECE($GET(^PSNDF(50.68,PSNLKGK,9)),"^")=0:"No",1:"")

           IF $PIECE($GET(^PSNDF(50.68,PSNLKGK,9)),"^")=1

               Begin DoDot:1

 +2                IF '$GET(PSNLKDF)

                       QUIT 

 +3                IF '$DATA(^PS(50.606,PSNLKDF,0))

                       QUIT 

 +4                IF $PIECE($GET(^PS(50.606,PSNLKDF,1)),"^")=1

                       WRITE " (Dosage Checks shall be performed)"

                       QUIT 

 +5                IF $PIECE($GET(^PS(50.606,PSNLKDF,1)),"^")=0

                       WRITE " (No Dosage Checks performed)"

               End DoDot:1

 +6        QUIT