PSNDRUG.m

PSNDRUG ;BIR/CCH&WRT-Allows user to reset one or several drug matches ; 12/10/98 13:09

 ;;4.0; NATIONAL DRUG FILE;**2,3,33**; 30 Oct 98

 ;Reference to EN1^PSSUTIL supported by DBIA #3107

 ;Reference to ^PSDRUG supported by DBIAs #221 and #2352

 ;Reference to ^PS(59.7 supported by DBIA #2613

 S PSNFL=0 D EXPLN F PSNMM=1:1 D START S:'$D(PSNFL) PSNFL=0 Q:PSNFL

DONE W !!,"Remember, these matches must be verified using the options ""Verify Matches"" or",!,"""Verify Single Match"" and then be merged using the option ""Merge National Drug File",!,"Data Into Local File"".",!

 K PSNMM,PSNFL,X,Y,PSNB,PSNDEA,PSNINACT D KILL Q

EXPLN W !!,"Enter name of drug from your local drug file and a match",!,"with the National Drug File will be attempted. ",!,"Press return at the ""Select DRUG GENERIC NAME: "" prompt to exit.",! Q

START D KILL S DIC="^PSDRUG(",DIC(0)="QEAM" D ^DIC K DIC I Y<0 S PSNFL=1 Q

 S (PSNB,PSNDRG)=+Y,PSNLOC=$P(Y,"^",2) D CR^PSNHELP

DTE S DATE=$G(^PSDRUG(PSNB,"I")) I DATE,DATE>DT S %=0 W !,"This drug has an Inactivation date in the future. Do you want to continue" D YN^DICN G:%=0 DTE0 Q:%=2  Q:%<0

 I DATE,DATE<DT W !!,"This drug is ""Inactive"". Please try again.",! Q

 I $D(^PSDRUG(PSNB,3)),$P(^PSDRUG(PSNB,3),"^",1)=1,'$D(^XUSEC("PSNMGR",DUZ)) W !,"You cannot rematch this entry. It is marked to transmit to CMOP.",!,"You do not have the ""PSNMGR"" key.",! Q

 S PSNSAVEY=$G(Y) I $P(^PS(59.7,1,10),"^",3)=1,'$D(^PSDRUG(PSNB,"ND")) S X="PSSUTIL" X ^%ZOSF("TEST") I  D EN1^PSSUTIL(PSNB,0)

 S Y=$G(PSNSAVEY) K PSNSAVEY

 I $P(^PS(59.7,1,10),"^",3)=1,$D(^PSDRUG(+Y,"ND")) G REMTCH^PSNHELP

MATCH Q:'$D(^PSDRUG(PSNB,0))  Q:$P(^PSDRUG(PSNB,0),"^",1)']""

 I $D(^PSDRUG(PSNB,"ND")),$P(^PSDRUG(PSNB,"ND"),"^",2)]"" Q

 I $D(PSNFLB),$D(^PSNTRAN(PSNB,0)) Q

 D KILL^PSNHIT,^PSNDEA Q:$D(PSNINACT)  Q:'$D(PSNDEA)  K PSNDEA

 I $P(^PS(59.7,1,10),"^",3)=1 K:$D(^PSNTRAN(PSNB,0)) ^PSNTRAN(PSNB,0) D NAM^PSNCOMP Q

 Q

KILL K ANS,PSNDA,PSNUNDA,PSNDDA,PSNSTDA,DIC,FF,KK,NBR,PSNANS,PSNCLASS,PSNDRG,PSNSZ,PSNFNM,PSNFORM,PSNLOC,PSNNDF,PSNNEW,PSNOLD,PSNPST,PSNSIZE,PSNSIZE,NDP,PS,PT,DOS,STR,UNT,VV,VV1,PSNTYPE,PSNPD

 K PSNNAM,PSNNAME,PSNTRFL,PSNTYP,PSNVAR,VAR,STOP,PSND,PSNDFM,PSNVC,PSNVCL,JJ,MJL,PSNODE,PSNOU,PSNSZE,PSNTPE,PSNENT,PSNF,PSNM,^TMP($J,"PSNND"),ASC,PSNRAN,PSNV,PSNWR,PSNX,PSNZ,WRT,BB,END,LIST,^TMP($J,"PSNPSPT"),^TMP($J,"PSNDFPK")

 K CODE,DA,DATE,DIR,EEE,FFF,FL,GGG,IEN,J,K,NO31,NOM31,NOMSYN,DUNCE,PP,PSNARY,PSNIEN,PSNP,PTPS,QQ,RR,ST,TT,TTT,WR,XX,XXX,Y,ZXZX,PPQ,PPR,^TMP($J,"PSNND"),^TMP($J,"PSNDF1"),^TMP($J,"PSNPSPS"),PSNUP,PSNINQ Q

DTE0 W !,"Answer yes or no" G DTE

GONE K DUNCE,TT,DIRUT,TTT,PPQ,PSNDRG,PSNLOC,PSNNAM,PSNODE,PSNOU,PSNP,NO31,NOM31,NOMSYN Q

PSNDRUG   ;BIR/CCH&WRT-Allows user to reset one or several drug matches ; 12/10/98 13:09

 +1       ;;4.0; NATIONAL DRUG FILE;**2,3,33**; 30 Oct 98

 +2       ;Reference to EN1^PSSUTIL supported by DBIA #3107

 +3       ;Reference to ^PSDRUG supported by DBIAs #221 and #2352

 +4       ;Reference to ^PS(59.7 supported by DBIA #2613

 +5        SET PSNFL=0

           DO EXPLN

           FOR PSNMM=1:1

               DO START

               IF '$DATA(PSNFL)

                   SET PSNFL=0

               IF PSNFL

                   QUIT 

DONE       WRITE !!,"Remember, these matches must be verified using the options ""Verify Matches"" or",!,"""Verify Single Match"" and then be merged using the option ""Merge National Drug File",!,"Data Into Local File"".",!

 +1        KILL PSNMM,PSNFL,X,Y,PSNB,PSNDEA,PSNINACT

           DO KILL

           QUIT 

EXPLN      WRITE !!,"Enter name of drug from your local drug file and a match",!,"with the National Drug File will be attempted. ",!,"Press return at the ""Select DRUG GENERIC NAME: "" prompt to exit.",!

           QUIT 

START      DO KILL

           SET DIC="^PSDRUG("

           SET DIC(0)="QEAM"

           DO ^DIC

           KILL DIC

           IF Y<0

               SET PSNFL=1

               QUIT 

 +1        SET (PSNB,PSNDRG)=+Y

           SET PSNLOC=$PIECE(Y,"^",2)

           DO CR^PSNHELP

DTE        SET DATE=$GET(^PSDRUG(PSNB,"I"))

           IF DATE

               IF DATE>DT

                   SET %=0

                   WRITE !,"This drug has an Inactivation date in the future. Do you want to continue"

                   DO YN^DICN

                   IF %=0

                       GOTO DTE0

                   IF %=2

                       QUIT 

                   IF %<0

                       QUIT 

 +1        IF DATE

               IF DATE<DT

                   WRITE !!,"This drug is ""Inactive"". Please try again.",!

                   QUIT 

 +2        IF $DATA(^PSDRUG(PSNB,3))

               IF $PIECE(^PSDRUG(PSNB,3),"^",1)=1

                   IF '$DATA(^XUSEC("PSNMGR",DUZ))

                       WRITE !,"You cannot rematch this entry. It is marked to transmit to CMOP.",!,"You do not have the ""PSNMGR"" key.",!

                       QUIT 

 +3        SET PSNSAVEY=$GET(Y)

           IF $PIECE(^PS(59.7,1,10),"^",3)=1

               IF '$DATA(^PSDRUG(PSNB,"ND"))

                   SET X="PSSUTIL"

                   XECUTE ^%ZOSF("TEST")

                  IF $TEST

                       DO EN1^PSSUTIL(PSNB,0)

 +4        SET Y=$GET(PSNSAVEY)

           KILL PSNSAVEY

 +5        IF $PIECE(^PS(59.7,1,10),"^",3)=1

               IF $DATA(^PSDRUG(+Y,"ND"))

                   GOTO REMTCH^PSNHELP

MATCH      IF '$DATA(^PSDRUG(PSNB,0))

               QUIT 

           IF $PIECE(^PSDRUG(PSNB,0),"^",1)']""

               QUIT 

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

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

                   QUIT 

 +2        IF $DATA(PSNFLB)

               IF $DATA(^PSNTRAN(PSNB,0))

                   QUIT 

 +3        DO KILL^PSNHIT

           DO ^PSNDEA

           IF $DATA(PSNINACT)

               QUIT 

           IF '$DATA(PSNDEA)

               QUIT 

           KILL PSNDEA

 +4        IF $PIECE(^PS(59.7,1,10),"^",3)=1

               IF $DATA(^PSNTRAN(PSNB,0))

                   KILL ^PSNTRAN(PSNB,0)

               DO NAM^PSNCOMP

               QUIT 

 +5        QUIT 

KILL       KILL ANS,PSNDA,PSNUNDA,PSNDDA,PSNSTDA,DIC,FF,KK,NBR,PSNANS,PSNCLASS,PSNDRG,PSNSZ,PSNFNM,PSNFORM,PSNLOC,PSNNDF,PSNNEW,PSNOLD,PSNPST,PSNSIZE,PSNSIZE,NDP,PS,PT,DOS,STR,UNT,VV,VV1,PSNTYPE,PSNPD

 +1        KILL PSNNAM,PSNNAME,PSNTRFL,PSNTYP,PSNVAR,VAR,STOP,PSND,PSNDFM,PSNVC,PSNVCL,JJ,MJL,PSNODE,PSNOU,PSNSZE,PSNTPE,PSNENT,PSNF,PSNM,^TMP($JOB,"PSNND"),ASC,PSNRAN,PSNV,PSNWR,PSNX,PSNZ,WRT,BB,END,LIST,^TMP($JOB,"PSNPSPT"),^TMP($JOB,"PSNDFPK")

 +2        KILL CODE,DA,DATE,DIR,EEE,FFF,FL,GGG,IEN,J,K,NO31,NOM31,NOMSYN,DUNCE,PP,PSNARY,PSNIEN,PSNP,PTPS,QQ,RR,ST,TT,TTT,WR,XX,XXX,Y,ZXZX,PPQ,PPR,^TMP($JOB,"PSNND"),^TMP($JOB,"PSNDF1"),^TMP($JOB,"PSNPSPS"),PSNUP,PSNINQ

           QUIT 

DTE0       WRITE !,"Answer yes or no"

           GOTO DTE

GONE       KILL DUNCE,TT,DIRUT,TTT,PPQ,PSNDRG,PSNLOC,PSNNAM,PSNODE,PSNOU,PSNP,NO31,NOM31,NOMSYN

           QUIT