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

YSCLHLRD.m

Go to the documentation of this file.
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
 ;