TMGPSSDE ;TMG/kst/Custom version of PSSDEE ;03/25/06
         ;;1.0;TMG-LIB;**1**;04/25/04
 
PSSDEE  ;BIR/WRT-MASTER DRUG ENTER/EDIT ROUTINE ;01/21/00
        ;;1.0;PHARMACY DATA MANAGEMENT;**3,5,15,16,20,22,28,32,34,33,38,57,47,68,61**;9/30/97
 
        ;"*****************************************************************
        ;"* Custom version of code by Kevin Toppenberg, MD
        ;"* to allow customization of the code.
        ;"*
        ;"*****************************************************************
 
        ;"Reference to REACT1^PSNOUT supported by DBIA #2080
        ;"Reference to $$UP^XLFSTR(X) supported by DBIA #10104
        ;"Reference to $$PSJDF^PSNAPIS(P1,P3) supported by DBIA #2531
        ;
BEGIN   set PSSFLAG=0
        do ^PSSDEE2  ;"kill vars
        set PSSZ=1
        F PSSXX=1:1 do  quit:PSSFLAG
        . kill DA
        . do ASK  ;" ask users all questions
DONE    do ^PSSDEE2 ;" kill vars
        kill PSSFLAG
        quit
        ;
        ;"=================================================================
ASK     W !
        set DIC="^PSDRUG("
        set DIC(0)="QEALMNTV" ;"query/echo/ask/learn=OK/multIndex/IntNumOK/T->searchAllIndexes/verify
        set DLAYGO=50  ;"force allowing adding record to file 50
        set DIC("T")="" ;"present every match to the lookup value
        do ^DIC
        kill DIC
        if Y<0 set PSSFLAG=1 quit
        ;
        set (FLG1,FLG2,FLG3,FLG4,FLG5,FLG6,FLG7,FLAG,FLGKY,FLGOI)=0
        kill ^TMP($J,"ADD")
        kill ^TMP($J,"SOL")
        ;
        set DA=+Y
        set DISPDRG=DA
        L +^PSDRUG(DISPDRG):0
        if '$T W !,$C(7),"Another person is editing this one." quit
        set PSSHUIDG=1
        set PSSNEW=$P(Y,"^",3)
        do USE
        do NOPE
        do COMMON
        do DEA
        do MF
        kill PSSHUIDG
        do DRG^PSSHUIDG(DISPDRG,PSSNEW)
        L -^PSDRUG(DISPDRG)
        kill FLG3,PSSNEW
        quit
        ;
        ;"=================================================================
COMMON  set DIE="^PSDRUG("
        set DR="[PSSCOMMON]"
        do ^DIE
        quit:$data(Y)!($data(DTOUT))
        W:'$data(Y) !,"PRICE PER DISPENSE UNIT: "
        S:'$data(^PSDRUG(DA,660)) $P(^PSDRUG(DA,660),"^",6)=""
        W:'$data(Y) $P(^PSDRUG(DA,660),"^",6)
        do DEA
        do CK
        do ASKND
        do OIKILL^PSSDEE1
        do COMMON1
        quit
        ;
COMMON1 W !,"Just a reminder...you are editing ",$P(^PSDRUG(DISPDRG,0),"^"),"."
        set (PSSVVDA,DA)=DISPDRG
        do DOSN^PSSDOS
        set DA=PSSVVDA
        kill PSSVVDA
        do USE
        do APP
        do ORDITM^PSSDEE1
        quit
        ;
CK      do DSPY^PSSDEE1
        set FLGNDF=0
        quit
        ;
ASKND   set %=-1
        if $data(^XUSEC("PSNMGR",DUZ)) do
        . do MESSAGE^PSSDEE1
        . W !!,"Do you wish to match/rematch to NATIONAL DRUG file"
        . set %=1
        . S:FLGMTH=1 %=2
        . do YN^DICN
        if %=0 W !,"If you answer ""yes"", you will attempt to match to NDF." G ASKND
        if %=2 kill X,Y quit
        if %<0 kill X,Y quit
        if %=1 do
        . do RSET^PSSDEE1
        . do EN1^PSSUTIL(DISPDRG,1)
        . set X="PSNOUT"
        . X ^%ZOSF("TEST")
        . if  do
        . . do REACT1^PSNOUT
        . . set DA=DISPDRG
        . . if $data(^PSDRUG(DA,"ND")),$P(^PSDRUG(DA,"ND"),"^",2)]"" do ONE
        quit
        ;
