source: WorldVistAEHR/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSSNDCUT.m@ 703

Last change on this file since 703 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1PSSNDCUT ;BIRM/MFR - NDC Utilities ;10/15/04
2 ;;1.0;PHARMACY DATA MANAGEMENT;**90**;9/30/97
3 ;
4SAVNDC(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 ;
24GETNDC(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 ;
38NDCFMT(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 ;
56CHKCH(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
Note: See TracBrowser for help on using the repository browser.