source: FOIAVistA/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSSHUIDG.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 5.8 KB
Line 
1PSSHUIDG ;BIR/SAB - builds hl7 drug update message ;06/27/2002
2 ;;1.0;PHARMACY DATA MANAGEMENT;**57,66,70**;9/30/97
3 ;IA: 10054 - ^LAB(60
4 ;IA: 10055 - ^LAB(61
5 ;IA: 2079 - ^PSNDF
6 ;IA: 2221 - ^PS(50.607
7 ;IA: 872 - ^ORD(101
8 ;IA: 10106 - $$HLDATE^HLFNC
9 ;IA: 2161 - INIT^HLFNC2
10 ;IA: 2164 - GENERATE^HLMA
11DRG(DRG,NEW) ;entry point
12 N ACT,CNT,DOS,DOSF,DRG0,DRG2,DRG3,DRG6,DRG60,DRGN,DRGZ,DRGZ1,INT,MEDRT,PSSRESLT,PSSOPTNS,PKG,PROT,SYN,XX
13 N HL,HLA
14 S PROT=$O(^ORD(101,"B","PSS HUI DRUG UPDATE",0))
15 I 'PROT D EN^DDIOL("Drug Update Protocol NOT Installed ","","$C(7),!!") Q
16 D INIT^HLFNC2(PROT,.HL) I $G(HL) Q ;D EN^DDIOL($P(HL,"^",2)_". Drug Update Message Not Sent.","","$C(7),!!") Q
17 S HL("ECH")="^~\",CNT=0
18 S DRG0=$G(^PSDRUG(DRG,0)),DRG2=$G(^(2)),DRG3=$G(^(3)),DRG6=$G(^(6)),DRGN=$G(^("ND")),DRGZ=$G(^("CLOZ")),DRGZ1=$G(^("CLOZ1")),DRG60=$G(^(660))
19 ;msh segment
20 ;S CNT=CNT+1,HLA("HLS",CNT)="MSH|^~\&|PHARMACY DATA MANAGEMENT"
21 ;S $P(HLA("HLS",CNT),HL("FS"),9)="MFN"
22 ;mfi segment
23 S CNT=CNT+1,HLA("HLS",CNT)="MFI|50^DRUG^99PSD"
24 S $P(HLA("HLS",CNT),HL("FS"),6)="NE"
25 ;mfa segment
26 S CNT=CNT+1,HLA("HLS",CNT)="MFA|"_$S($G(NEW):"MAD",1:"MUP")
27 ;mfe segment
28 S CNT=CNT+1,HLA("HLS",CNT)="MFE|"_$S($G(NEW):"MAD",1:"MUP"),$P(HLA("HLS",CNT),"|",5)=DRG_"^"_$P(DRG0,"^")_"^99PSD"
29 ;zpa segment
30 S CNT=CNT+1,HLA("HLS",CNT)="ZPA|"_$P(DRG2,"^",4)_"|"_$P(DRG0,"^",9)_"|"_$$HLDATE^HLFNC($G(^PSDRUG(DRG,"I")),"TS")_"|"
31 S HLA("HLS",CNT)=HLA("HLS",CNT)_$P(DRG2,"^",3)_"|"_$P(DRG0,"^",10)_"|"_$P(DRG0,"^",2)_"|"_$P(DRG0,"^",3)_"|"_$P(DRG0,"^",6)_"|"_$P(DRG0,"^",8)_"|"_$P(DRG0,"^",11)
32 ;zpb segment
33 S CNT=CNT+1,HLA("HLS",CNT)="ZPB|"_$S($P(DRG2,"^")&($D(^PS(50.7,+$P(DRG2,"^"),0))):$P(DRG2,"^")_"^"_$P($G(^PS(50.7,$P(DRG2,"^"),0)),"^")_"^PSD50.7",1:"")_"|"
34 S DOSF=$S($P(DRG2,"^")&($P($G(^PS(50.7,+$P(DRG2,"^"),0)),"^",2)):$P(^PS(50.7,+$P(DRG2,"^"),0),"^",2)_"^"_$P($G(^PS(50.606,+$P($G(^PS(50.7,+$P(DRG2,"^"),0)),"^",2),0)),"^")_"^"_"PSD50.606",1:"")
35 S MEDRT=$S($P(DRG2,"^")&($P($G(^PS(50.7,+$P(DRG2,"^"),0)),"^",6)):$P(^PS(50.7,+$P(DRG2,"^"),0),"^",6)_"^"_$P($G(^PS(51.2,+$P($G(^PS(50.7,+$P(DRG2,"^"),0)),"^",6),0)),"^")_"^"_"PSD51.2",1:"")
36 S HLA("HLS",CNT)=HLA("HLS",CNT)_DOSF_"|"_MEDRT_"|"
37 S HLA("HLS",CNT)=HLA("HLS",CNT)_$S($P(DRGN,"^",3)&($P($G(^PSNDF(50.68,+$P(DRGN,"^",3),0)),"^")]""):$P(DRGN,"^",3)_"^"_$P($G(^PSNDF(50.68,$P(DRGN,"^",3),0)),"^")_"^PSD50.68",1:"")_"|"
38 S HLA("HLS",CNT)=HLA("HLS",CNT)_$P($G(DRG60),"^",8)_"|"_+$P(DRG3,"^")_"|"_+$P(DRG6,"^")_"|"_$$HLDATE^HLFNC($P(DRG60,"^",9),"TS")_"|"
39 S HLA("HLS",CNT)=HLA("HLS",CNT)_$S($P(DRGZ,"^")&($P($G(^LAB(60,+$P(DRGZ,"^"),0)),"^")]""):$P(DRGZ,"^")_"^"_$P($G(^LAB(60,$P(DRGZ,"^"),0)),"^")_"^LAB60",1:"")
40 ;zpc segment
41 S CNT=CNT+1,HLA("HLS",CNT)="ZPC|"_$S($P(DRGZ,"^",3)&($P($G(^LAB(61,+$P(DRGZ,"^",3),0)),"^")]""):$P(DRGZ,"^",3)_"^"_$P(^LAB(61,$P(DRGZ,"^",3),0),"^")_"^LAB61",1:"")_"|"
42 S HLA("HLS",CNT)=HLA("HLS",CNT)_$P(DRGZ1,"^")_"|"_$P(DRGZ1,"^",2)_"|"_$P($G(^PSDRUG(DRG,"DOS")),"^")_"|",DOS=$P($G(^PSDRUG(DRG,"DOS")),"^",2)
43 S HLA("HLS",CNT)=HLA("HLS",CNT)_$S(DOS&($P($G(^PS(50.607,+DOS,0)),"^")]""):DOS_"^"_$P(^PS(50.607,+DOS,0),"^")_"^PSD50.607",1:"")_"|"
44 S HLA("HLS",CNT)=HLA("HLS",CNT)_$P(DRG60,"^",3)_"|"_$P(DRG60,"^",6)
45 ;zpd segment
46 K SYN F XX=0:0 S XX=$O(^PSDRUG(DRG,1,XX)) Q:'XX D
47 .S SYN=^PSDRUG(DRG,1,XX,0),CNT=CNT+1
48 .S HLA("HLS",CNT)="ZPD|"_$P(SYN,"^")_"|"_$P(SYN,"^",2)_"|"
49 .S HLA("HLS",CNT)=HLA("HLS",CNT)_$S($P(SYN,"^",3)]"":$P(SYN,"^",3)_"^"_$S($P(SYN,"^",3)=0:"TRADE NAME",$P(SYN,"^",3)=1:"QUICK CODE",$P(SYN,"^",3)="D":"DRUG ACCOUNTABILITY",$P(SYN,"^",3)="C":"CONTROLLED SUBSTANCE",1:""),1:"")_"|"
50 .S HLA("HLS",CNT)=HLA("HLS",CNT)_$P(SYN,"^",4)_"|"_$S($P(SYN,"^",5)&($P($G(^DIC(51.5,+$P(SYN,"^",5),0)),"^")]""):$P(SYN,"^",5)_"^"_$P(^DIC(51.5,$P(SYN,"^",5),0),"^")_"^"_$P(^(0),"^",2)_"^PSD51.5",1:"")_"|"
51 .S HLA("HLS",CNT)=HLA("HLS",CNT)_$P(SYN,"^",6)_"|"_$P(SYN,"^",7)_"|"_$P(SYN,"^",8)_"|"_$P(SYN,"^",9) K SYN
52 ;zpe segment
53 K ACT,INT F XX=0:0 S XX=$O(^PSDRUG(DRG,4,XX)) Q:'XX S ACT=^PSDRUG(DRG,4,XX,0),CNT=CNT+1 D
54 .S HLA("HLS",CNT)="ZPE|"_$$HLDATE^HLFNC($P(ACT,"^"),"TS")_"|"_$S($P(ACT,"^",2)]"":"E^EDIT",1:"")_"|"
55 .S INT=$S($P(ACT,"^",3)&($P($G(^VA(200,$P(ACT,"^",3),0)),"^")]""):$P(ACT,"^",3)_"^"_$P(^VA(200,$P(ACT,"^",3),0),"^")_"^VA200",1:"")
56 .S HLA("HLS",CNT)=HLA("HLS",CNT)_INT_"|"_$P(ACT,"^",4)_"|"_$P(ACT,"^",5)_"|"_$P(ACT,"^",6)
57 K INT,ACT,XX
58 ;zpf segment
59 K ACT,INT F XX=0:0 S XX=$O(^PSDRUG(DRG,"DOS1",XX)) Q:'XX S ACT=^PSDRUG(DRG,"DOS1",XX,0),CNT=CNT+1 D
60 .S HLA("HLS",CNT)="ZPF|"_$P(ACT,"^")_"|"_$P(ACT,"^",2)_"|"_$S($P(ACT,"^",3)="I":"I^INPATIENT",$P(ACT,"^",3)="O":"O^OUTPATIENT",$P(ACT,"^",3)="IO"!($P(ACT,"^",3)="OI"):"IO^INPATIENT/OUTPATIENT",1:"")_"|"_$P(ACT,"^",4)
61 K ACT,INT,XX
62 ;zpg segment
63 K ACT F XX=0:0 S XX=$O(^PSDRUG(DRG,"CLOZ2",XX)) Q:'XX S ACT=^PSDRUG(DRG,"CLOZ2",XX,0),CNT=CNT+1 D
64 .S HLA("HLS",CNT)="ZPG|"_$S($P(ACT,"^")&($P($G(^LAB(60,$P(ACT,"^"),0)),"^")]""):$P(ACT,"^")_"^"_$P(^LAB(60,$P(ACT,"^"),0),"^")_"^LAB60",1:"")_"|"_$P(ACT,"^",2)_"|"
65 .S HLA("HLS",CNT)=HLA("HLS",CNT)_$S($P(ACT,"^",3)&($P($G(^LAB(61,$P(ACT,"^",3),0)),"^")]""):$P(ACT,"^",3)_"^"_$P(^LAB(61,$P(ACT,"^",3),0),"^")_"^LAB61",1:"")_"|"_$S($P(ACT,"^",4)=1:"1^WBC",$P(ACT,"^",4)=2:"2^ANC",1:"") K ACT
66 ;zph segment
67 K ACT,INT F XX=0:0 S XX=$O(^PSDRUG(DRG,"DOS2",XX)) Q:'XX S ACT=^PSDRUG(DRG,"DOS2",XX,0),CNT=CNT+1 D
68 .S HLA("HLS",CNT)="ZPH|"_$P(ACT,"^")_"|"
69 .S PKG=$S($P(ACT,"^",2)="O":"O^OUTPATIENT",$P(ACT,"^",2)="I":"I^INPATIENT",$P(ACT,"^",2)="IO":"IO^INPATIENT/OUTPATIENT",$P(ACT,"^",2)="OI":"IO^INPATIENT/OUTPATIENT",1:"")
70 .S HLA("HLS",CNT)=HLA("HLS",CNT)_PKG_"|"_$P(ACT,"^",3)
71 K ACT,INT,XX,PKG
72 ;builds hl7 message
73 D GENERATE^HLMA("PSS HUI DRUG UPDATE","LM",1,.PSSRESLT,"",.PSSOPTNS)
74 Q
75 ;
76PSN ;entry point from NDF data updates
77 S PROT=$O(^ORD(101,"B","PSS HUI DRUG UPDATE",0)) I 'PROT G PSNX
78 D INIT^HLFNC2(PROT,.HL) I $G(HL) G PSNX
79 N PSN
80 F S PSN=$O(^TMP($J,"^",PSN)) Q:'PSN D DRG(PSN)
81PSNX K PSN,^TMP($J),PROT,HL S ZTREQ="@"
82 Q
Note: See TracBrowser for help on using the repository browser.