source: WorldVistAEHR/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSAP56.m@ 1154

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

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1PSAP56 ;VMP/PDW-DUPLICATE REMOVAL ;93/17/2006
2 ;;3.0;DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**56**; 10/24/97
3 ;;References to ^PSDRUG( are covered by DBIA #2095
4EN ;
5 D EXIT
6 S VSN=0 F S VSN=$O(^PSDRUG("AVSN",VSN)) Q:VSN'>0 D VSN
7 D MAILMSG,EXIT
8 Q
9VSN ;
10 S DRDA=0,RXCNT=0 F S DRDA=$O(^PSDRUG("AVSN",VSN,DRDA)) Q:DRDA'>0 D DRDA
11 Q
12DRDA ;process drug:VSN
13 ;SYN0(counter)=node, SYNIEN(counter)=SYDA
14 K SYN0,SYNIEN,SYNDUP,SYNDC,SYCNT
15 S SYDA=0 F S SYDA=$O(^PSDRUG("AVSN",VSN,DRDA,SYDA)) Q:SYDA'>0 D
16 . ; if more DRUG VSN decendents process the DRUG
17 .I +$O(^PSDRUG("AVSN",VSN,DRDA,SYDA)) D MORE
18 Q
19MORE ;
20 K SYN0,SYNIEN,SYNDUP,SYNDC,SYCNT
21 S SYNIEN=0 F S SYNIEN=$O(^PSDRUG("AVSN",VSN,DRDA,SYNIEN)) Q:SYNIEN'>0 D
22 .S SYCNT=$G(SYCNT)+1,SYN0(SYCNT)=^PSDRUG(DRDA,1,SYNIEN,0),SYNIEN(SYCNT)=SYNIEN
23 .S SYDA=SYNIEN ; reset upper loop to end of VSNs
24 ;
25DUPS ;compare synonyms of the identical VSN/drug found
26 K SYNDUP
27 ;pairs of divisions may have set the same drug with different DUOU, dups then on sereval DUOU
28 ;FIND EXACT MATCHES, store pairs in SYNDUP(N1,N2)="", and DELETE ALL BUT FIRST
29 F N1=1:1:SYCNT-1 F N2=N1+1:1:SYCNT I SYN0(N1)=SYN0(N2) S SYNDUP(N1,N2)=""
30 I '$D(SYNDUP) Q
31 D DELETE
32 D LOGDUP
33 Q
34DELETE ;
35 Q:'$D(SYNDUP)
36 S N1=0 F S N1=$O(SYNDUP(N1)) Q:N1'>0 D
37 . S N2=0 F S N2=$O(SYNDUP(N1,N2)) Q:N2'>0 D
38 . . K DIK S DA(1)=DRDA,DA=SYNIEN(N2),DIK="^PSDRUG("_DA(1)_",1," D ^DIK
39 . . K SYNDC(N2) ;if dup N2 is removed its NDC match to others needs to be removed
40 . . K SYNDUP(N2) ; if N2 has dups they will also have been picked up under N1 already
41 Q
42LOGDUP ;
43 S DRGNM=$P(^PSDRUG(DRDA,0),U,1)
44 S SYDAL=0 F S SYDAL=$O(SYNDUP(SYDAL)) Q:SYDAL'>0 S ^TMP($J,"PSADUP",DRGNM,DRDA,SYNIEN(SYDAL))=0
45 Q
46 ;SYN0(SYCNT)=^PSDRUG(DRDA,1,SYDA,0)
47 ;SYNIEN(SYCNT)=SYDA
48 ;S SYNDUP(N1,N2)=""
49 ;S SYNDC(N1,N2)=""
50MAILMSG ; generate mail message of duplicates deleted.
51 K ^TMP($J,"PSAMM")
52 N DIFROM
53 I $D(^TMP($J,"PSADUP")) I 1
54 E G NOMSG
55 S X="PSA*3*56 DELETE DUPLICATE SYNONYMS REPORT" D MMLN
56 S X="The following Drug-Synonyms have had identical synonyms removed from the drug." D MMLN
57 S X="" D TXT("Drug Name",1),TXT("DRG#,SYN#",43),TXT("NDC",53),TXT("VSN",68),MMLN
58 S DRGNM="" F S DRGNM=$O(^TMP($J,"PSADUP",DRGNM)) Q:DRGNM="" D DRIEN
59 S XMSUB="PSA*3*56 Delete Duplicate Drug Synonyms report"
60 S XMTEXT="^TMP($J,""PSAMM"",",XMDUZ="PSA*3*56 Post Init"
61 S XMY(DUZ)=""
62 D ^XMD
63 Q
64DRIEN ;work the specific drug
65 S DRDA=0 F S DRDA=$O(^TMP($J,"PSADUP",DRGNM,DRDA)) Q:DRDA'>0 D SYNDR
66 Q
67SYNDR ; work synonyms under a drug
68 S SYNDA=0 F S SYNDA=$O(^TMP($J,"PSADUP",DRGNM,DRDA,SYNDA)) Q:SYNDA'>0 D SYN
69 Q
70SYN ;report the individual synonym that had duplicates deleted
71 K SYNFLD
72 ;2-NDC'2 400-VSN'4 401-OU'5 402-PPOU'6 403-DUOU'7 404-PPDU'8
73 S SYN0=^PSDRUG(DRDA,1,SYNDA,0),X=SYN0,DA=SYNDA,DA(1)=DRDA,IENS=DA_","_DA(1)_","
74 S NDC=$P(X,U,2),VSN=$P(X,U,4),PPOU="PPOU: $"_$P(X,U,6),DUOU="DUOU: "_$P(X,U,7),PPDU="PPDU: $"_$P(X,U,8)
75 S OU="OU: "_$$GET1^DIQ(50.1,IENS,401),DA(1)=DRDA
76 S X="" D TXT(DRGNM,1),TXT(DRDA_","_SYNDA,43),TXT(NDC,53),TXT(VSN,68) D MMLN
77 S X="" D TXT(OU,1),TXT(PPOU,15),TXT(DUOU,45),TXT(PPDU,60) D MMLN
78 Q
79MMLN S MMLC=+$G(MMLC)+1 S ^TMP($J,"PSAMM",MMLC)=X Q
80TXT(VAL,COL) S:'$D(X) X="" S X=$$SETSTR^VALM1(VAL,X,COL,$L(VAL)) Q
81NOMSG ; report no duplicates found to remove.
82 S X="PSA*3*56 DELETE DUPLICATE SYNONYMS REPORT" D MMLN
83 S X=" " D MMLN
84 S X="There were no duplicate drug-synonyms found. No synonyms removed." D MMLN
85 S XMSUB="PSA*3*56 Delete Duplicate Drug Synonyms report"
86 S XMTEXT="^TMP($J,""PSAMM"",",XMDUZ="PSA*3*56 Post Init"
87 S XMY(DUZ)=""
88 D ^XMD
89EXIT ;
90 K COL,DIK,DRDA,DRGNM,DUOU,IENS,MMLC,N1,N2,NDC,OU,PPDU,DDOU,RXCNT,SYCNT,SYDA,SYN0
91 K SYNDA,SYNDC,SYNDUP,SYNFLD,SYNIEN,SYN0,^TMP($J),VAL,VSN,PPOU,SYDAL
92 Q
Note: See TracBrowser for help on using the repository browser.