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