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