source: WorldVistAEHR/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSSPKIPR.m@ 1361

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

initial load of WorldVistAEHR

File size: 5.7 KB
RevLine 
[613]1PSSPKIPR ;BIR/MHA-DEA/PKI Post-Inst DEA-CS FED SCH mismatch report ;08/08/02
2 ;;1.0;PHARMACY DATA MANAGEMENT;**61,76**;9/30/97
3 ;Reference to ^PSNDF(50.68 supported by DBIA 3735
4 Q:'$D(OP)
5DEV ;
6 K %ZIS,IO("Q"),POP,ZTSK S PSDIO=ION,%ZIS="QM" D ^%ZIS
7 S ZZ="PSSPKI"
8 I POP W !,"NO DEVICE SELECTED !!!" G END
9 I $D(IO("Q")) K IO("Q"),ZTIO,ZTSAVE,ZTDTH,ZTSK D G END
10 .S ZTRTN="EN^PSSPKIPR",ZTDESC="PKI CS vs DEA-Spec-Hdlg inconsistent-discrepancy report"
11 .N I F I="OP","ZZ" S ZTSAVE(I)=""
12 .D ^%ZTLOAD W:$D(ZTSK) !,"Report is Queued to print !!" K ZTSK
13 W:$E(IOST)["C" !!,"......Compiling report, this may take a few minutes......",!,"......It is better to QUEUE this report!!........"
14EN ;
15 K ^XTMP(ZZ) N PSSX,PSSD,PSSJ,PSSK,PSSN,NDR
16 S PSSX="" F S PSSX=$O(^PSDRUG("B",PSSX)) Q:PSSX="" D
17 .S PSSN=0 F S PSSN=$O(^PSDRUG("B",PSSX,PSSN)) Q:'PSSN D
18 ..Q:'$D(^PSDRUG(PSSN,0))
19 ..I $P($G(^PSDRUG(PSSN,"I")),"^"),$P($G(^("I")),"^")<DT Q
20 ..S PSSD=$P($G(^PSDRUG(PSSN,0)),"^",3) Q:PSSD=""
21 ..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
22 ...I PSSD["A"&(PSSD["C"),+PSSD=2!(+PSSD=3) S PSSJ=3 Q
23 ...S PSSL="",PSSK=$P($G(^PSDRUG(PSSN,"ND")),"^",3) I 'PSSK S PSSJ=2 Q
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 ...I $L(PSSL)=1,PSSD[PSSL Q
27 ...I PSSD[$E(PSSL),PSSD[$E(PSSL,2) Q
28 ...S PSSJ=1,NDR=$$GET1^DIQ(50.68,PSSK,.01),PSSL=$$GET1^DIQ(50.68,PSSK,19,"I")
29 I OP=4!(OP="A") D REP4
30 D EN1 Q
31 ;
32REP S ^XTMP(ZZ,PSSJ,PSSX)=NDR_"^"_$P($G(^PSDRUG(PSSN,0)),"^",2)_"^"_PSSD_$S(PSSJ=1:"^"_PSSL,1:"")
33 Q
34EN1 ;
35 K ^TMP($J) N S1,S2 S $E(S1,42)="",$E(S2,12)=""
36 F J=1,2,3,4 I $D(^XTMP(ZZ,J)) D
37 .S K="",XX=1 F S K=$O(^XTMP(ZZ,J,K)) Q:K="" D
38 ..S:J'=4 QQ=^XTMP(ZZ,J,K)
39 ..I J=1 D PDET Q
40 ..I J=4 D REPN Q
41 ..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
42TST U IO S PG=1,QU=0,$P(UL,"=",80)="" S:OP="A" T=1 S:$G(OP) T=OP D HD
43 I OP="A" I '$D(^TMP($J)) W !!,"********** NO DATA TO PRINT **********",!! Q
44 I $G(OP) D G END
45 .I '$D(^TMP($J,OP)) W !!,"********** NO DATA TO PRINT **********",!! Q
46 .D PR
47 I OP="A" D G END
48 .F T=1,2,3,4 D Q:QU
49 ..I T'=1 S PG=1 D HD
50 ..D PR Q:QU
51PR S K="" F S K=$O(^TMP($J,T,K)) Q:'K W !,^TMP($J,T,K) D:($Y+4)>IOSL HD Q:QU
52 Q
53END K ^XTMP(ZZ),^TMP($J)
54 W ! W:$E(IOST)'["C" @IOF D ^%ZISC
55 K ZZ,AR,DIR,DIRUT,DOS,I,J,K,T,NDR,OP,PG,PSSD,PSSJ,PSSK,PSSL,PSSN,PSSX,QQ,QU,S1,S2,T,UL,XX,ZTSAVE
56 S:$D(ZTQUEUED) ZTREQ="@"
57 Q
58PDET ;
59 S ^TMP($J,J,XX)="GENERIC NAME: "_K,XX=XX+1
60 S ^TMP($J,J,XX)="VA PRODUCT NAME: "_$P(QQ,"^"),XX=XX+1
61 S ^TMP($J,J,XX)="VA CLASS: "_$P(QQ,"^",2),XX=XX+1
62 S ^TMP($J,J,XX)="CURRENT DEA, SPECIAL HDLG: "_$P(QQ,"^",3),XX=XX+1
63 S ^TMP($J,J,XX)="CS FEDERAL SCHEDULE: "_$P(QQ,"^",4),XX=XX+1
64 S ^TMP($J,J,XX)="",XX=XX+1
65 Q
66REP4 ;
67 N OI S PSSL="" F S PSSL=$O(^PSDRUG("ASP",PSSL)) Q:'PSSL D
68 .Q:'$D(^PS(50.7,PSSL,0)) S OI=$P(^PS(50.7,PSSL,0),"^")
69 .S PSSN="" K AR S (I,J)=0 F S PSSN=$O(^PSDRUG("ASP",PSSL,PSSN)) Q:'PSSN D
70 ..Q:'$D(^PSDRUG(PSSN,0))
71 ..I $P($G(^PSDRUG(PSSN,"I")),"^"),$P($G(^("I")),"^")<DT Q
72 ..S PSSD=$P($G(^PSDRUG(PSSN,0)),"^",3)
73 ..Q:PSSD=""
74 ..I PSSD["A"!(PSSD["C") I PSSD[1!(PSSD[2)!(PSSD[3)!(PSSD[4)!(PSSD[5)!($P($G(^PSDRUG(PSSN,2)),"^",3)["N") D
75 ...S PSSK=$P($G(^PSDRUG(PSSN,"ND")),"^",3)
76 ...S:PSSK PSSK=$$GET1^DIQ(50.68,PSSK,19,"I")
77 ...S AR(PSSN)=OI_"^"_PSSL_"^"_PSSN_"^"_$P(^PSDRUG(PSSN,0),"^")_"^"_PSSD_"^"_PSSK
78 ...I PSSD["A" S I=1 Q
79 ...I PSSD["C" S J=1
80 .I I,J S I="" F S I=$O(AR(I)) Q:'I S AR=AR(I),^XTMP(ZZ,4,$P(AR,"^",1,2),I)=$P(AR,"^",3,6)
81 Q
82REPN ;
83 S DOS="" S DOS=$P(^PS(50.7,$P(K,"^",2),0),"^",2) I DOS S DOS=$P(^PS(50.606,DOS,0),"^")
84 S ^TMP($J,J,XX)=$P(K,"^")_" "_DOS,XX=XX+1
85 S I=0 F S I=$O(^XTMP(ZZ,J,K,I)) Q:'I S QQ=$G(^XTMP(ZZ,J,K,I)) D
86 .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
87 S ^TMP($J,J,XX)="",XX=XX+1
88 Q
89GRP ;
90 S PG=1,QU=0 S:OP="A" T=1 D HD
91HD I PG>1,$E(IOST)="C" S DIR(0)="E" D ^DIR I $D(DIRUT) S QU=1 Q
92 W @IOF D @("H"_T) W !,UL,! S PG=PG+1
93 Q
94H1 W !?5,"DEA Special Handling & CS Federal Schedule Discrepancies",?71,"Page: ",PG
95 I PG=1 D
96 .W !!,"The following active Controlled Substances were identified as having a"
97 .W !,"discrepancy between the CS FEDERAL SCHEDULE in the VA PRODUCT file (#50.68)"
98 .W !,"and the DEA,SPECIAL HDLG code in the DRUG file (#50). You may wish to update"
99 .W !,"the DEA,SPECIAL HDLG code for these drugs."
100 .W !!,"PLEASE NOTE: The CS FEDERAL SCHEDULE will only identify DEA, SPECIAL HDLG"
101 .W !,"codes of 1, 2A, 2C, 3A, 3C, 4, or 5. In addition to these codes, you may"
102 .W !,"also use other DEA, SPECIAL HDLG codes such as L, P,R, S, etc., as needed."
103 Q
104H2 W !?10,"Controlled Substances Not Matched to NDF",?71,"Page: ",PG
105 I PG=1 D
106 .W !!,"The following active Controlled Substances have not been matched to NDF."
107 .W !,"You may wish to match these drugs."
108 .W !!,"GENERIC NAME",?43,"VA CLASS",?53,"CURR DEA, SPECIAL HDLG"
109 Q
110H3 W !?7,"CS (DRUGS) with Inconsistent DEA Special Handling Field",?71,"Page: ",PG
111 I PG=1 D
112 .W !!,"The following active drugs are defined as Controlled Substances, but"
113 .W !,"not classified correctly as Narcotics or Non-Narcotics."
114 .W !,"Please make sure they are defined correctly."
115 .W !!,"GENERIC NAME",?43,"VA CLASS",?53,"CURR DEA, SPECIAL HDLG"
116 Q
117H4 W !?3,"CS (ORDERABLE ITEMS) with Inconsistent DEA Special Handling Field",?71,"Page: ",PG
118 I PG=1 D
119 .W !!,"The following pharmacy orderable items are associated with active dispense"
120 .W !,"drugs that have a discrepancy within their DEA Special Hdlg fields. Please"
121 .W !,"correct all entries to identify these orderable items with a specific"
122 .W !,"Controlled Substance schedule."
123 .W !!,"PHARMACY ORDERABLE ITEM"
124 .W !," IEN DISPENSE DRUG",?52,"DEA SPEC. HDLG",?67,"CS FED. SCHE."
125 Q
Note: See TracBrowser for help on using the repository browser.