ONE     set PSNP=$G(^PSDRUG(DA,"I"))
        if PSNP,PSNP<DT quit
        W !,"You have just VERIFIED this match and MERGED the entry."
        do CKDF
        do EN2^PSSUTIL(DISPDRG,1)
        S:'$data(OLDDF) OLDDF=""
        if OLDDF'=NEWDF do
        . set FLGNDF=1
        . do WR
        quit
        ;
CKDF    set NWND=^PSDRUG(DA,"ND")
        set NWPC1=$P(NWND,"^",1)
        set NWPC3=$P(NWND,"^",3)
        set DA=NWPC1
        set K=NWPC3
        set X=$$PSJDF^PSNAPIS(DA,K)
        set NEWDF=$P(X,"^",2)
        set DA=DISPDRG
        N PSSK
        do PKIND^PSSDDUT2
        quit
        ;
NOPE    set ZAPFLG=0
        if '$data(^PSDRUG(DA,"ND")),$data(^PSDRUG(DA,2)),$P(^PSDRUG(DA,2),"^",1)']"" do DFNULL
        if '$data(^PSDRUG(DA,"ND")),'$data(^PSDRUG(DA,2)) do DFNULL
        if $data(^PSDRUG(DA,"ND")),$P(^PSDRUG(DA,"ND"),"^",2)']"",$data(^PSDRUG(DA,2)),$P(^PSDRUG(DA,2),"^",1)']"" do DFNULL
        quit
        ;
DFNULL  set OLDDF=""
        set ZAPFLG=1
        quit
        ;
ZAPIT   if $data(ZAPFLG),ZAPFLG=1,FLGNDF=1,OLDDF'=NEWDF do CKIV^PSSDEE1
        quit
        ;
APP     W !!,"MARK THIS DRUG AND EDIT IT FOR: "
        do CHOOSE
        quit
        ;
CHOOSE  if $data(^XUSEC("PSORPH",DUZ))!($data(^XUSEC("PSXCMOPMGR",DUZ))) W !,"O  - Outpatient" set FLG1=1
        if $data(^XUSEC("PSJU MGR",DUZ)) W !,"U  - Unit Dose" set FLG2=1
        if $data(^XUSEC("PSJI MGR",DUZ)) W !,"I  - IV" set FLG3=1
        if $data(^XUSEC("PSGWMGR",DUZ)) W !,"W  - Ward Stock" set FLG4=1
        if $data(^XUSEC("PSAMGR",DUZ))!($data(^XUSEC("PSA ORDERS",DUZ))) W !,"D  - Drug Accountability" set FLG5=1
        if $data(^XUSEC("PSDMGR",DUZ)) W !,"C  - Controlled Substances" set FLG6=1
        if $data(^XUSEC("PSORPH",DUZ)) W !,"X  - Non-VA Med" set FLG7=1
        if FLG1,FLG2,FLG3,FLG4,FLG5,FLG6 set FLAG=1
        if FLAG W !,"A  - ALL"
        W !
        if 'FLG1,'FLG2,'FLG3,'FLG4,'FLG5,'FLG6,'FLG7 do  quit
        . W !,"You do not have the proper keys to continue. Sorry, this concludes your editing session.",!
        . set FLGKY=1
        . kill DIRUT,X
        if FLGKY'=1 D
        . kill DIR
        . set DIR(0)="FO^1:30"
        . set DIR("A")="Enter your choice(s) separated by commas "
        . F  do ^DIR quit:$$CHECK($$UP^XLFSTR(X))
        . set PSSANS=X
        . set PSSANS=$$UP^XLFSTR(PSSANS)
        . do BRANCH
        . do BRANCH1
        quit
        ;
