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
