- 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 Feb 18, 2025@23:56:51 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