PSSNDCUT ;BIRM/MFR - NDC Utilities ;10-Dec-2013 16:28;DU
;;1.0;PHARMACY DATA MANAGEMENT;**90,1017**;9/30/97;Build 40
; Modified - IHS/MSC/MGH 12/10/2013 - Line GETNDC+4
SAVNDC(DRG,SITE,NDC,CMP) ; Saves the NDC in the DRUG file (Format: 5-4-2)
; Input: (r) DRG - Drug IEN (#50)
; (r) SITE - Outpatient Site IEN (#59)
; (r) NDC - NDC Number
; (o) CMP - CMOP? (1-YES/0-NO)
N RFL,DIE,DIC,DA,DR,I,DD,DO,DINUM,X,Y
;
S NDC=$$NDCFMT(NDC) I NDC="" Q
;
;- Saving the NDC in the DRUG file (#50)
I '$D(^PSDRUG(DRG,"NDCOP",SITE)) D
. S DIC="^PSDRUG("_DRG_",""NDCOP"","
. S (X,DINUM)=SITE,DA(1)=DRG,DIC(0)=""
. K DD,DO D FILE^DICN K DD,DO,DINUM,Y
;
K DA,DIE,DR S DIE="^PSDRUG("_DRG_",""NDCOP"","
S DA(1)=DRG,DA=SITE,DR=$S($G(CMP):2,1:1)_"///"_NDC
D ^DIE
Q
;
GETNDC(DRG,SITE,CMOP) ; Retuns the NDC for a specific Drug/Site/CMOP or NON-CMOP
N NDC,NDF
;
I '$D(CMOP) S CMOP=$S($D(^PSDRUG("AQ",DRG)):1,1:0)
;Patch 1017 DO NOT use Local NDC codes.
; - LOCAL NDC by DIVISION
;I $G(SITE),'CMOP S NDC=$$NDCFMT($$GET1^DIQ(50.032,SITE_","_DRG,1)) I NDC'="" Q NDC
; - CMOP NDC by DIVISION
;I $G(SITE),CMOP S NDC=$$NDCFMT($$GET1^DIQ(50.032,SITE_","_DRG,2)) I NDC'="" Q NDC
; - Drug File NDC
S NDC=$$NDCFMT($$GET1^DIQ(50,DRG,31)) I NDC'="" Q NDC
; - National Drug File NDC
I NDC="" S NDF=+$$GET1^DIQ(50,DRG,22,"I") I NDF'="" S NDC=$$NDCFMT($$GET1^DIQ(50.68,NDF,13)) I NDC'="" Q NDC
Q NDC
;
NDCFMT(NDC) ; Formats NDC codes into 5-4-2
N S1,S2,S3
I '$$CHKCH(NDC) Q ""
I NDC?.N,NDC'?11N Q ""
I NDC?11N Q ($E(NDC,1,5)_"-"_$E(NDC,6,9)_"-"_$E(NDC,10,11))
;
I $L(NDC,"-")'=3 Q ""
S S1=$P(NDC,"-"),S2=$P(NDC,"-",2),S3=$P(NDC,"-",3)
I '$L(S1)!'$L(S2)!'$L(S3) Q ""
I $L(S1)>6!($L(S2)>4)!($L(S3)>2) Q ""
;
S:$L(S1)>5 S1=$E(S1,$L(S1)-4,$L(S1))
S:$L(S1)<5 S1=$E(S1+100000,2,6)
S S2=$E(S2+10000,2,5)
S S3=$E(S3+100,2,3)
;
Q (S1_"-"_S2_"-"_S3)
;
CHKCH(STR) ; Checks characters different from "-" and numbers
N CHKCH
I STR="" Q 0
S CHKCH=1 F I=1:1:$L(STR) I $E(STR,I)'?1N,$E(STR,I)'?1"-" S CHKCH=0 Q
Q CHKCH
PSSNDCUT ;BIRM/MFR - NDC Utilities ;10-Dec-2013 16:28;DU
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**90,1017**;9/30/97;Build 40
+2 ; Modified - IHS/MSC/MGH 12/10/2013 - Line GETNDC+4
SAVNDC(DRG,SITE,NDC,CMP) ; Saves the NDC in the DRUG file (Format: 5-4-2)
+1 ; Input: (r) DRG - Drug IEN (#50)
+2 ; (r) SITE - Outpatient Site IEN (#59)
+3 ; (r) NDC - NDC Number
+4 ; (o) CMP - CMOP? (1-YES/0-NO)
+5 NEW RFL,DIE,DIC,DA,DR,I,DD,DO,DINUM,X,Y
+6 ;
+7 SET NDC=$$NDCFMT(NDC)
IF NDC=""
QUIT
+8 ;
+9 ;- Saving the NDC in the DRUG file (#50)
+10 IF '$DATA(^PSDRUG(DRG,"NDCOP",SITE))
Begin DoDot:1
+11 SET DIC="^PSDRUG("_DRG_",""NDCOP"","
+12 SET (X,DINUM)=SITE
SET DA(1)=DRG
SET DIC(0)=""
+13 KILL DD,DO
DO FILE^DICN
KILL DD,DO,DINUM,Y
End DoDot:1
+14 ;
+15 KILL DA,DIE,DR
SET DIE="^PSDRUG("_DRG_",""NDCOP"","
+16 SET DA(1)=DRG
SET DA=SITE
SET DR=$SELECT($GET(CMP):2,1:1)_"///"_NDC
+17 DO ^DIE
+18 QUIT
+19 ;
GETNDC(DRG,SITE,CMOP) ; Retuns the NDC for a specific Drug/Site/CMOP or NON-CMOP
+1 NEW NDC,NDF
+2 ;
+3 IF '$DATA(CMOP)
SET CMOP=$SELECT($DATA(^PSDRUG("AQ",DRG)):1,1:0)
+4 ;Patch 1017 DO NOT use Local NDC codes.
+5 ; - LOCAL NDC by DIVISION
+6 ;I $G(SITE),'CMOP S NDC=$$NDCFMT($$GET1^DIQ(50.032,SITE_","_DRG,1)) I NDC'="" Q NDC
+7 ; - CMOP NDC by DIVISION
+8 ;I $G(SITE),CMOP S NDC=$$NDCFMT($$GET1^DIQ(50.032,SITE_","_DRG,2)) I NDC'="" Q NDC
+9 ; - Drug File NDC
+10 SET NDC=$$NDCFMT($$GET1^DIQ(50,DRG,31))
IF NDC'=""
QUIT NDC
+11 ; - National Drug File NDC
+12 IF NDC=""
SET NDF=+$$GET1^DIQ(50,DRG,22,"I")
IF NDF'=""
SET NDC=$$NDCFMT($$GET1^DIQ(50.68,NDF,13))
IF NDC'=""
QUIT NDC
+13 QUIT NDC
+14 ;
NDCFMT(NDC) ; Formats NDC codes into 5-4-2
+1 NEW S1,S2,S3
+2 IF '$$CHKCH(NDC)
QUIT ""
+3 IF NDC?.N
IF NDC'?11N
QUIT ""
+4 IF NDC?11N
QUIT ($EXTRACT(NDC,1,5)_"-"_$EXTRACT(NDC,6,9)_"-"_$EXTRACT(NDC,10,11))
+5 ;
+6 IF $LENGTH(NDC,"-")'=3
QUIT ""
+7 SET S1=$PIECE(NDC,"-")
SET S2=$PIECE(NDC,"-",2)
SET S3=$PIECE(NDC,"-",3)
+8 IF '$LENGTH(S1)!'$LENGTH(S2)!'$LENGTH(S3)
QUIT ""
+9 IF $LENGTH(S1)>6!($LENGTH(S2)>4)!($LENGTH(S3)>2)
QUIT ""
+10 ;
+11 IF $LENGTH(S1)>5
SET S1=$EXTRACT(S1,$LENGTH(S1)-4,$LENGTH(S1))
+12 IF $LENGTH(S1)<5
SET S1=$EXTRACT(S1+100000,2,6)
+13 SET S2=$EXTRACT(S2+10000,2,5)
+14 SET S3=$EXTRACT(S3+100,2,3)
+15 ;
+16 QUIT (S1_"-"_S2_"-"_S3)
+17 ;
CHKCH(STR) ; Checks characters different from "-" and numbers
+1 NEW CHKCH
+2 IF STR=""
QUIT 0
+3 SET CHKCH=1
FOR I=1:1:$LENGTH(STR)
IF $EXTRACT(STR,I)'?1N
IF $EXTRACT(STR,I)'?1"-"
SET CHKCH=0
QUIT
+4 QUIT CHKCH
