source: WorldVistAEHR/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSSPKIPI.m@ 623

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

initial load of WorldVistAEHR

File size: 5.5 KB
Line 
1PSSPKIPI ;BIR/MHA-DEA/PKI Post-Inst DEA-CS FED SCH mismatch report ;08/08/02
2 ;;1.0;PHARMACY DATA MANAGEMENT;**61**;9/30/97
3 ;Reference to ^PSNDF(50.68 supported by DBIA 3735
4START ;
5 S ZZ="PSSPKI"
6 K ^XTMP(ZZ,$J) N PSSX,PSSD,PSSJ,PSSK,PSSN,NDR
7 S PSSX="" F S PSSX=$O(^PSDRUG("B",PSSX)) Q:PSSX="" D
8 .S PSSN=0 F S PSSN=$O(^PSDRUG("B",PSSX,PSSN)) Q:'PSSN D
9 ..Q:'$D(^PSDRUG(PSSN,0))
10 ..I $P($G(^PSDRUG(PSSN,"I")),"^"),$P($G(^("I")),"^")<DT Q
11 ..;Q:$P($G(^PSDRUG(PSSN,2)),"^",3)'["O"
12 ..S PSSD=$P($G(^PSDRUG(PSSN,0)),"^",3) I PSSD="" D GCS Q
13 ..I PSSD[1!(PSSD[2)!(PSSD[3)!(PSSD[4)!(PSSD[5)!($P($G(^PSDRUG(PSSN,2)),"^",3)["N") S PSSJ=0,NDR="" D D:PSSJ REP
14 ...I PSSD["A"&(PSSD["C"),+PSSD=2!(+PSSD=3) S PSSJ=3 Q
15 ...S PSSL="",PSSK=$P($G(^PSDRUG(PSSN,"ND")),"^",3) I 'PSSK S PSSJ=2 Q
16 ...S PSSL=$$GET1^DIQ(50.68,PSSK,19,"I") Q:'PSSL
17 ...S PSSL=$E(PSSL)_$S(PSSL["n":"C",+PSSL=2!(+PSSL=3):"A",1:"")
18 ...I $L(PSSL)=1,PSSD[PSSL Q
19 ...I PSSD[$E(PSSL),PSSD[$E(PSSL,2) Q
20 ...S PSSJ=1,NDR=$$GET1^DIQ(50.68,PSSK,.01),PSSL=$$GET1^DIQ(50.68,PSSK,19,"I")
21 D REP4,SM Q
22 ;
23GCS S PSSL="",PSSK=$P($G(^PSDRUG(PSSN,"ND")),"^",3) Q:'PSSK
24 S PSSL=$$GET1^DIQ(50.68,PSSK,19,"I") Q:'PSSL
25 S PSSL=$E(PSSL)_$S(PSSL["n":"C",+PSSL=2!(+PSSL=3):"A",1:"")
26 S:+PSSL $P(^PSDRUG(PSSN,0),"^",3)=PSSL
27 Q
28 ;
29REP S ^XTMP(ZZ,$J,PSSJ,PSSX)=NDR_"^"_$P($G(^PSDRUG(PSSN,0)),"^",2)_"^"_PSSD_$S(PSSJ=1:"^"_PSSL,1:"")
30 Q
31SM K ^TMP($J),XMY
32 F J=1,2,3,4 I $D(^XTMP(ZZ,$J,J)) D
33 .N S1,S2 S $E(S1,42)="",$E(S2,12)="",K="",$P(UL,"=",79)=""
34 .D:J=1
35 ..S ^TMP($J,J,1)="The following active Controlled Substances were identified as having a"
36 ..S ^TMP($J,J,2)="discrepancy between the CS FEDERAL SCHEDULE in the VA PRODUCT file (#50.68)"
37 ..S ^TMP($J,J,3)="and the DEA,SPECIAL HDLG code in the DRUG file (#50). You may wish to update"
38 ..S ^TMP($J,J,4)="the DEA,SPECIAL HDLG code for these drugs."
39 ..S ^TMP($J,J,5)=""
40 ..S ^TMP($J,J,6)="PLEASE NOTE: The CS FEDERAL SCHEDULE will only identify DEA, SPECIAL HDLG"
41 ..S ^TMP($J,J,8)="codes of 1, 2A, 2C, 3A, 3C, 4, or 5. In addition to these codes, you may"
42 ..S ^TMP($J,J,9)="also use other DEA, SPECIAL HDLG codes such as L, P,R, S, etc., as needed."
43 ..S ^TMP($J,J,10)="",XX=11
44 .D:J=2
45 ..S ^TMP($J,J,1)="The following active Controlled Substances have not been matched to NDF."
46 ..S ^TMP($J,J,2)="You may wish to match these drugs."
47 ..S ^TMP($J,J,5)=""
48 ..S ^TMP($J,J,6)="GENERIC NAME",$E(^TMP($J,J,6),43)="VA CLASS",$E(^TMP($J,J,6),53)="CURR DEA, SPECIAL HDLG"
49 ..S ^TMP($J,J,7)=UL,^TMP($J,J,8)="",XX=9
50 .D:J=3
51 ..S ^TMP($J,J,1)="The following active drugs are defined as Controlled Substances, but"
52 ..S ^TMP($J,J,2)="not classified correctly as Narcotics or Non-Narcotics."
53 ..S ^TMP($J,J,3)="Please make sure they are defined correctly."
54 ..S ^TMP($J,J,5)=""
55 ..S ^TMP($J,J,6)="GENERIC NAME",$E(^TMP($J,J,6),43)="VA CLASS",$E(^TMP($J,J,6),53)="CURR DEA, SPECIAL HDLG"
56 ..S ^TMP($J,J,7)=UL,^TMP($J,J,8)="",XX=9
57 .D:J=4
58 ..S ^TMP($J,J,1)="The following pharmacy orderable items are associated with active dispense"
59 ..S ^TMP($J,J,2)="drugs that have a discrepancy within their DEA Special Hdlg fields. Please"
60 ..S ^TMP($J,J,3)="correct all entries to identify these orderable items with a specific"
61 ..S ^TMP($J,J,5)="Controlled Substance schedule."
62 ..S ^TMP($J,J,6)=""
63 ..S ^TMP($J,J,7)="PHARMACY ORDERABLE ITEM"
64 ..S ^TMP($J,J,8)=" IEN DISPENSE DRUG",$E(^TMP($J,J,8),52)="DEA SPEC. HDLG",$E(^TMP($J,J,8),67)="CS FED. SCHE."
65 ..S ^TMP($J,J,9)=UL,^TMP($J,J,10)="",XX=11
66 .F S K=$O(^XTMP(ZZ,$J,J,K)) Q:K="" D
67 ..S:J'=4 QQ=^XTMP(ZZ,$J,J,K)
68 ..I J=1 D PDET Q
69 ..I J=4 D REPN Q
70 ..S ^TMP($J,J,XX)=$E(K_S1,1,42)_$E($P(QQ,"^",2)_S2,1,10)_$E($P(QQ,"^",3)_S2,1,10),XX=XX+1
71 .S XMY(DUZ)="",XMDUZ="Patch # - DEA/PKI Post-Install"
72 .I $D(^XUSEC("PSNMGR")) F I=0:0 S I=$O(^XUSEC("PSNMGR",I)) Q:'I S XMY(I)=""
73 .I J=1 S XMSUB="CS FEDERAL SCHEDULE AND DEA, SPECIAL HDLG DISCREPANCIES"
74 .I J=2 S XMSUB="CONTROLLED SUBSTANCES NOT MATCHED"
75 .I J=3 S XMSUB="CONTROLLED SUBSTANCES NOT SET CORRECTLY"
76 .I J=4 S XMSUB="DISCREPANCY IN DEA WITHIN DRUGS TIED TO AN OI"
77 .S XMTEXT="^TMP($J,J," N DIFROM D ^XMD K XMY,^TMP($J,J)
78END K ^XTMP(ZZ,$J),^TMP($J),XMY,XMDUZ
79 Q
80PDET ;
81 S ^TMP($J,J,XX)="GENERIC NAME: "_K,XX=XX+1
82 S ^TMP($J,J,XX)="VA PRODUCT NAME: "_$P(QQ,"^"),XX=XX+1
83 S ^TMP($J,J,XX)="VA CLASS: "_$P(QQ,"^",2),XX=XX+1
84 S ^TMP($J,J,XX)="CURRENT DEA, SPECIAL HDLG: "_$P(QQ,"^",3),XX=XX+1
85 S ^TMP($J,J,XX)="CS FEDERAL SCHEDULE: "_$P(QQ,"^",4),XX=XX+1
86 S ^TMP($J,J,XX)="",XX=XX+1
87 Q
88REP4 ;
89 N OI S PSSL="" F S PSSL=$O(^PSDRUG("ASP",PSSL)) Q:'PSSL D
90 .Q:'$D(^PS(50.7,PSSL,0)) S OI=$P(^PS(50.7,PSSL,0),"^")
91 .S PSSN="" K AR S (I,J)=0 F S PSSN=$O(^PSDRUG("ASP",PSSL,PSSN)) Q:'PSSN D
92 ..Q:'$D(^PSDRUG(PSSN,0))
93 ..I $P($G(^PSDRUG(PSSN,"I")),"^"),$P($G(^("I")),"^")<DT Q
94 ..S PSSD=$P($G(^PSDRUG(PSSN,0)),"^",3)
95 ..Q:PSSD=""
96 ..I PSSD["A"!(PSSD["C") I PSSD[1!(PSSD[2)!(PSSD[3)!(PSSD[4)!(PSSD[5)!($P($G(^PSDRUG(PSSN,2)),"^",3)["N") D
97 ...S PSSK=$P($G(^PSDRUG(PSSN,"ND")),"^",3)
98 ...S:PSSK PSSK=$$GET1^DIQ(50.68,PSSK,19,"I")
99 ...S AR(PSSN)=OI_"^"_PSSL_"^"_PSSN_"^"_$P(^PSDRUG(PSSN,0),"^")_"^"_PSSD_"^"_PSSK
100 ...I PSSD["A" S I=1 Q
101 ...I PSSD["C" S J=1
102 .I I,J S I="" F S I=$O(AR(I)) Q:'I S AR=AR(I),^XTMP(ZZ,$J,4,$P(AR,"^",1,2),I)=$P(AR,"^",3,6)
103 Q
104REPN ;
105 S DOS="" S DOS=$P(^PS(50.7,$P(K,"^",2),0),"^",2) I DOS S DOS=$P(^PS(50.606,DOS,0),"^")
106 S ^TMP($J,J,XX)=$P(K,"^")_" "_DOS,XX=XX+1
107 S I=0 F S I=$O(^XTMP(ZZ,$J,J,K,I)) Q:'I S QQ=$G(^XTMP(ZZ,$J,J,K,I)) D
108 .S ^TMP($J,J,XX)=" "_$E(I_" ",1,6)_$E($P(QQ,"^",2)_S1,1,43)_$E($P(QQ,"^",3)_" ",1,13)_$P(QQ,"^",4),XX=XX+1
109 S ^TMP($J,J,XX)="",XX=XX+1
110 Q
Note: See TracBrowser for help on using the repository browser.