YSCLHLRD ;DSS/PO-CLOZAPINE DATA TRANSMISSION-Messaging-Clinical/dispense ;18 June 2020 12:03:21
;;5.01;MENTAL HEALTH;**149**;Dec 30, 1994;Build 72
Q
;
RDEO11(YSCLARR,YSILENT) ; Build and send clinical/dispense message
; input: YSCLARR - data array to build HL7 segments from
;
; APPARMS - HLO application parameters
; HL- delimiters for HL7 utilities
; HLMSTATE - message state for HLO
; WHO - destination for HLO
; SEG - segment for HLO
; ERROR - message creation error
; YSCLDEST - destination name for HLO
; HL7RES - HL7 send result, zero if message not sent
;
N APPARMS,ERROR,HL,HL7RES,HLMSTATE,SEG,WHO,YSCLDEST
; create message
S APPARMS("MESSAGE TYPE")="RDE"
S APPARMS("EVENT")="O11"
S APPARMS("MESSAGE STRUCTURE")="RDE_O11"
S APPARMS("VERSION")="2.5.1"
I '$$NEWMSG^HLOAPI(.APPARMS,.HLMSTATE,.ERROR) I 'HL7RES D APPERROR^%ZTER("Error creating ClozMod RDE^O11") ; log error (D ^XTER) and continue Q
;
D PID^YSCLHLPD(.SEG,.YSCLARR) ;create PID segment
Q:'$$ADDSEG^HLOAPI(.HLMSTATE,.SEG)
;
; create PV1 segment
D SET^HLOAPI(.SEG,"PV1",0)
D SET^HLOAPI(.SEG,YSCLARR("PATIENT_INPAT/OUTPAT"),2)
Q:'$$ADDSEG^HLOAPI(.HLMSTATE,.SEG) ; "PV1" segment
;
; create ORC segment
D SET^HLOAPI(.SEG,"ORC",0)
D SET^HLOAPI(.SEG,"RE",1) ; order control code = results to follow
D SET^HLOAPI(.SEG,YSCLARR("MED_PRESCRIBING DATE"),9,1,1)
D SET^HLOAPI(.SEG,YSCLARR("PROVIDER_NPI"),12,1,1)
D SET^HLOAPI(.SEG,YSCLARR("PROVIDER_LAST NAME"),12,2,1,1)
D SET^HLOAPI(.SEG,YSCLARR("PROVIDER_FIRST NAME"),12,3,1,1)
D SET^HLOAPI(.SEG,"NPI",12,13,1,1)
Q:'$$ADDSEG^HLOAPI(.HLMSTATE,.SEG)
;
; create RXE segment
D SET^HLOAPI(.SEG,"RXE",0)
; give code for drug
D SET^HLOAPI(.SEG,YSCLARR("MED_DRUG NDC"),2,4)
D SET^HLOAPI(.SEG,YSCLARR("MED_DRUG NAME"),2,5)
D SET^HLOAPI(.SEG,"NDC",2,6)
D SET^HLOAPI(.SEG,YSCLARR("MED_DOSE"),3)
D SET^HLOAPI(.SEG,"MG",5,1) ; units value is hard coded, should we replace it from VistA?
; If override code is a 9, append the Prescriber-approved code
I YSCLARR("MED_REASON CODE")=9 S YSCLARR("MED_REASON CODE")=YSCLARR("MED_REASON CODE")_$G(YSCLARR("MED_ALTERNATE REASON CODE"))
D SET^HLOAPI(.SEG,YSCLARR("MED_REASON CODE"),7,1)
D SET^HLOAPI(.SEG,YSCLARR("MED_REASON TEXT"),7,2)
D SET^HLOAPI(.SEG,YSCLARR("MED_ALTERNATE REASON CODE"),7,4)
D SET^HLOAPI(.SEG,YSCLARR("MED_ALTERNATE REASON TEXT"),7,5)
D SET^HLOAPI(.SEG,YSCLARR("DISPQTY"),10,1)
D SET^HLOAPI(.SEG,YSCLARR("DISPQTYUNIT"),11,2)
;
D SET^HLOAPI(.SEG,YSCLARR("MED_APPROVING PROVIDER DEA"),14,1,1,1)
D SET^HLOAPI(.SEG,YSCLARR("MED_APPROVING PROVIDER IEN"),14,1,1,2)
D SET^HLOAPI(.SEG,"DEA",14,13,1,1)
;ajf ; adding approving provider
D SET^HLOAPI(.SEG,YSCLARR("MED_APPROVING PROVIDER_LAST NAME"),14,2,1,1)
D SET^HLOAPI(.SEG,YSCLARR("MED_APPROVING PROVIDER_FIRST NAME"),14,3,1,1)
D SET^HLOAPI(.SEG,"PN",14,13,1,2)
D SET^HLOAPI(.SEG,YSCLARR("MED_RX#/ORDER#"),15,1)
D SET^HLOAPI(.SEG,YSCLARR("SITE_PHARMACY NCPDP"),40,1)
;
Q:'$$ADDSEG^HLOAPI(.HLMSTATE,.SEG)
;
; create TQ1 segment(s)
D SET^HLOAPI(.SEG,"TQ1",0)
D SET^HLOAPI(.SEG,"1",1,1)
; Use drug file dosage if available
I $G(YSCLARR("DISPAMT")) D
. D SET^HLOAPI(.SEG,YSCLARR("DISPAMT"),2,1)
. D SET^HLOAPI(.SEG,$G(YSCLARR("DISPUNIT")),2,2,1)
I '$G(YSCLARR("DISPAMT")) D
. D SET^HLOAPI(.SEG,YSCLARR("MED_DOSE"),2,1)
. D SET^HLOAPI(.SEG,"MG",2,2,1)
Q:'$$ADDSEG^HLOAPI(.HLMSTATE,.SEG)
;
; create RXR segment for route
D SET^HLOAPI(.SEG,"RXR",0)
D SET^HLOAPI(.SEG,"PO",1,1)
D SET^HLOAPI(.SEG,"ORAL",1,2)
D SET^HLOAPI(.SEG,"HL70162",1,3)
Q:'$$ADDSEG^HLOAPI(.HLMSTATE,.SEG)
;
S APPARMS("SENDING APPLICATION")="YSCL-REG-SEND"
S APPARMS("ACCEPT ACK TYPE")="AL"
S APPARMS("APP ACK TYPE")="NE"
S APPARMS("ACCEPT ACK RESPONSE")="COMTRESP^YSCLHLRD" ; temporary until COMMIT ack needed
S APPARMS("APP ACK RESPONSE")="APPRESP^YSCLHLRD" ; temporary until APP ack needed
S YSCLDEST="YSCL-REG-REC"
S WHO("RECEIVING APPLICATION")=YSCLDEST
S WHO("FACILITY LINK NAME")="YSCL-NCCC"
;
S HL7RES=$$SENDONE^HLOAPI1(.HLMSTATE,.APPARMS,.WHO,.ERROR)
I 'HL7RES D APPERROR^%ZTER("HLO error sending ClozMod RDE^O11") ; log error (D ^XTER) and continue
; leave code for future developers
;D:'$G(YSILENT) ; write messages
;. W:HL7RES !,"RDE_O11 message IEN=",HL7RES," generated and sent to ",YSCLDEST,!
;. W:'HL7RES !,"Error: ",$G(ERROR),!," ","No RDE_O11 message sent!"
;
Q HL7RES
;
COMTRESP ; process COMMIT ACCEPT ACK RESPONSE
;
N COMTND,HDR,MSG,ND,RES
I $G(HLMSGIEN) S RES=$$STARTMSG^HLOPRS(.MSG,HLMSGIEN,.HDR)
S COMTND=$$NOW^XLFDT+.00000001,ND=$$TMPND
F Q:'$D(^XTMP(ND,"COMTRESP",COMTND)) S COMTND=COMTND+.00000001 ; unique node per response
S ^XTMP(ND,"COMTRESP",COMTND,$J,"MSGIEN")="COMMIT ACK RESPONSE - COMTRESP^YSCLHLRD called! HLMSGIEN="_$G(HLMSGIEN)
S ^XTMP(ND,"COMTRESP",COMTND,$J,"RES")=$G(RES)
M ^XTMP(ND,"COMTRESP",COMTND,$J,"MSG")=MSG
M ^XTMP(ND,"COMTRESP",COMTND,$J,"HDR")=HDR
D XTMPZRO
Q
;
APPRESP ; process ACCEPT ACK RESPONSE
N APPND,ND
S APPND=$$NOW^XLFDT+.00000001,ND=$$TMPND
F Q:'$D(^XTMP(ND,"APPRESP",APPND)) S APPND=APPND+.00000001 ; unique node per response
S ^XTMP(ND,"APPRESP",APPND,$J)="APP ACK RESPONSE - APPRESP^YSCLHLRD called! HLMSGIEN="_$G(HLMSGIEN)
D XTMPZRO
Q
;
XTMPZRO ;set ^XTMP("YSCLHLRD "_DT), new zero node everyday
N XPRVAL S XPRVAL=$$FMADD^XLFDT($$DT^XLFDT,90) ; 90 days in the future
S $P(XPRVAL,U,2)=$$NOW^XLFDT,$P(XPRVAL,U,3)="CLOZAPINE HL7 (HLO) ACKS",^XTMP($$TMPND,0)=XPRVAL
Q
;
TMPND() Q "YSCLHL7ACK "_DT ; zero node for ^XTMP, space before the date
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSCLHLRD 5692 printed Sep 23, 2025@19:49:51 Page 2
YSCLHLRD ;DSS/PO-CLOZAPINE DATA TRANSMISSION-Messaging-Clinical/dispense ;18 June 2020 12:03:21
+1 ;;5.01;MENTAL HEALTH;**149**;Dec 30, 1994;Build 72
+2 QUIT
+3 ;
RDEO11(YSCLARR,YSILENT) ; Build and send clinical/dispense message
+1 ; input: YSCLARR - data array to build HL7 segments from
+2 ;
+3 ; APPARMS - HLO application parameters
+4 ; HL- delimiters for HL7 utilities
+5 ; HLMSTATE - message state for HLO
+6 ; WHO - destination for HLO
+7 ; SEG - segment for HLO
+8 ; ERROR - message creation error
+9 ; YSCLDEST - destination name for HLO
+10 ; HL7RES - HL7 send result, zero if message not sent
+11 ;
+12 NEW APPARMS,ERROR,HL,HL7RES,HLMSTATE,SEG,WHO,YSCLDEST
+13 ; create message
+14 SET APPARMS("MESSAGE TYPE")="RDE"
+15 SET APPARMS("EVENT")="O11"
+16 SET APPARMS("MESSAGE STRUCTURE")="RDE_O11"
+17 SET APPARMS("VERSION")="2.5.1"
+18 ; log error (D ^XTER) and continue Q
IF '$$NEWMSG^HLOAPI(.APPARMS,.HLMSTATE,.ERROR)
IF 'HL7RES
DO APPERROR^%ZTER("Error creating ClozMod RDE^O11")
+19 ;
+20 ;create PID segment
DO PID^YSCLHLPD(.SEG,.YSCLARR)
+21 if '$$ADDSEG^HLOAPI(.HLMSTATE,.SEG)
QUIT
+22 ;
+23 ; create PV1 segment
+24 DO SET^HLOAPI(.SEG,"PV1",0)
+25 DO SET^HLOAPI(.SEG,YSCLARR("PATIENT_INPAT/OUTPAT"),2)
+26 ; "PV1" segment
if '$$ADDSEG^HLOAPI(.HLMSTATE,.SEG)
QUIT
+27 ;
+28 ; create ORC segment
+29 DO SET^HLOAPI(.SEG,"ORC",0)
+30 ; order control code = results to follow
DO SET^HLOAPI(.SEG,"RE",1)
+31 DO SET^HLOAPI(.SEG,YSCLARR("MED_PRESCRIBING DATE"),9,1,1)
+32 DO SET^HLOAPI(.SEG,YSCLARR("PROVIDER_NPI"),12,1,1)
+33 DO SET^HLOAPI(.SEG,YSCLARR("PROVIDER_LAST NAME"),12,2,1,1)
+34 DO SET^HLOAPI(.SEG,YSCLARR("PROVIDER_FIRST NAME"),12,3,1,1)
+35 DO SET^HLOAPI(.SEG,"NPI",12,13,1,1)
+36 if '$$ADDSEG^HLOAPI(.HLMSTATE,.SEG)
QUIT
+37 ;
+38 ; create RXE segment
+39 DO SET^HLOAPI(.SEG,"RXE",0)
+40 ; give code for drug
+41 DO SET^HLOAPI(.SEG,YSCLARR("MED_DRUG NDC"),2,4)
+42 DO SET^HLOAPI(.SEG,YSCLARR("MED_DRUG NAME"),2,5)
+43 DO SET^HLOAPI(.SEG,"NDC",2,6)
+44 DO SET^HLOAPI(.SEG,YSCLARR("MED_DOSE"),3)
+45 ; units value is hard coded, should we replace it from VistA?
DO SET^HLOAPI(.SEG,"MG",5,1)
+46 ; If override code is a 9, append the Prescriber-approved code
+47 IF YSCLARR("MED_REASON CODE")=9
SET YSCLARR("MED_REASON CODE")=YSCLARR("MED_REASON CODE")_$GET(YSCLARR("MED_ALTERNATE REASON CODE"))
+48 DO SET^HLOAPI(.SEG,YSCLARR("MED_REASON CODE"),7,1)
+49 DO SET^HLOAPI(.SEG,YSCLARR("MED_REASON TEXT"),7,2)
+50 DO SET^HLOAPI(.SEG,YSCLARR("MED_ALTERNATE REASON CODE"),7,4)
+51 DO SET^HLOAPI(.SEG,YSCLARR("MED_ALTERNATE REASON TEXT"),7,5)
+52 DO SET^HLOAPI(.SEG,YSCLARR("DISPQTY"),10,1)
+53 DO SET^HLOAPI(.SEG,YSCLARR("DISPQTYUNIT"),11,2)
+54 ;
+55 DO SET^HLOAPI(.SEG,YSCLARR("MED_APPROVING PROVIDER DEA"),14,1,1,1)
+56 DO SET^HLOAPI(.SEG,YSCLARR("MED_APPROVING PROVIDER IEN"),14,1,1,2)
+57 DO SET^HLOAPI(.SEG,"DEA",14,13,1,1)
+58 ;ajf ; adding approving provider
+59 DO SET^HLOAPI(.SEG,YSCLARR("MED_APPROVING PROVIDER_LAST NAME"),14,2,1,1)
+60 DO SET^HLOAPI(.SEG,YSCLARR("MED_APPROVING PROVIDER_FIRST NAME"),14,3,1,1)
+61 DO SET^HLOAPI(.SEG,"PN",14,13,1,2)
+62 DO SET^HLOAPI(.SEG,YSCLARR("MED_RX#/ORDER#"),15,1)
+63 DO SET^HLOAPI(.SEG,YSCLARR("SITE_PHARMACY NCPDP"),40,1)
+64 ;
+65 if '$$ADDSEG^HLOAPI(.HLMSTATE,.SEG)
QUIT
+66 ;
+67 ; create TQ1 segment(s)
+68 DO SET^HLOAPI(.SEG,"TQ1",0)
+69 DO SET^HLOAPI(.SEG,"1",1,1)
+70 ; Use drug file dosage if available
+71 IF $GET(YSCLARR("DISPAMT"))
Begin DoDot:1
+72 DO SET^HLOAPI(.SEG,YSCLARR("DISPAMT"),2,1)
+73 DO SET^HLOAPI(.SEG,$GET(YSCLARR("DISPUNIT")),2,2,1)
End DoDot:1
+74 IF '$GET(YSCLARR("DISPAMT"))
Begin DoDot:1
+75 DO SET^HLOAPI(.SEG,YSCLARR("MED_DOSE"),2,1)
+76 DO SET^HLOAPI(.SEG,"MG",2,2,1)
End DoDot:1
+77 if '$$ADDSEG^HLOAPI(.HLMSTATE,.SEG)
QUIT
+78 ;
+79 ; create RXR segment for route
+80 DO SET^HLOAPI(.SEG,"RXR",0)
+81 DO SET^HLOAPI(.SEG,"PO",1,1)
+82 DO SET^HLOAPI(.SEG,"ORAL",1,2)
+83 DO SET^HLOAPI(.SEG,"HL70162",1,3)
+84 if '$$ADDSEG^HLOAPI(.HLMSTATE,.SEG)
QUIT
+85 ;
+86 SET APPARMS("SENDING APPLICATION")="YSCL-REG-SEND"
+87 SET APPARMS("ACCEPT ACK TYPE")="AL"
+88 SET APPARMS("APP ACK TYPE")="NE"
+89 ; temporary until COMMIT ack needed
SET APPARMS("ACCEPT ACK RESPONSE")="COMTRESP^YSCLHLRD"
+90 ; temporary until APP ack needed
SET APPARMS("APP ACK RESPONSE")="APPRESP^YSCLHLRD"
+91 SET YSCLDEST="YSCL-REG-REC"
+92 SET WHO("RECEIVING APPLICATION")=YSCLDEST
+93 SET WHO("FACILITY LINK NAME")="YSCL-NCCC"
+94 ;
+95 SET HL7RES=$$SENDONE^HLOAPI1(.HLMSTATE,.APPARMS,.WHO,.ERROR)
+96 ; log error (D ^XTER) and continue
IF 'HL7RES
DO APPERROR^%ZTER("HLO error sending ClozMod RDE^O11")
+97 ; leave code for future developers
+98 ;D:'$G(YSILENT) ; write messages
+99 ;. W:HL7RES !,"RDE_O11 message IEN=",HL7RES," generated and sent to ",YSCLDEST,!
+100 ;. W:'HL7RES !,"Error: ",$G(ERROR),!," ","No RDE_O11 message sent!"
+101 ;
+102 QUIT HL7RES
+103 ;
COMTRESP ; process COMMIT ACCEPT ACK RESPONSE
+1 ;
+2 NEW COMTND,HDR,MSG,ND,RES
+3 IF $GET(HLMSGIEN)
SET RES=$$STARTMSG^HLOPRS(.MSG,HLMSGIEN,.HDR)
+4 SET COMTND=$$NOW^XLFDT+.00000001
SET ND=$$TMPND
+5 ; unique node per response
FOR
if '$DATA(^XTMP(ND,"COMTRESP",COMTND))
QUIT
SET COMTND=COMTND+.00000001
+6 SET ^XTMP(ND,"COMTRESP",COMTND,$JOB,"MSGIEN")="COMMIT ACK RESPONSE - COMTRESP^YSCLHLRD called! HLMSGIEN="_$GET(HLMSGIEN)
+7 SET ^XTMP(ND,"COMTRESP",COMTND,$JOB,"RES")=$GET(RES)
+8 MERGE ^XTMP(ND,"COMTRESP",COMTND,$JOB,"MSG")=MSG
+9 MERGE ^XTMP(ND,"COMTRESP",COMTND,$JOB,"HDR")=HDR
+10 DO XTMPZRO
+11 QUIT
+12 ;
APPRESP ; process ACCEPT ACK RESPONSE
+1 NEW APPND,ND
+2 SET APPND=$$NOW^XLFDT+.00000001
SET ND=$$TMPND
+3 ; unique node per response
FOR
if '$DATA(^XTMP(ND,"APPRESP",APPND))
QUIT
SET APPND=APPND+.00000001
+4 SET ^XTMP(ND,"APPRESP",APPND,$JOB)="APP ACK RESPONSE - APPRESP^YSCLHLRD called! HLMSGIEN="_$GET(HLMSGIEN)
+5 DO XTMPZRO
+6 QUIT
+7 ;
XTMPZRO ;set ^XTMP("YSCLHLRD "_DT), new zero node everyday
+1 ; 90 days in the future
NEW XPRVAL
SET XPRVAL=$$FMADD^XLFDT($$DT^XLFDT,90)
+2 SET $PIECE(XPRVAL,U,2)=$$NOW^XLFDT
SET $PIECE(XPRVAL,U,3)="CLOZAPINE HL7 (HLO) ACKS"
SET ^XTMP($$TMPND,0)=XPRVAL
+3 QUIT
+4 ;
TMPND() ; zero node for ^XTMP, space before the date
QUIT "YSCLHL7ACK "_DT
+1 ;
