PSNNDC ;BIR/WRT-auto set of translation file if ndc in national file ; 10/27/98 13:47
;;4.0; NATIONAL DRUG FILE;; 30 Oct 98
D:$D(XRTL) T0^%ZOSV ; START
FIRST D CHECK,SECOND
Q
CHECK I $P(^PS(59.7,1,10),"^",3)=0 W !!,"You must use the Conversion Rematch option first before using this option.",! Q
SECOND I $P(^PS(59.7,1,10),"^",3)=1 F PSNB=0:0 S PSNB=$O(^PSDRUG(PSNB)) Q:'PSNB U IO W:'(PSNB#100) "." D STRT0
Q
STRT0 Q:'$D(^PSDRUG(PSNB,0))
S PSNP=$G(^PSDRUG(PSNB,"I")) I PSNP,PSNP<DT Q
I $D(^PSDRUG(PSNB,"ND")),$P(^PSDRUG(PSNB,"ND"),"^",2)]"" Q
Q:'$D(^PSDRUG(PSNB,2)) Q:$P(^PSDRUG(PSNB,2),"^",4)'?1.6N1"-"1.4N1"-"1.2N S ANS=$P(^PSDRUG(PSNB,2),"^",4) I $D(^PSNTRAN(PSNB,0)) Q:$P(^PSNTRAN(PSNB,0),"^",2)]""
NDC F VV=1:1:3 S VV1=$S(VV=1:6,VV=2:4,VV=3:2) D NDCSET
S ANS=$P(ANS,"-",1)_$P(ANS,"-",2)_$P(ANS,"-",3) K VV,VV1
I '$D(^PSNDF(50.67,"NDC",ANS)) K ANS S NOM31=1 Q
S PSNIEN=$O(^PSNDF(50.67,"NDC",ANS,0)),PSNFNM=$P(^PSNDF(50.67,PSNIEN,0),"^",6),PSNSIZE=$P(^PSNDF(50.67,PSNIEN,0),"^",8),PSNTYPE=$P(^PSNDF(50.67,PSNIEN,0),"^",9)
I $D(^PSNDF(50.68,PSNFNM,7)) S PSNPD=$P(^PSNDF(50.68,PSNFNM,7),"^",3) I PSNPD]"",PSNPD<DT Q
S PSNNDF=$P(^PSNDF(50.68,PSNFNM,0),"^",2),PSNFORM=$P(^PSNDF(50.68,PSNFNM,0),"^"),PSNCLASS=$P(^PSNDF(50.68,PSNFNM,3),"^") D ASKIT^PSNHIT
Q
NDCSET I $L($P(ANS,"-",VV))<VV1 S $P(ANS,"-",VV)=$E("0000000",1,VV1-$L($P(ANS,"-",VV)))_$P(ANS,"-",VV)
Q
SET S:'$D(^PSNTRAN(PSNB,0)) $P(^PSNTRAN(0),"^",4)=($P(^PSNTRAN(0),"^",4))+1,$P(^PSNTRAN(0),"^",3)=PSNB
S ^PSNTRAN(PSNB,0)=PSNNDF_"^"_PSNFNM_"^"_PSNCLASS_"^^"_PSNSIZE_"^^"_PSNTYPE_"^"_DUZ
Q
STRT1 Q:'$D(^PSDRUG(PSNB,2)) Q:$P(^PSDRUG(PSNB,2),"^",4)'?1.6N1"-"1.4N1"-"1.2N S ANS=$P(^PSDRUG(PSNB,2),"^",4) I $D(^PSNTRAN(PSNB,0)) Q:$P(^PSNTRAN(PSNB,0),"^",2)]""
NDC1 F VV=1:1:3 S VV1=$S(VV=1:6,VV=2:4,VV=3:2) D NDCSET
S ANS=$P(ANS,"-",1)_$P(ANS,"-",2)_$P(ANS,"-",3) K VV,VV1
I '$D(^PSNDF(50.67,"NDC",ANS)) K ANS S NOMSYN=1 Q
S PSNIEN=$O(^PSNDF(50.67,"NDC",ANS,0)),PSNFNM=$P(^PSNDF(50.67,PSNIEN,0),"^",6),PSNSIZE=$P(^PSNDF(50.67,PSNIEN,0),"^",8),PSNTYPE=$P(^PSNDF(50.67,PSNIEN,0),"^",9)
I $D(^PSNDF(50.68,PSNFNM,7)) S PSNPD=$P(^PSNDF(50.68,PSNFNM,7),"^",3) I PSNPD]"",PSNPD<DT Q
S PSNNDF=$P(^PSNDF(50.68,PSNFNM,0),"^",2),PSNFORM=$P(^PSNDF(50.68,PSNFNM,0),"^"),PSNCLASS=$P(^PSNDF(50.68,PSNFNM,3),"^") D ASKIT1^PSNHIT
Q
SYN S PPQ=0 I $D(^PSNTRAN(PSNB,0)) Q:$P(^PSNTRAN(PSNB,0),"^",2)]""
W !,?5,"I will attempt to match the NDCs from your SYNONYMS.",!
I '$O(^PSDRUG(PSNB,1,0)) S NOMSYN=1
I $O(^PSDRUG(PSNB,1,0)) F XXX=0:0 S XXX=$O(^PSDRUG(PSNB,1,XXX)) Q:'XXX S ANS=$P(^PSDRUG(PSNB,1,XXX,0),"^",2) I ANS?1.6N1"-"1.4N1"-"1.2N Q:$P($G(^PSNTRAN(PSNB,0)),"^",2)]"" S TT=0,TTT=1 D NDC1 Q:DUNCE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSNNDC 2705 printed Dec 13, 2024@02:24:19 Page 2
PSNNDC ;BIR/WRT-auto set of translation file if ndc in national file ; 10/27/98 13:47
+1 ;;4.0; NATIONAL DRUG FILE;; 30 Oct 98
+2 ; START
if $DATA(XRTL)
DO T0^%ZOSV
FIRST DO CHECK
DO SECOND
+1 QUIT
CHECK IF $PIECE(^PS(59.7,1,10),"^",3)=0
WRITE !!,"You must use the Conversion Rematch option first before using this option.",!
QUIT
SECOND IF $PIECE(^PS(59.7,1,10),"^",3)=1
FOR PSNB=0:0
SET PSNB=$ORDER(^PSDRUG(PSNB))
if 'PSNB
QUIT
USE IO
if '(PSNB#100)
WRITE "."
DO STRT0
+1 QUIT
STRT0 if '$DATA(^PSDRUG(PSNB,0))
QUIT
+1 SET PSNP=$GET(^PSDRUG(PSNB,"I"))
IF PSNP
IF PSNP<DT
QUIT
+2 IF $DATA(^PSDRUG(PSNB,"ND"))
IF $PIECE(^PSDRUG(PSNB,"ND"),"^",2)]""
QUIT
+3 if '$DATA(^PSDRUG(PSNB,2))
QUIT
if $PIECE(^PSDRUG(PSNB,2),"^",4)'?1.6N1"-"1.4N1"-"1.2N
QUIT
SET ANS=$PIECE(^PSDRUG(PSNB,2),"^",4)
IF $DATA(^PSNTRAN(PSNB,0))
if $PIECE(^PSNTRAN(PSNB,0),"^",2)]""
QUIT
NDC FOR VV=1:1:3
SET VV1=$SELECT(VV=1:6,VV=2:4,VV=3:2)
DO NDCSET
+1 SET ANS=$PIECE(ANS,"-",1)_$PIECE(ANS,"-",2)_$PIECE(ANS,"-",3)
KILL VV,VV1
+2 IF '$DATA(^PSNDF(50.67,"NDC",ANS))
KILL ANS
SET NOM31=1
QUIT
+3 SET PSNIEN=$ORDER(^PSNDF(50.67,"NDC",ANS,0))
SET PSNFNM=$PIECE(^PSNDF(50.67,PSNIEN,0),"^",6)
SET PSNSIZE=$PIECE(^PSNDF(50.67,PSNIEN,0),"^",8)
SET PSNTYPE=$PIECE(^PSNDF(50.67,PSNIEN,0),"^",9)
+4 IF $DATA(^PSNDF(50.68,PSNFNM,7))
SET PSNPD=$PIECE(^PSNDF(50.68,PSNFNM,7),"^",3)
IF PSNPD]""
IF PSNPD<DT
QUIT
+5 SET PSNNDF=$PIECE(^PSNDF(50.68,PSNFNM,0),"^",2)
SET PSNFORM=$PIECE(^PSNDF(50.68,PSNFNM,0),"^")
SET PSNCLASS=$PIECE(^PSNDF(50.68,PSNFNM,3),"^")
DO ASKIT^PSNHIT
+6 QUIT
NDCSET IF $LENGTH($PIECE(ANS,"-",VV))<VV1
SET $PIECE(ANS,"-",VV)=$EXTRACT("0000000",1,VV1-$LENGTH($PIECE(ANS,"-",VV)))_$PIECE(ANS,"-",VV)
+1 QUIT
SET if '$DATA(^PSNTRAN(PSNB,0))
SET $PIECE(^PSNTRAN(0),"^",4)=($PIECE(^PSNTRAN(0),"^",4))+1
SET $PIECE(^PSNTRAN(0),"^",3)=PSNB
+1 SET ^PSNTRAN(PSNB,0)=PSNNDF_"^"_PSNFNM_"^"_PSNCLASS_"^^"_PSNSIZE_"^^"_PSNTYPE_"^"_DUZ
+2 QUIT
STRT1 if '$DATA(^PSDRUG(PSNB,2))
QUIT
if $PIECE(^PSDRUG(PSNB,2),"^",4)'?1.6N1"-"1.4N1"-"1.2N
QUIT
SET ANS=$PIECE(^PSDRUG(PSNB,2),"^",4)
IF $DATA(^PSNTRAN(PSNB,0))
if $PIECE(^PSNTRAN(PSNB,0),"^",2)]""
QUIT
NDC1 FOR VV=1:1:3
SET VV1=$SELECT(VV=1:6,VV=2:4,VV=3:2)
DO NDCSET
+1 SET ANS=$PIECE(ANS,"-",1)_$PIECE(ANS,"-",2)_$PIECE(ANS,"-",3)
KILL VV,VV1
+2 IF '$DATA(^PSNDF(50.67,"NDC",ANS))
KILL ANS
SET NOMSYN=1
QUIT
+3 SET PSNIEN=$ORDER(^PSNDF(50.67,"NDC",ANS,0))
SET PSNFNM=$PIECE(^PSNDF(50.67,PSNIEN,0),"^",6)
SET PSNSIZE=$PIECE(^PSNDF(50.67,PSNIEN,0),"^",8)
SET PSNTYPE=$PIECE(^PSNDF(50.67,PSNIEN,0),"^",9)
+4 IF $DATA(^PSNDF(50.68,PSNFNM,7))
SET PSNPD=$PIECE(^PSNDF(50.68,PSNFNM,7),"^",3)
IF PSNPD]""
IF PSNPD<DT
QUIT
+5 SET PSNNDF=$PIECE(^PSNDF(50.68,PSNFNM,0),"^",2)
SET PSNFORM=$PIECE(^PSNDF(50.68,PSNFNM,0),"^")
SET PSNCLASS=$PIECE(^PSNDF(50.68,PSNFNM,3),"^")
DO ASKIT1^PSNHIT
+6 QUIT
SYN SET PPQ=0
IF $DATA(^PSNTRAN(PSNB,0))
if $PIECE(^PSNTRAN(PSNB,0),"^",2)]""
QUIT
+1 WRITE !,?5,"I will attempt to match the NDCs from your SYNONYMS.",!
+2 IF '$ORDER(^PSDRUG(PSNB,1,0))
SET NOMSYN=1
+3 IF $ORDER(^PSDRUG(PSNB,1,0))
FOR XXX=0:0
SET XXX=$ORDER(^PSDRUG(PSNB,1,XXX))
if 'XXX
QUIT
SET ANS=$PIECE(^PSDRUG(PSNB,1,XXX,0),"^",2)
IF ANS?1.6N1"-"1.4N1"-"1.2N
if $PIECE($GET(^PSNTRAN(PSNB,0)),"^",2)]""
QUIT
SET TT=0
SET TTT=1
DO NDC1
if DUNCE
QUIT
