Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSSHLDFS

PSSHLDFS.m

Go to the documentation of this file.
PSSHLDFS ;BIR/MHA - PADE HL7 SERVER ;6/10/15
 ;;1.0;PHARMACY DATA MANAGEMENT;**193**;9/30/97;Build 17
 ; Reference to ^ORD(101 is supported by DBIA #872
 ;
 ; Description:
 ; This routine is to service Pharmacy Data Management's HL7 messaging
 ; to external applications.  The entry point, "ENP" is accessed via
 ; PSS DRUG ENTER/EDIT option and the entry point, "PROCESS1" is accessed
 ; by PSS MASTER FILE ALL, Inpatient Interface (PADE) option. This routine
 ; basically consists of subroutines to generate HL7 messages.
 ;
ENP(PSSHLDRG,PSSACT) ;
 ; set up environment for message       
 ; INPUT
 ;  PSSHLDRG = IEN of DRUG file (#50)
 ;  PSSACT = Message type - send new drug (MAD) or drug update (MUD)
 ; OUTPUT
 ;   ENTRY OR ENTRIES IN OUTGOING VISTA HL7 INTERFACE QUEUE
 ;   
EN ;
 N XX,VR,SPNAM,DNSNAM,DNSPORT,PSSD,PSSNM
 S SPNAM="PSS MFNM01 SERVER"
 S VR=$O(^ORD(101,"B",SPNAM,0))
 I 'VR D EN^DDIOL("Drug Update Protocol "_SPNAM_" is NOT Installed.","","$C(7),!!") Q
 S XX=0 F  S XX=$O(^PS(58.7,XX)) Q:'XX  D   ;sends HL7 message for each PADE SERVER
 .S PSSD=$G(^PS(58.7,XX,0))
 .Q:PSSD=""
 .S PSSNM=$P(PSSD,"^"),DNSNAM=$P(PSSD,"^",2),DNSPORT=$P(PSSD,"^",3)
 .Q:PSSNM=""!(DNSNAM="")!(DNSPORT="")
 .S VR=$P(PSSD,"^",4) Q:VR&(VR<DT)
 .S VR=$P(PSSD,"^",5) Q:VR="X"!(VR="")
 .S PSSHLDRG=+$G(PSSHLDRG),PSSACT=$G(PSSACT)
 .I PSSHLDRG D PROCESS1(SPNAM,PSSHLDRG,PSSACT,DNSNAM,DNSPORT)
 Q
 ;
PROCESS1(SPNAM,DRG,PSSACT,DNSNAM,DNSPORT) ;  Process 1 drug entry per message
 ;  Init HL params and begin building msg
 N PSSHLFS,PSSHLCS,PSSMSG,HL,HLA,PSSHLCNT,PSSFAC,PSSFNAM,PSSFIEN
 N PSSEVDT,PSSRSLT,PSS50,STATUS,HLSCOUNT,PSSHLDT,PSSHLERR,PSSHLSCS
 N PSSUIUO,SEG
 S PSSEVDT=$$NOW^XLFDT(),PSSHLDT=+$$HLDATE^HLFNC(PSSEVDT,"TS")
 K ^TMP("HLS",$J)
 M PSS50=^PSDRUG(DRG) I $G(PSS50("I"))&($P($G(PSS50("I")),"^")<DT) S PSSHLERR=5506 K HLA Q
 D INIT^HLFNC2(SPNAM,.HL)
 S PSSHLFS=$G(HL("FS")),PSSHLCS=$E(HL("ECH"),1),PSSHLSCS=$E(HL("ECH"),4)
 S PSSFIEN=$$KSP^XUPARAM("INST"),PSSFNAM=$$GET1^DIQ(4,PSSFIEN,.01)
 K HLA,HLEVN
 S (PSSHLCNT,PSSCNT)=0
 ; Build segments & transmit
 D MFI(PSSACT,.HLSCOUNT)
 D MFE(DRG,.PSS50,PSSACT,.HLSCOUNT)
 D ZFM(DRG,.PSS50,PSSACT,.HLSCOUNT)
 D TRANS
 K ^TMP("HLS",$J)
 Q
 ;
MFI(ACTION,PSSCNT) ;  MFI Seg
 S PSSCNT=1
 S SEG="MFI"_PSSHLFS
 S $P(SEG,PSSHLFS,2)="CDM"_PSSHLCS_"FORMULARY"_PSSHLFS
 S $P(SEG,PSSHLFS,4)=$S(ACTION="MAD":"REP",1:"UPD")_PSSHLFS
 S $P(SEG,PSSHLFS,7)="NE"
 S PSSARRAY("HLS",PSSCNT)=SEG
 D STORE(.PSSARRAY,PSSCNT) K PSSARRAY S PSSCNT=$G(PSSCNT)+1
 Q
 ;
MFE(DRG,FILE50,ACTION,PSSCNT) ;  MFE Seg
 S SEG="MFE"_PSSHLFS_ACTION
 S $P(SEG,PSSHLFS,5)=$$GIVECODE(DRG,PSSHLCS)
 S $P(SEG,PSSHLFS,6)="CE"
 S PSSARRAY("HLS",PSSCNT)=SEG
 D STORE(.PSSARRAY,HLSCOUNT) K PSSARRAY S PSSCNT=$G(PSSCNT)+1
 Q
 ;
ZFM(DRG,FILE50,ACTION,PSSCNT) ;  ZFM Seg [optional]
 ;  This segment is optional, send if it passes criteria below
 N NDF,SCHED,II,ND,DONE,X,Y,PSSPROD0,PSSSYN,PSSDOSF,PSSDSQ
 N PSSOI,PSSSOL,PSSVOL,PSSVOLU,PSSCLASS,CLASSNAM,GENDRG
 N PSSUOFI,PSSORDU,PSSPROD,PSSDRINF,PSSCPDU,PSSCPOU,PSSNDC,PSSREOL,PSSDLNM
 K ^TMP($J,"PSSHLNDF"),^TMP($J,"PSSCLASS")
 S PSSPROD=+$G(FILE50("ND")),PSSOI=+$G(FILE50(2)),GENDRG=""
 I PSSPROD S GENDRG=$P($G(^PSNDF(50.6,PSSPROD,0)),"^") S:GENDRG]"" GENDRG=PSSHLCS_PSSPROD_PSSHLCS_GENDRG_PSSHLCS_"99PSNDF"
 S SEG="ZFM"_PSSHLFS_$S(ACTION="MAD":"A",ACTION="MDL":"D",1:"C")
 ; Item ID (Drug ID)
 S $P(SEG,PSSHLFS,3)=$$GIVECODE(DRG,PSSHLCS)_GENDRG
 ;  Generic Name
 S $P(SEG,PSSHLFS,4)=$P($G(^PS(50.7,PSSOI,0)),"^")
 S NDF=+$P($G(FILE50("ND")),"^",3)
 S SCHED=+$P($G(FILE50(0)),"^",3) I (SCHED<1)!(SCHED>5) S SCHED="U"
 ;  Item Class (Narcotic Schedule)
 S $P(SEG,PSSHLFS,5)=SCHED
 ; Facility
 S $P(SEG,PSSHLFS,7)=PSSFNAM_PSSHLCS_"D"_PSSHLCS_PSSFIEN
 ;  Brand Name
 S PSSSYN="",II=0 F  S II=$O(FILE50(1,II)) Q:'II!$G(DONE)  S ND=$G(FILE50(1,II,0)) I $P(ND,"^")]"",$P(ND,"^",3)=0 S PSSSYN=$P(ND,"^"),DONE=1
 S:PSSSYN]"" $P(SEG,PSSHLFS,8)=PSSSYN
 ;  Dosage Form
 N NATDRG,VAPROD S PSSDOSF="",NATDRG=$P($G(FILE50("ND")),"^"),VAPROD=$P($G(FILE50("ND")),"^",3) S PSSDRINF=$$DFSU^PSNAPIS(NATDRG,VAPROD)
 S X=$P($G(^PS(50.7,PSSOI,0)),"^",2) S:X PSSDOSF=$P($G(^PS(50.606,X,0)),"^")
 S $P(SEG,PSSHLFS,9)=PSSDOSF
 ;  Drug Strength
 S PSSDSQ=$G(FILE50("DOS"))
 S:$P(PSSDSQ,"^")]"" $P(SEG,PSSHLFS,10)=$P(PSSDSQ,"^")_PSSHLFS_$P($G(^PS(50.607,$P(PSSDSQ,"^",2),0)),"^")
 I PSSDSQ="" S PSSDSQ=$P(PSSDRINF,"^",4) S:PSSDSQ]"" $P(SEG,PSSHLFS,10)=PSSDSQ_PSSHLFS_$P(PSSDRINF,"^",6)
 ;  Therapeutic Class
 S PSSCLASS=$P($G(FILE50("ND")),"^",6) I PSSCLASS D C^PSN50P65(PSSCLASS,,"PSSCLASS") D
 .S CLASSNAM=$P($G(^TMP($J,"PSSCLASS",PSSCLASS,1)),"^") I CLASSNAM'="" S $P(SEG,PSSHLFS,15)=CLASSNAM
 ;  Cost Per Dispense Unit
 S PSSCPDU=+$P($G(FILE50(660)),"^",6) I PSSCPDU'=""  S $P(SEG,PSSHLFS,16)=PSSCPDU
 ;  National Drug Code
 S $P(SEG,PSSHLFS,18)=$P($G(FILE50(2)),"^",4)
 S PSSARRAY("HLS",PSSCNT)=SEG
 K ^TMP($J,"PSSHLNDF")
 D STORE(.PSSARRAY,HLSCOUNT) K PSSARRAY S PSSCNT=$G(PSSCNT)+1
 Q
 ;
