- 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,396**; 30 Oct 98;Build 190
- ;
- ;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",DIC("W")="S PSNTDRUG=Y D GETTIER^PSNLOOK(PSNTDRUG)" 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSNDRUG 2758 printed Feb 18, 2025@23:50:05 Page 2
- 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,396**; 30 Oct 98;Build 190
- +2 ;
- +3 ;Reference to EN1^PSSUTIL supported by DBIA #3107
- +4 ;Reference to ^PSDRUG supported by DBIAs #221 and #2352
- +5 ;Reference to ^PS(59.7 supported by DBIA #2613
- +6 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"
- SET DIC("W")="S PSNTDRUG=Y D GETTIER^PSNLOOK(PSNTDRUG)"
- 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