| [613] | 1 | PSSNDCUT ;BIRM/MFR - NDC Utilities ;10/15/04
|
|---|
| 2 | ;;1.0;PHARMACY DATA MANAGEMENT;**90**;9/30/97
|
|---|
| 3 | ;
|
|---|
| 4 | SAVNDC(DRG,SITE,NDC,CMP) ; Saves the NDC in the DRUG file (Format: 5-4-2)
|
|---|
| 5 | ; Input: (r) DRG - Drug IEN (#50)
|
|---|
| 6 | ; (r) SITE - Outpatient Site IEN (#59)
|
|---|
| 7 | ; (r) NDC - NDC Number
|
|---|
| 8 | ; (o) CMP - CMOP? (1-YES/0-NO)
|
|---|
| 9 | N RFL,DIE,DIC,DA,DR,I,DD,DO,DINUM,X,Y
|
|---|
| 10 | ;
|
|---|
| 11 | S NDC=$$NDCFMT(NDC) I NDC="" Q
|
|---|
| 12 | ;
|
|---|
| 13 | ;- Saving the NDC in the DRUG file (#50)
|
|---|
| 14 | I '$D(^PSDRUG(DRG,"NDCOP",SITE)) D
|
|---|
| 15 | . S DIC="^PSDRUG("_DRG_",""NDCOP"","
|
|---|
| 16 | . S (X,DINUM)=SITE,DA(1)=DRG,DIC(0)=""
|
|---|
| 17 | . K DD,DO D FILE^DICN K DD,DO,DINUM,Y
|
|---|
| 18 | ;
|
|---|
| 19 | K DA,DIE,DR S DIE="^PSDRUG("_DRG_",""NDCOP"","
|
|---|
| 20 | S DA(1)=DRG,DA=SITE,DR=$S($G(CMP):2,1:1)_"///"_NDC
|
|---|
| 21 | D ^DIE
|
|---|
| 22 | Q
|
|---|
| 23 | ;
|
|---|
| 24 | GETNDC(DRG,SITE,CMOP) ; Retuns the NDC for a specific Drug/Site/CMOP or NON-CMOP
|
|---|
| 25 | N NDC,NDF
|
|---|
| 26 | ;
|
|---|
| 27 | I '$D(CMOP) S CMOP=$S($D(^PSDRUG("AQ",DRG)):1,1:0)
|
|---|
| 28 | ; - LOCAL NDC by DIVISION
|
|---|
| 29 | I $G(SITE),'CMOP S NDC=$$NDCFMT($$GET1^DIQ(50.032,SITE_","_DRG,1)) I NDC'="" Q NDC
|
|---|
| 30 | ; - CMOP NDC by DIVISION
|
|---|
| 31 | I $G(SITE),CMOP S NDC=$$NDCFMT($$GET1^DIQ(50.032,SITE_","_DRG,2)) I NDC'="" Q NDC
|
|---|
| 32 | ; - Drug File NDC
|
|---|
| 33 | S NDC=$$NDCFMT($$GET1^DIQ(50,DRG,31)) I NDC'="" Q NDC
|
|---|
| 34 | ; - National Drug File NDC
|
|---|
| 35 | 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
|
|---|
| 36 | Q NDC
|
|---|
| 37 | ;
|
|---|
| 38 | NDCFMT(NDC) ; Formats NDC codes into 5-4-2
|
|---|
| 39 | N S1,S2,S3
|
|---|
| 40 | I '$$CHKCH(NDC) Q ""
|
|---|
| 41 | I NDC?.N,NDC'?11N Q ""
|
|---|
| 42 | I NDC?11N Q ($E(NDC,1,5)_"-"_$E(NDC,6,9)_"-"_$E(NDC,10,11))
|
|---|
| 43 | ;
|
|---|
| 44 | I $L(NDC,"-")'=3 Q ""
|
|---|
| 45 | S S1=$P(NDC,"-"),S2=$P(NDC,"-",2),S3=$P(NDC,"-",3)
|
|---|
| 46 | I '$L(S1)!'$L(S2)!'$L(S3) Q ""
|
|---|
| 47 | I $L(S1)>6!($L(S2)>4)!($L(S3)>2) Q ""
|
|---|
| 48 | ;
|
|---|
| 49 | S:$L(S1)>5 S1=$E(S1,$L(S1)-4,$L(S1))
|
|---|
| 50 | S:$L(S1)<5 S1=$E(S1+100000,2,6)
|
|---|
| 51 | S S2=$E(S2+10000,2,5)
|
|---|
| 52 | S S3=$E(S3+100,2,3)
|
|---|
| 53 | ;
|
|---|
| 54 | Q (S1_"-"_S2_"-"_S3)
|
|---|
| 55 | ;
|
|---|
| 56 | CHKCH(STR) ; Checks characters different from "-" and numbers
|
|---|
| 57 | N CHKCH
|
|---|
| 58 | I STR="" Q 0
|
|---|
| 59 | S CHKCH=1 F I=1:1:$L(STR) I $E(STR,I)'?1N,$E(STR,I)'?1"-" S CHKCH=0 Q
|
|---|
| 60 | Q CHKCH
|
|---|