GIVECODE(ID,CS) ;  Give code
 N DRGID,DRGNM,DRGNM2,DRGSTR,DRUGND
 Q:'$D(^PSDRUG(+ID)) ""
 S DRUGND=$G(^PSDRUG(+ID,"ND"))
 S DRGID=$P(DRUGND,"^",3),DRGNM=$P($G(^PSDRUG(+ID,0)),"^")
 S DRGSTR=ID_CS_DRGNM_CS_"99PSD"
 S DRGNM2=$P(DRUGND,"^",2)
 S DRGSTR=DRGSTR_$S(DRGID:CS_DRGID_CS_DRGNM2_CS_"99PSP",1:"")
 Q DRGSTR
 ;
STORE(SEGMENT,NODE) ;  Store to HL7 SEG("HLS" array
 N NEXTND,I S NEXTND=+$O(^TMP("HLS",$J,""),-1)+1 S:'NEXTND NEXTND=1
 F I=1:1:NODE D
 .I ($G(SEGMENT("HLS",I))'="") S ^TMP("HLS",$J,NEXTND)=SEGMENT("HLS",I),NEXTND=NEXTND+1
 Q
 ;
TRANS ;  Generate HLMA entry and send message
 N HLP,PSSMFSND S HLP=""
 S HLP("SUBSCRIBER")="^^^^~"_DNSNAM_":"_DNSPORT_"~DNS"
 ;W !,"Generating HL7 message and Sending "_$P($$GIVECODE^PSSHLDFS(DRG,"-"),",",1,2)_" drug to PADE",!
 W !,"Generating HL7 message and Sending "_DRG_"-"_$P(^PSDRUG(DRG,0),"^"),!
 D GENERATE^HLMA(SPNAM,"GM",1,.PSSMFSND,"",.HLP)
 I +$P(PSSMFSND,U,2) D
 .W !!,"Drug Update transmission to PADE(s) failed because the HL7 Message could not generate."
 .W !,"  Reason(s): "_$P(PSSMFSND,U,2)," ",$P(PSSMFSND,U,3),!
 Q
 ;