PSSDGUPD ;BIR/PWC - builds HL7 V.2.4 drug update message ;12/22/2003
;;1.0;PHARMACY DATA MANAGEMENT;**57,66,70,82**;9/30/97
;IA: 10054 - ^LAB(60
;IA: 10055 - ^LAB(61
;IA: 2079 - ^PSNDF
;IA: 2221 - ^PS(50.607
;IA: 872 - ^ORD(101
;IA: 10106 - $$HLDATE^HLFNC
;IA: 2161 - INIT^HLFNC2
;IA: 2164 - GENERATE^HLMA
Q
DRG(DRG,NEW,DNSNAM,DNSPORT) ;entry point
N CNT,DOSF,DRG0,DRG2,DRG3,DRG6,DRG60,DRGN,DRGSYN,DRGZ,DRGZ1,MEDRT,PSSRESLT,PSSOPTNS,PROT,HL,HLA,ZPA,RXD,OBR,DOS1,DOS2,CLOZ2,LTMON,XX,WARN,LNF,VNF,SYIN,SYNINT,SYUN,VSN,TYPE,UNIT,WNS,WW,ORDITEM,CMOP,OPEXT,LABTST,SPEC,ZPANF,ZPACMOP
;
K HLA("HLS") S PROT=$O(^ORD(101,"B","PSS EXT MFU SERVER",0))
I 'PROT D EN^DDIOL("Drug Update Protocol NOT Installed ","","$C(7),!!") Q
D INIT^HLFNC2(PROT,.HL) I $G(HL) Q
S HL("ECH")="~^\&",CNT=0
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))
S WARN=$P(DRG0,"^",8),LNF=$P(DRG0,"^",9),VNF=$P(DRG0,"^",11)
S WNS="" I $G(WARN) F I=1:1 S WW=$P(WARN,",",I) Q:WW="" S WNS=WNS_WW_"^"_$G(^PS(54,WW,0))_"~"
S ORDITEM=+$P(DRG2,"^"),CMOP=+$P(DRG3,"^"),OPEXT=+$P(DRG6,"^")
S LABTST=+$P(DRGZ,"^"),SPEC=+$P(DRGZ,"^",3)
;msh segment
;S CNT=CNT+1,HLA("HLS",CNT)="MSH|~^\&|PSS VISTA|STATION #~STATION DNS~DNS|PSS DISPENSE|~DISPENSE DNS NAME:PORT~DNS|"_$H_"||MFN^M01|10001||P|2.4|||AL|AL|||||"
;mfi segment
S CNT=CNT+1,HLA("HLS",CNT)="MFI|50^DRUG^99PSD||UPD|||NE"
;the MFE and ZPA segments are multiples and a separate one will be sent
;for each Drug and the matching synonyms.
;mfe segment - DRUG
S CNT=CNT+1,HLA("HLS",CNT)="MFE|"_$S($G(NEW):"MAD",1:"MUP")_"|||"_$P(DRG0,"^")
;zpa segment - DRUG
S CNT=CNT+1,ZPA=""
S $P(ZPA,"^",1)=$P(DRG0,"^")_"|N|" ;main drug
I LNF&VNF S ZPANF="LFN^Local Non-Formulary^Pharm Formulary Listing~VFN^VISN Non-Formulary^Pharm Formulary Listing"
I LNF&'VNF S ZPANF="LFN^Local Non-Formulary^Pharm Formulary Listing"
I 'LNF&VNF S ZPANF="VFN^VISN Non-Formulary^Pharm Formulary Listing"
S $P(ZPA,"|",3)=$G(ZPANF)
S $P(ZPA,"|",4)=$$HLDATE^HLFNC($G(^PSDRUG(DRG,"I")),"TS")
S $P(ZPA,"|",5)=$P(DRG0,"^",10)
S $P(ZPA,"|",6)=$P(DRG0,"^",2)
S $P(ZPA,"|",7)=$E($P(DRG0,"^",3),1)
S $P(ZPA,"|",8)=$E($P(DRG0,"^",3),2)
S $P(ZPA,"|",9)=$S($P(DRG0,"^",6)]"":"50^"_$P(DRG0,"^",6)_"^LPS50",1:"")
S $P(ZPA,"|",10)=WNS
S $P(ZPA,"|",11)=$S(ORDITEM&($D(^PS(50.7,ORDITEM,0))):ORDITEM_"^"_$P($G(^PS(50.7,ORDITEM,0)),"^")_"^LPSD50.7",1:"")
S DOSF=$S(ORDITEM&($P($G(^PS(50.7,ORDITEM,0)),"^",2)):$P(^PS(50.7,ORDITEM,0),"^",2)_"^"_$P($G(^PS(50.606,+$P($G(^PS(50.7,ORDITEM,0)),"^",2),0)),"^")_"^"_"LPSD50.606",1:"")
S MEDRT=$S(ORDITEM&($P($G(^PS(50.7,ORDITEM,0)),"^",6)):$P(^PS(50.7,ORDITEM,0),"^",6)_"^"_$P($G(^PS(51.2,+$P($G(^PS(50.7,ORDITEM,0)),"^",6),0)),"^")_"^"_"LPSD51.2",1:"")
S $P(ZPA,"|",12)=DOSF
S $P(ZPA,"|",13)=MEDRT
S $P(ZPA,"|",14)=$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)),"^")_"^LPSD50.68",1:"")
I CMOP&OPEXT S ZPACMOP="OP^OP Dispense^Pharm dispense flag~CMOP^CMOP Dispense^Pharm dispense flag"
I 'CMOP&OPEXT S ZPACMOP="OP^OP Dispense^Pharm dispense flag"
I CMOP&'OPEXT S ZPACMOP="CMOP^CMOP Dispense^Pharm dispense flag"
S $P(ZPA,"|",15)=$G(ZPACMOP)
S $P(ZPA,"|",16)=$$HLDATE^HLFNC($P(DRG60,"^",9),"TS")
S $P(ZPA,"|",17)=$S(LABTST&($P($G(^LAB(60,LABTST,0)),"^")]""):LABTST_"^"_$P($G(^LAB(60,LABTST,0)),"^")_"^LLAB60",1:"")
S $P(ZPA,"|",18)=$S(SPEC&($P($G(^LAB(61,SPEC,0)),"^")]""):SPEC_"^"_$P(^LAB(61,SPEC,0),"^")_"^LLAB61",1:"")
S $P(ZPA,"|",19)=$P(DRGZ1,"^")
S $P(ZPA,"|",20)=$P(DRGZ,"^",2)
S $P(ZPA,"|",21)=$P($G(^PSDRUG(DRG,"DOS")),"^")
S UNIT=$P($G(^PSDRUG(DRG,"DOS")),"^",2)
;order unit
S $P(ZPA,"|",22)=$S(UNIT&($P($G(^PS(50.607,+UNIT,0)),"^")]""):UNIT_"^"_$P(^PS(50.607,+UNIT,0),"^")_"^LPSD50.607",1:"")
;price per order unit and price per dispense unit
S $P(ZPA,"|",23)=$S($P(DRG60,"^",3)]"":$P(DRG60,"^",3)_"&USD^UP",1:"")
S $P(ZPA,"|",24)=$S($P(DRG60,"^",6)]"":$P(DRG60,"^",6)_"&USD^UP",1:"")
;dispense unit, dispense unit/order unit
S $P(ZPA,"|",25)=$P(DRG60,"^",8)
S $P(ZPA,"|",26)=$P(DRG60,"^",5)
S $P(ZPA,"|",29)=$P(DRG2,"^",4)
S HLA("HLS",CNT)="ZPA|"_ZPA
;
;rxd segment
; a separate RXD segment will be sent for each multiple of possible dosages
F XX=0:0 S XX=$O(^PSDRUG(DRG,"DOS1",XX)) Q:'XX S DOS1=$G(^(XX,0)) D
.K RXD S CNT=CNT+1,RXD=""
.S $P(RXD,"|",4)=$P(DOS1,"^",4)
.S $P(RXD,"|",9)=$P(DOS1,"^")
.S $P(RXD,"|",12)="^P&"_$P(DOS1,"^",2)_"&LPSD50.0903"
.S $P(RXD,"|",24)=$P(DOS1,"^",3)
.S HLA("HLS",CNT)="RXD|"_RXD
;a separate RXD segment will be sent for each local possible dosages
F XX=0:0 S XX=$O(^PSDRUG(DRG,"DOS2",XX)) Q:'XX S DOS2=$G(^(XX,0)) D
.K RXD S CNT=CNT+1,RXD=""
.S $P(RXD,"|",4)=$P(DOS2,"^",3)
.S $P(RXD,"|",12)=$S($P(DOS2,"^")]"":"^LP&"_$P(DOS2,"^")_"&LPSD50.0904",1:"")
.S $P(RXD,"|",24)=$P(DOS2,"^",2)
.S HLA("HLS",CNT)="RXD|"_RXD
;
;obr segments - clozapine lab tests
;a separate OBR segment will be sent for each clozapine multiple
;
F XX=0:0 S XX=$O(^PSDRUG(DRG,"CLOZ2",XX)) Q:'XX S CLOZ2=$G(^(XX,0)) D
.S LTMON=$P(CLOZ2,"^"),SPEC=$P(CLOZ2,"^",3),TYPE=$P(CLOZ2,"^",4)
.K OBR S CNT=CNT+1,OBR=""
.S $P(OBR,"|",4)=$S(LTMON]"":LTMON_"^"_$P(^LAB(60,LTMON,0),"^")_"^LLAB60",1:"")
.S $P(OBR,"|",15)=$S(SPEC]"":SPEC_"^"_$P(^LAB(61,SPEC,0),"^")_"^LLAB61",1:"")
.S $P(OBR,"|",24)=$S(TYPE=1:"WBC",TYPE=2:"ANC",1:"")
.S $P(OBR,"|",27)=$P(CLOZ2,"^",2)
.S HLA("HLS",CNT)="OBR|"_OBR
;
; now send SYNONYMS for DRUG in multiple ZPA segments
;
F XX=0:0 S XX=$O(^PSDRUG(DRG,1,XX)) Q:'XX S DRGSYN=$G(^(XX,0)) D
.S SYIN=$P(DRGSYN,"^",3),VSN=$P(DRGSYN,"^",4),SYUN=+$P(DRGSYN,"^",5)
.S SYNINT=$S(SYIN=0:"TRADE NAME",SYIN=1:"QUICK CODE",SYIN="D":"DRUG ACCOUNTABILITY",SYIN="C":"CONTROLLED SUBSTANCE",1:"")
.K ZPA S CNT=CNT+1,ZPA=""
.S $P(ZPA,"|",1)=$P(DRGSYN,"^")_"|Y"
.S $P(ZPA,"|",9)=$S(VSN]"":"50.1^"_VSN_"^LPS50.1",1:"")
.S $P(ZPA,"|",22)=$S(SYUN&($P($G(^DIC(51.5,SYUN,0)),"^")]""):SYUN_"^"_$P(^(0),"^",2)_"^LPSD51.5",1:"")
.S $P(ZPA,"|",23)=$S($P(DRGSYN,"^",6)]"":$P(DRGSYN,"^",6)_"&USD^UP",1:"")
.S $P(ZPA,"|",24)=$S($P(DRGSYN,"^",8)]"":$P(DRGSYN,"^",8)_"&USD^UP",1:"")
.S $P(ZPA,"|",26)=$P(DRGSYN,"^",7)
.S $P(ZPA,"|",28)=$P(DRGSYN,"^",9)
.S $P(ZPA,"|",29)=$P(DRGSYN,"^",2)
.S $P(ZPA,"|",30)=SYNINT
.S HLA("HLS",CNT)="ZPA|"_ZPA
S PSSOPTNS("SUBSCRIBER")="^^^^~"_DNSNAM_":"_DNSPORT_"~DNS"
D GENERATE^HLMA("PSS EXT MFU SERVER","LM",1,.PSSRESLT,"",.PSSOPTNS)
K HLA("HLS")
Q
;
PSN ;entry point from NDF data updates
S PROT=$O(^ORD(101,"B","PSS EXT MFU SERVER",0)) I 'PROT G PSNX
D INIT^HLFNC2(PROT,.HL) I $G(HL) G PSNX
N PSN
F S PSN=$O(^TMP($J,"^",PSN)) Q:'PSN D DRG(PSN)
PSNX K PSN,^TMP($J),PROT,HL S ZTREQ="@"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSDGUPD 6862 printed Dec 13, 2024@02:30:49 Page 2
PSSDGUPD ;BIR/PWC - builds HL7 V.2.4 drug update message ;12/22/2003
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**57,66,70,82**;9/30/97
+2 ;IA: 10054 - ^LAB(60
+3 ;IA: 10055 - ^LAB(61
+4 ;IA: 2079 - ^PSNDF
+5 ;IA: 2221 - ^PS(50.607
+6 ;IA: 872 - ^ORD(101
+7 ;IA: 10106 - $$HLDATE^HLFNC
+8 ;IA: 2161 - INIT^HLFNC2
+9 ;IA: 2164 - GENERATE^HLMA
+10 QUIT
DRG(DRG,NEW,DNSNAM,DNSPORT) ;entry point
+1 NEW CNT,DOSF,DRG0,DRG2,DRG3,DRG6,DRG60,DRGN,DRGSYN,DRGZ,DRGZ1,MEDRT,PSSRESLT,PSSOPTNS,PROT,HL,HLA,ZPA,RXD,OBR,DOS1,DOS2,CLOZ2,LTMON,XX,WARN,LNF,VNF,SYIN,SYNINT,SYUN,VSN,TYPE,UNIT,WNS,WW,ORDITEM,CMOP,OPEXT,LABTST,SPEC,ZPANF,ZPACMOP
+2 ;
+3 KILL HLA("HLS")
SET PROT=$ORDER(^ORD(101,"B","PSS EXT MFU SERVER",0))
+4 IF 'PROT
DO EN^DDIOL("Drug Update Protocol NOT Installed ","","$C(7),!!")
QUIT
+5 DO INIT^HLFNC2(PROT,.HL)
IF $GET(HL)
QUIT
+6 SET HL("ECH")="~^\&"
SET CNT=0
+7 SET DRG0=$GET(^PSDRUG(DRG,0))
SET DRG2=$GET(^(2))
SET DRG3=$GET(^(3))
SET DRG6=$GET(^(6))
SET DRGN=$GET(^("ND"))
SET DRGZ=$GET(^("CLOZ"))
SET DRGZ1=$GET(^("CLOZ1"))
SET DRG60=$GET(^(660))
+8 SET WARN=$PIECE(DRG0,"^",8)
SET LNF=$PIECE(DRG0,"^",9)
SET VNF=$PIECE(DRG0,"^",11)
+9 SET WNS=""
IF $GET(WARN)
FOR I=1:1
SET WW=$PIECE(WARN,",",I)
if WW=""
QUIT
SET WNS=WNS_WW_"^"_$GET(^PS(54,WW,0))_"~"
+10 SET ORDITEM=+$PIECE(DRG2,"^")
SET CMOP=+$PIECE(DRG3,"^")
SET OPEXT=+$PIECE(DRG6,"^")
+11 SET LABTST=+$PIECE(DRGZ,"^")
SET SPEC=+$PIECE(DRGZ,"^",3)
+12 ;msh segment
+13 ;S CNT=CNT+1,HLA("HLS",CNT)="MSH|~^\&|PSS VISTA|STATION #~STATION DNS~DNS|PSS DISPENSE|~DISPENSE DNS NAME:PORT~DNS|"_$H_"||MFN^M01|10001||P|2.4|||AL|AL|||||"
+14 ;mfi segment
+15 SET CNT=CNT+1
SET HLA("HLS",CNT)="MFI|50^DRUG^99PSD||UPD|||NE"
+16 ;the MFE and ZPA segments are multiples and a separate one will be sent
+17 ;for each Drug and the matching synonyms.
+18 ;mfe segment - DRUG
+19 SET CNT=CNT+1
SET HLA("HLS",CNT)="MFE|"_$SELECT($GET(NEW):"MAD",1:"MUP")_"|||"_$PIECE(DRG0,"^")
+20 ;zpa segment - DRUG
+21 SET CNT=CNT+1
SET ZPA=""
+22 ;main drug
SET $PIECE(ZPA,"^",1)=$PIECE(DRG0,"^")_"|N|"
+23 IF LNF&VNF
SET ZPANF="LFN^Local Non-Formulary^Pharm Formulary Listing~VFN^VISN Non-Formulary^Pharm Formulary Listing"
+24 IF LNF&'VNF
SET ZPANF="LFN^Local Non-Formulary^Pharm Formulary Listing"
+25 IF 'LNF&VNF
SET ZPANF="VFN^VISN Non-Formulary^Pharm Formulary Listing"
+26 SET $PIECE(ZPA,"|",3)=$GET(ZPANF)
+27 SET $PIECE(ZPA,"|",4)=$$HLDATE^HLFNC($GET(^PSDRUG(DRG,"I")),"TS")
+28 SET $PIECE(ZPA,"|",5)=$PIECE(DRG0,"^",10)
+29 SET $PIECE(ZPA,"|",6)=$PIECE(DRG0,"^",2)
+30 SET $PIECE(ZPA,"|",7)=$EXTRACT($PIECE(DRG0,"^",3),1)
+31 SET $PIECE(ZPA,"|",8)=$EXTRACT($PIECE(DRG0,"^",3),2)
+32 SET $PIECE(ZPA,"|",9)=$SELECT($PIECE(DRG0,"^",6)]"":"50^"_$PIECE(DRG0,"^",6)_"^LPS50",1:"")
+33 SET $PIECE(ZPA,"|",10)=WNS
+34 SET $PIECE(ZPA,"|",11)=$SELECT(ORDITEM&($DATA(^PS(50.7,ORDITEM,0))):ORDITEM_"^"_$PIECE($GET(^PS(50.7,ORDITEM,0)),"^")_"^LPSD50.7",1:"")
+35 SET DOSF=$SELECT(ORDITEM&($PIECE($GET(^PS(50.7,ORDITEM,0)),"^",2)):$PIECE(^PS(50.7,ORDITEM,0),"^",2)_"^"_$PIECE($GET(^PS(50.606,+$PIECE($GET(^PS(50.7,ORDITEM,0)),"^",2),0)),"^")_"^"_"LPSD50.606",1:"")
+36 SET MEDRT=$SELECT(ORDITEM&($PIECE($GET(^PS(50.7,ORDITEM,0)),"^",6)):$PIECE(^PS(50.7,ORDITEM,0),"^",6)_"^"_$PIECE($GET(^PS(51.2,+$PIECE($GET(^PS(50.7,ORDITEM,0)),"^",6),0)),"^")_"^"_"LPSD51.2",1:"")
+37 SET $PIECE(ZPA,"|",12)=DOSF
+38 SET $PIECE(ZPA,"|",13)=MEDRT
+39 SET $PIECE(ZPA,"|",14)=$SELECT($PIECE(DRGN,"^",3)&($PIECE($GET(^PSNDF(50.68,+$PIECE(DRGN,"^",3),0)),"^")]""):$PIECE(DRGN,"^",3)_"^"_$PIECE($GET(^PSNDF(50.68,$PIECE(DRGN,"^",3),0)),"^")_"^LPSD50.68",1:"")
+40 IF CMOP&OPEXT
SET ZPACMOP="OP^OP Dispense^Pharm dispense flag~CMOP^CMOP Dispense^Pharm dispense flag"
+41 IF 'CMOP&OPEXT
SET ZPACMOP="OP^OP Dispense^Pharm dispense flag"
+42 IF CMOP&'OPEXT
SET ZPACMOP="CMOP^CMOP Dispense^Pharm dispense flag"
+43 SET $PIECE(ZPA,"|",15)=$GET(ZPACMOP)
+44 SET $PIECE(ZPA,"|",16)=$$HLDATE^HLFNC($PIECE(DRG60,"^",9),"TS")
+45 SET $PIECE(ZPA,"|",17)=$SELECT(LABTST&($PIECE($GET(^LAB(60,LABTST,0)),"^")]""):LABTST_"^"_$PIECE($GET(^LAB(60,LABTST,0)),"^")_"^LLAB60",1:"")
+46 SET $PIECE(ZPA,"|",18)=$SELECT(SPEC&($PIECE($GET(^LAB(61,SPEC,0)),"^")]""):SPEC_"^"_$PIECE(^LAB(61,SPEC,0),"^")_"^LLAB61",1:"")
+47 SET $PIECE(ZPA,"|",19)=$PIECE(DRGZ1,"^")
+48 SET $PIECE(ZPA,"|",20)=$PIECE(DRGZ,"^",2)
+49 SET $PIECE(ZPA,"|",21)=$PIECE($GET(^PSDRUG(DRG,"DOS")),"^")
+50 SET UNIT=$PIECE($GET(^PSDRUG(DRG,"DOS")),"^",2)
+51 ;order unit
+52 SET $PIECE(ZPA,"|",22)=$SELECT(UNIT&($PIECE($GET(^PS(50.607,+UNIT,0)),"^")]""):UNIT_"^"_$PIECE(^PS(50.607,+UNIT,0),"^")_"^LPSD50.607",1:"")
+53 ;price per order unit and price per dispense unit
+54 SET $PIECE(ZPA,"|",23)=$SELECT($PIECE(DRG60,"^",3)]"":$PIECE(DRG60,"^",3)_"&USD^UP",1:"")
+55 SET $PIECE(ZPA,"|",24)=$SELECT($PIECE(DRG60,"^",6)]"":$PIECE(DRG60,"^",6)_"&USD^UP",1:"")
+56 ;dispense unit, dispense unit/order unit
+57 SET $PIECE(ZPA,"|",25)=$PIECE(DRG60,"^",8)
+58 SET $PIECE(ZPA,"|",26)=$PIECE(DRG60,"^",5)
+59 SET $PIECE(ZPA,"|",29)=$PIECE(DRG2,"^",4)
+60 SET HLA("HLS",CNT)="ZPA|"_ZPA
+61 ;
+62 ;rxd segment
+63 ; a separate RXD segment will be sent for each multiple of possible dosages
+64 FOR XX=0:0
SET XX=$ORDER(^PSDRUG(DRG,"DOS1",XX))
if 'XX
QUIT
SET DOS1=$GET(^(XX,0))
Begin DoDot:1
+65 KILL RXD
SET CNT=CNT+1
SET RXD=""
+66 SET $PIECE(RXD,"|",4)=$PIECE(DOS1,"^",4)
+67 SET $PIECE(RXD,"|",9)=$PIECE(DOS1,"^")
+68 SET $PIECE(RXD,"|",12)="^P&"_$PIECE(DOS1,"^",2)_"&LPSD50.0903"
+69 SET $PIECE(RXD,"|",24)=$PIECE(DOS1,"^",3)
+70 SET HLA("HLS",CNT)="RXD|"_RXD
End DoDot:1
+71 ;a separate RXD segment will be sent for each local possible dosages
+72 FOR XX=0:0
SET XX=$ORDER(^PSDRUG(DRG,"DOS2",XX))
if 'XX
QUIT
SET DOS2=$GET(^(XX,0))
Begin DoDot:1
+73 KILL RXD
SET CNT=CNT+1
SET RXD=""
+74 SET $PIECE(RXD,"|",4)=$PIECE(DOS2,"^",3)
+75 SET $PIECE(RXD,"|",12)=$SELECT($PIECE(DOS2,"^")]"":"^LP&"_$PIECE(DOS2,"^")_"&LPSD50.0904",1:"")
+76 SET $PIECE(RXD,"|",24)=$PIECE(DOS2,"^",2)
+77 SET HLA("HLS",CNT)="RXD|"_RXD
End DoDot:1
+78 ;
+79 ;obr segments - clozapine lab tests
+80 ;a separate OBR segment will be sent for each clozapine multiple
+81 ;
+82 FOR XX=0:0
SET XX=$ORDER(^PSDRUG(DRG,"CLOZ2",XX))
if 'XX
QUIT
SET CLOZ2=$GET(^(XX,0))
Begin DoDot:1
+83 SET LTMON=$PIECE(CLOZ2,"^")
SET SPEC=$PIECE(CLOZ2,"^",3)
SET TYPE=$PIECE(CLOZ2,"^",4)
+84 KILL OBR
SET CNT=CNT+1
SET OBR=""
+85 SET $PIECE(OBR,"|",4)=$SELECT(LTMON]"":LTMON_"^"_$PIECE(^LAB(60,LTMON,0),"^")_"^LLAB60",1:"")
+86 SET $PIECE(OBR,"|",15)=$SELECT(SPEC]"":SPEC_"^"_$PIECE(^LAB(61,SPEC,0),"^")_"^LLAB61",1:"")
+87 SET $PIECE(OBR,"|",24)=$SELECT(TYPE=1:"WBC",TYPE=2:"ANC",1:"")
+88 SET $PIECE(OBR,"|",27)=$PIECE(CLOZ2,"^",2)
+89 SET HLA("HLS",CNT)="OBR|"_OBR
End DoDot:1
+90 ;
+91 ; now send SYNONYMS for DRUG in multiple ZPA segments
+92 ;
+93 FOR XX=0:0
SET XX=$ORDER(^PSDRUG(DRG,1,XX))
if 'XX
QUIT
SET DRGSYN=$GET(^(XX,0))
Begin DoDot:1
+94 SET SYIN=$PIECE(DRGSYN,"^",3)
SET VSN=$PIECE(DRGSYN,"^",4)
SET SYUN=+$PIECE(DRGSYN,"^",5)
+95 SET SYNINT=$SELECT(SYIN=0:"TRADE NAME",SYIN=1:"QUICK CODE",SYIN="D":"DRUG ACCOUNTABILITY",SYIN="C":"CONTROLLED SUBSTANCE",1:"")
+96 KILL ZPA
SET CNT=CNT+1
SET ZPA=""
+97 SET $PIECE(ZPA,"|",1)=$PIECE(DRGSYN,"^")_"|Y"
+98 SET $PIECE(ZPA,"|",9)=$SELECT(VSN]"":"50.1^"_VSN_"^LPS50.1",1:"")
+99 SET $PIECE(ZPA,"|",22)=$SELECT(SYUN&($PIECE($GET(^DIC(51.5,SYUN,0)),"^")]""):SYUN_"^"_$PIECE(^(0),"^",2)_"^LPSD51.5",1:"")
+100 SET $PIECE(ZPA,"|",23)=$SELECT($PIECE(DRGSYN,"^",6)]"":$PIECE(DRGSYN,"^",6)_"&USD^UP",1:"")
+101 SET $PIECE(ZPA,"|",24)=$SELECT($PIECE(DRGSYN,"^",8)]"":$PIECE(DRGSYN,"^",8)_"&USD^UP",1:"")
+102 SET $PIECE(ZPA,"|",26)=$PIECE(DRGSYN,"^",7)
+103 SET $PIECE(ZPA,"|",28)=$PIECE(DRGSYN,"^",9)
+104 SET $PIECE(ZPA,"|",29)=$PIECE(DRGSYN,"^",2)
+105 SET $PIECE(ZPA,"|",30)=SYNINT
+106 SET HLA("HLS",CNT)="ZPA|"_ZPA
End DoDot:1
+107 SET PSSOPTNS("SUBSCRIBER")="^^^^~"_DNSNAM_":"_DNSPORT_"~DNS"
+108 DO GENERATE^HLMA("PSS EXT MFU SERVER","LM",1,.PSSRESLT,"",.PSSOPTNS)
+109 KILL HLA("HLS")
+110 QUIT
+111 ;
PSN ;entry point from NDF data updates
+1 SET PROT=$ORDER(^ORD(101,"B","PSS EXT MFU SERVER",0))
IF 'PROT
GOTO PSNX
+2 DO INIT^HLFNC2(PROT,.HL)
IF $GET(HL)
GOTO PSNX
+3 NEW PSN
+4 FOR
SET PSN=$ORDER(^TMP($JOB,"^",PSN))
if 'PSN
QUIT
DO DRG(PSN)
PSNX KILL PSN,^TMP($JOB),PROT,HL
SET ZTREQ="@"
+1 QUIT
