- 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 Feb 18, 2025@23:50:36 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