CHECK(X)        ;" Validates Application Use response
        N CHECK,I,C
        set CHECK=1 if X=""!(Y["^")!($data(DIRUT)) quit CHECK
        F I=1:1:$L(X,",") D
        . set C=$P(X,",",I) W !?43,C," - "
        . if C="O",FLG1 W "Outpatient" quit
        . if C="U",FLG2 W "Unit Dose" quit
        . if C="I",FLG3 W "IV" quit
        . if C="W",FLG4 W "Ward Stock" quit
        . if C="D",FLG5 W "Drug Accountability" quit
        . if C="C",FLG6 W "Controlled Substances" quit
        . if C="X",FLG7 W "Non-VA Med" quit
        . W "Invalid Entry",$C(7) set CHECK=0
        quit CHECK
        ;
BRANCH  D:PSSANS["O" OP
        D:PSSANS["U" UD
        D:PSSANS["I" IV
        D:PSSANS["W" WS
        D:PSSANS["D" DACCT
        D:PSSANS["C" CS
        D:PSSANS["X" NVM
        quit
        ;
BRANCH1 if FLAG,PSSANS["A" do
        . do OP
        . do UD
        . do IV
        . do WS
        . do DACCT
        . do CS
        . do NVM
        quit
        ;
OP      if FLG1 D
        . W !,"** You are NOW editing OUTPATIENT fields. **"
        . set PSIUDA=DA
        . set PSIUX="O^Outpatient Pharmacy"
        . do ^PSSGIU
        . if %=1 D
        . . set DIE="^PSDRUG(",DR="[PSSOP]"
        . . do ^DIE
        . . kill DIR
        . . do OPEI
        . . do ASKCMOP
        . . set X="PSOCLO1"
        . . X ^%ZOSF("TEST")
        . . if  do ASKCLOZ set FLGOI=1
        if FLG1 do CKCMOP
        quit
        ;
CKCMOP  if $P($G(^PSDRUG(DISPDRG,2)),"^",3)'["O" do
        . S:$data(^PSDRUG(DISPDRG,3)) $P(^PSDRUG(DISPDRG,3),"^",1)=0
        . K:$data(^PSDRUG("AQ",DISPDRG)) ^PSDRUG("AQ",DISPDRG)
        . set DA=DISPDRG
        . do ^PSSREF
        quit
        ;
UD      if FLG2 do
        . W !,"** You are NOW editing UNIT DOSE fields. **"
        . set PSIUDA=DA
        . set PSIUX="U^Unit Dose"
        . do ^PSSGIU
        . if %=1 do
        . . set DIE="^PSDRUG("
        . . set DR="62.05;212.2"
        . . do ^DIE
        . . set DIE="^PSDRUG("
        . . set DR="212"
        . . set DR(2,50.0212)=".01;1"
        . . do ^DIE
        . . set FLGOI=1
        quit
        ;
IV      if FLG3
        W !,"** You are NOW editing IV fields. **"
        S (PSIUDA,PSSDA)=DA
        set PSIUX="I^IV"
        do ^PSSGIU
        if %=1 do IV1 set FLGOI=1
        quit
        ;
IV1     kill PSSIVOUT ;"This variable controls the selection process loop.
        W !,"Edit Additives or Solutions: "
        kill DIR
        set DIR(0)="SO^A:ADDITIVES;S:SOLUTIONS;"
        do ^DIR
        quit:$data(DIRUT)
        set PSSASK=Y(0)
        D:PSSASK="ADDITIVES" ENA^PSSVIDRG
        D:PSSASK="SOLUTIONS" ENS^PSSVIDRG
        if '$data(PSSIVOUT) G IV1
        kill PSSIVOUT
        quit
        ;
WS      if FLG4
        W !,"** You are NOW editing WARD STOCK fields. **"
        set DIE="^PSDRUG("
        set DR="300;301;302"
        do ^DIE
        quit
        ;
DACCT   if FLG5
        W !,"** You are NOW editing DRUG ACCOUNTABILITY fields. **"
        set DIE="^PSDRUG("
        set DR="441"
        do ^DIE
        set DIE="^PSDRUG("
        set DR="9"
        set DR(2,50.1)="1;2;400;401;402;403;404;405"
        do ^DIE
        quit
        ;
CS      if FLG6
        W !,"** You are NOW Marking/Unmarking for CONTROLLED SUBS. **"
        set PSIUDA=DA
        set PSIUX="N^Controlled Substances"
        do ^PSSGIU
        quit
        ;
NVM     if FLG7
        W !,"** You are NOW Marking/Unmarking for NON-VA MEDS. **"
        set PSIUDA=DA
        set PSIUX="X^Non-VA Med"
        do ^PSSGIU
        quit
        ;
ASKCMOP if $data(^XUSEC("PSXCMOPMGR",DUZ)) do
        . W !!,"Do you wish to mark to transmit to CMOP? "
        . kill DIR
        . set DIR(0)="Y"
        . set DIR("?")="If you answer ""yes"", you will attempt to mark this drug to transmit to CMOP."
        do ^DIR
        if "Nn"[X kill X,Y,DIRUT quit
        if "Yy"[X do
        . set PSXFL=0
        . do TEXT^PSSMARK
        . H 7
        . N PSXUDA
        . S (PSXUM,PSXUDA)=DA
        . set PSXLOC=$P(^PSDRUG(DA,0),"^")
        . set PSXGOOD=0
        . set PSXF=0
        . set PSXBT=0
        . do BLD^PSSMARK
        . do PICK2^PSSMARK
        . set DA=PSXUDA
        quit
        ;
ASKCLOZ W !!,"Do you wish to mark/unmark as a LAB MONITOR or CLOZAPINE DRUG? "
        kill DIR
        set DIR(0)="Y"
        set DIR("?")="If you answer ""yes"", you will have the opportunity to edit LAB MONITOR or CLOZAPINE fields."
        do ^DIR
        if "Nn"[X kill X,Y,DIRUT quit
        if "Yy"[X set NFLAG=0 do MONCLOZ
        quit
        ;
MONCLOZ kill PSSAST
        do FLASH
        W !,"Mark/Unmark for Lab Monitor or Clozapine: "
        kill DIR
        set DIR(0)="S^L:LAB MONITOR;C:CLOZAPINE;"
        do ^DIR
        quit:$data(DIRUT)
        set PSSAST=Y(0)
        D:PSSAST="LAB MONITOR" ^PSSLAB
        D:PSSAST="CLOZAPINE" CLOZ
        quit
        ;
FLASH   kill LMFLAG,CLFALG,WHICH
        set WHICH=$P($G(^PSDRUG(DISPDRG,"CLOZ1")),"^")
        set LMFLAG=0
        set CLFLAG=0
        if WHICH="PSOCLO1" set CLFLAG=1
        if WHICH'="PSOCLO1" S:WHICH'="" LMFLAG=1
        quit
        ;
CLOZ    quit:NFLAG
        quit:$data(DTOUT)
        quit:$data(DIRUT)
        quit:$data(DUOUT)
        W !,"** You are NOW editing CLOZAPINE fields. **"
        do ^PSSCLDRG
        quit
        ;
USE     kill PACK
        set PACK=""
        S:$P($G(^PSDRUG(DISPDRG,"PSG")),"^",2)]"" PACK="W"
        if $data(^PSDRUG(DISPDRG,2)) set PACK=PACK_$P(^PSDRUG(DISPDRG,2),"^",3)
        if PACK'="" D
        . W $C(7) N XX W !! F XX=1:1:79 W "*"
        . W !,"This entry is marked for the following PHARMACY packages: "
        . do USE1
        quit
        ;
USE1    W:PACK["O" !," Outpatient"
        W:PACK["U" !," Unit Dose"
        W:PACK["I" !," IV"
        W:PACK["W" !," Ward Stock"
        W:PACK["D" !," Drug Accountability"
        W:PACK["N" !," Controlled Substances"
        W:PACK["X" !," Non-VA Med"
        W:'$data(PACK) !," NONE"
        if PACK'["O",PACK'["U",PACK'["I",PACK'["W",PACK'["D",PACK'["N",PACK'["X" W !," NONE"
        quit
        ;
WR      if ^XMB("NETNAME")'["CMOP-" do
        . if OLDDF="" quit
        . W !,"The dosage form has changed from "_OLDDF_" to "_NEWDF_" due to",!
        . w "matching/rematching to NDF.",!
        . w "You will need to rematch to Orderable Item.",!
        quit
PRIMDRG if $data(^PS(59.7,1,20)),$P(^PS(59.7,1,20),"^",1)=4!($P(^PS(59.7,1,20),"^",1)=4.5) do
        . if $data(^PSDRUG(DISPDRG,2)) do
        . . set VAR=$P(^PSDRUG(DISPDRG,2),"^",3)
        . . if VAR["U"!(VAR["I") do
        . . . do PRIM1
        quit
        ;
PRIM1   W !!,"You need to match this drug to ""PRIMARY DRUG"" file as well.",!
        set DIE="^PSDRUG(",DR="64"
        set DA=DISPDRG
        do ^DIE
        kill VAR
        quit
        ;
MF      if $P($G(^PS(59.7,1,80)),"^",2)>1 if $data(^PSDRUG(DISPDRG,2)) DO
        . set PSSOR=$P(^PSDRUG(DISPDRG,2),"^",1)
        . if PSSOR]"" DO
        . . DO EN^PSSPOIDT(PSSOR)
        . . DO EN2^PSSHL1(PSSOR,"MUP")
        quit
        ;
MFA     if $P($G(^PS(59.7,1,80)),"^",2)>1 do
        . set PSSOR=$P(^PS(52.6,ENTRY,0),"^",11)
        . set PSSDD=$P(^PS(52.6,ENTRY,0),"^",2)
        . if PSSOR]"" do
        . . do EN^PSSPOIDT(PSSOR)
        . . do EN2^PSSHL1(PSSOR,"MUP")
        . . do MFDD
        quit
        ;
MFS     if $P($G(^PS(59.7,1,80)),"^",2)>1 do
        . set PSSOR=$P(^PS(52.7,ENTRY,0),"^",11)
        . set PSSDD=$P(^PS(52.7,ENTRY,0),"^",2)
        . if PSSOR]"" do
        . . do EN^PSSPOIDT(PSSOR)
        . . do EN2^PSSHL1(PSSOR,"MUP")
        . . do MFDD
        quit
        ;
MFDD    if $data(^PSDRUG(PSSDD,2)) do
        . set PSSOR=$P(^PSDRUG(PSSDD,2),"^",1)
        . if PSSOR]"" do
        . . do EN^PSSPOIDT(PSSOR)
        . . do EN2^PSSHL1(PSSOR,"MUP")
        quit
        ;
OPEI    if $data(^PSDRUG(DISPDRG,"ND")),$P(^PSDRUG(DISPDRG,"ND"),"^",10)]"" do
        . set DIE="^PSDRUG("
        . set DR="28"
        . set DA=DISPDRG
        . do ^DIE
        quit
        ;
DEA     ;
        if $P($G(^PSDRUG(DISPDRG,3)),"^")=1,($P(^PSDRUG(DISPDRG,0),"^",3)[1!($P(^(0),"^",3)[2)) do DSH
        quit
        ;
DSH     W !!,"****************************************************************************"
        W !,"This entry contains a ""1"" or a ""2"" in the ""DEA, SPECIAL HDLG""",!
        w "field, therefore this item has been UNMARKED for CMOP transmission."
        W !,"****************************************************************************",!
        S $P(^PSDRUG(DISPDRG,3),"^")=0
        kill ^PSDRUG("AQ",DISPDRG)
        set DA=DISPDRG
        N %
        do ^PSSREF
        quit