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

YSCLHLAD.m

Go to the documentation of this file.
  1. YSCLHLAD ;DSS/PO-CLOZAPINE DATA TRANSMISSION-Messaging-ADT ;19 May 2020 14:13:48
  1. ;;5.01;MENTAL HEALTH;**149**;Dec 30, 1994;Build 72
  1. Q
  1. ;
  1. ; Reference to ^%ZTER supported by DBIA #1621
  1. ; Reference to ^DICRW supported by DBIA #10005
  1. ; Reference to ^DIQ supported by DBIA #2056
  1. ; References to ^HLOAPI supported by DBIA #4716
  1. ; References to HLOAPI1 supported by DBIA #4717
  1. ;
  1. ADTA28(YSCLARR,YSILENT) ; Build and send registration message
  1. ; input: YSCLARR data array to build HL7 segments
  1. ;
  1. ; APPARMS - HLO application parameters
  1. ; HL - delimiters for HL7 utilities
  1. ; HL7RES - Hl7 send result, 0 if message not sent
  1. ; HLMSTATE - message state for HLO
  1. ; SEG - segment for HLO
  1. ; YSCLDEST - destination name for HLO
  1. ; YSHLERR - message creation error
  1. ; YSWHTO - destination for HLO
  1. ;
  1. N APPARMS,HL,HL7RES,HLMSTATE,SEG,YSCLDEST,YSHLERR,YSWHTO
  1. ;
  1. ; create message
  1. S APPARMS("MESSAGE TYPE")="ADT"
  1. S APPARMS("EVENT")="A28"
  1. S APPARMS("MESSAGE STRUCTURE")="ADT_A05"
  1. S APPARMS("VERSION")="2.5.1"
  1. I '$$NEWMSG^HLOAPI(.APPARMS,.HLMSTATE,.YSHLERR) U IO W !,$G(YSHLERR) Q
  1. ;
  1. ; create EVN segment
  1. D SET^HLOAPI(.SEG,"EVN",0)
  1. D SET^HLOAPI(.SEG,$$FMTHL7^XLFDT($$NOW^XLFDT),2)
  1. Q:'$$ADDSEG^HLOAPI(.HLMSTATE,.SEG)
  1. ;
  1. D PID^YSCLHLPD(.SEG,.YSCLARR) ;creat PID segment
  1. Q:'$$ADDSEG^HLOAPI(.HLMSTATE,.SEG)
  1. ;
  1. ; create ROL segment
  1. D SET^HLOAPI(.SEG,"ROL",0)
  1. D SET^HLOAPI(.SEG,"UP",2) ; update
  1. D SET^HLOAPI(.SEG,"PRX",3)
  1. D SET^HLOAPI(.SEG,"HL70443",3,3)
  1. D SET^HLOAPI(.SEG,"Prescribing Physician",3,2)
  1. ;
  1. D SET^HLOAPI(.SEG,YSCLARR("PROVIDER_DEA"),4,1,1,1)
  1. D SET^HLOAPI(.SEG,YSCLARR("PROVIDER_LAST NAME"),4,2,1,1)
  1. D SET^HLOAPI(.SEG,YSCLARR("PROVIDER_FIRST NAME"),4,3,1,1)
  1. D SET^HLOAPI(.SEG,"DEA",4,13,1,1)
  1. ;
  1. D SET^HLOAPI(.SEG,YSCLARR("PROVIDER_NPI"),4,1,1,2)
  1. D SET^HLOAPI(.SEG,YSCLARR("PROVIDER_LAST NAME"),4,2,1,2)
  1. D SET^HLOAPI(.SEG,YSCLARR("PROVIDER_FIRST NAME"),4,3,1,2)
  1. D SET^HLOAPI(.SEG,"NPI",4,13,1,2)
  1. Q:'$$ADDSEG^HLOAPI(.HLMSTATE,.SEG) ; "ROL" segment
  1. ;
  1. ; create PV1 segment
  1. D SET^HLOAPI(.SEG,"PV1",0)
  1. D SET^HLOAPI(.SEG,YSCLARR("PATIENT_INPAT/OUTPAT"),2)
  1. Q:'$$ADDSEG^HLOAPI(.HLMSTATE,.SEG) ; "PV1" segment
  1. ;
  1. ; create OBX segment for clozapine status
  1. D Q:'$$ADDSEG^HLOAPI(.HLMSTATE,.SEG) ;"OBX|1|..."
  1. . N SEGSEQ S SEGSEQ=1
  1. . D SET^HLOAPI(.SEG,"OBX",0)
  1. . D SET^HLOAPI(.SEG,SEGSEQ,1) ; sequence id
  1. . D SET^HLOAPI(.SEG,"CE",2) ; value type
  1. . D SET^HLOAPI(.SEG,"PTSTAT",3,2) ; observation ID
  1. . D SET^HLOAPI(.SEG,YSCLARR("PATIENT_CLOZ STATUS"),5) ; patient status
  1. . D SET^HLOAPI(.SEG,"F",11) ; observation result status - "F" means Final Results
  1. ;
  1. ; create OBX segment for dispense frequency
  1. D Q:'$$ADDSEG^HLOAPI(.HLMSTATE,.SEG) ;"OBX|2|..."
  1. . N SEGSEQ S SEGSEQ=2
  1. . D SET^HLOAPI(.SEG,"OBX",0)
  1. . D SET^HLOAPI(.SEG,SEGSEQ,1) ; sequence id
  1. . D SET^HLOAPI(.SEG,"CE",2) ; value type
  1. . D SET^HLOAPI(.SEG,"DISPENSE FREQUENCY",3,2) ; observation ID
  1. . D SET^HLOAPI(.SEG,YSCLARR("LAB_FREQ"),5) ;
  1. . D SET^HLOAPI(.SEG,"F",11) ; observation result status, "F" means Final Results
  1. . Q
  1. ;
  1. ; create OBX segment for WBC
  1. D Q:'$$ADDSEG^HLOAPI(.HLMSTATE,.SEG) ;"OBX|3|..."
  1. . N SEGSEQ S SEGSEQ=3
  1. . D SET^HLOAPI(.SEG,"OBX",0)
  1. . D SET^HLOAPI(.SEG,SEGSEQ,1) ; sequence ID
  1. . D SET^HLOAPI(.SEG,"CE",2) ; value type
  1. . D SET^HLOAPI(.SEG,"WBC",3,2) ; observation ID
  1. . D SET^HLOAPI(.SEG,YSCLARR("LAB_WBC VAL"),5) ; WBC value
  1. . D SET^HLOAPI(.SEG,"F",11) ; observation result status, "F" means Final Results
  1. . ;ajf ; Don't set date if wbc value is null
  1. . I $G(YSCLARR("LAB_WBC VAL")) D SET^HLOAPI(.SEG,YSCLARR("LAB_COLLECTION DATE"),14)
  1. ; create OBX segment for ANC
  1. D Q:'$$ADDSEG^HLOAPI(.HLMSTATE,.SEG) ;"OBX|4|..."
  1. . N SEGSEQ S SEGSEQ=4
  1. . D SET^HLOAPI(.SEG,"OBX",0)
  1. . D SET^HLOAPI(.SEG,SEGSEQ,1) ; sequence ID
  1. . D SET^HLOAPI(.SEG,"CE",2) ; value type
  1. . D SET^HLOAPI(.SEG,"ANC",3,2) ; observation ID ;???PVZ should it come form LABSTR e.g. "ABS NEUT"
  1. . D SET^HLOAPI(.SEG,YSCLARR("LAB_ANC VAL"),5)
  1. . D SET^HLOAPI(.SEG,"F",11) ; observation result status - "F" means Final Results
  1. . ;ajf ; Don't set date if ANC value is null
  1. . I $G(YSCLARR("LAB_ANC VAL")) D SET^HLOAPI(.SEG,YSCLARR("LAB_COLLECTION DATE"),14)
  1. ;
  1. ; create OBX segment for site DEA number
  1. D Q:'$$ADDSEG^HLOAPI(.HLMSTATE,.SEG) ;"OBX|5|..."
  1. . N SEGSEQ S SEGSEQ=5
  1. . N SITEDEA S SITEDEA=$$GET1^DIQ(4,YSCLARR("PROVIDER_DEFAULT DIV."),52)
  1. . D SET^HLOAPI(.SEG,"OBX",0)
  1. . D SET^HLOAPI(.SEG,SEGSEQ,1) ; sequence ID
  1. . D SET^HLOAPI(.SEG,"CE",2) ; value type
  1. . D SET^HLOAPI(.SEG,"Facility DEA number",3,2) ; observation ID
  1. . D SET^HLOAPI(.SEG,YSCLARR("SITE_SITE DEA"),5) ; facility DEA number
  1. . D SET^HLOAPI(.SEG,"F",11) ; observation result status - "F" means Final
  1. ;
  1. D Q:'$$ADDSEG^HLOAPI(.HLMSTATE,.SEG) ;"OBX|6|..."
  1. . N SEGSEQ S SEGSEQ=6
  1. . D SET^HLOAPI(.SEG,"OBX",0)
  1. . D SET^HLOAPI(.SEG,SEGSEQ,1) ; sequence id
  1. . D SET^HLOAPI(.SEG,"CE",2) ; value type
  1. . D SET^HLOAPI(.SEG,"SITELOC",3,2) ; observation ID
  1. . D SET^HLOAPI(.SEG,YSCLARR("SITE_ID"),5) ; site ID (division)
  1. . D SET^HLOAPI(.SEG,"F",11) ; observation result status - "F" means Final
  1. . D SET^HLOAPI(.SEG,YSCLARR("SITE_SITE NAME"),23)
  1. . D SET^HLOAPI(.SEG,YSCLARR("SITE_STATION"),23,10)
  1. . D SET^HLOAPI(.SEG,YSCLARR("SITE_STREET ADDR 1"),24,1)
  1. . D SET^HLOAPI(.SEG,YSCLARR("SITE_STREET ADDR 2"),24,2)
  1. . D SET^HLOAPI(.SEG,YSCLARR("SITE_CITY"),24,3)
  1. . D SET^HLOAPI(.SEG,YSCLARR("SITE_STATE"),24,4)
  1. . D SET^HLOAPI(.SEG,YSCLARR("SITE_ZIP"),24,5)
  1. ;
  1. S APPARMS("SENDING APPLICATION")="YSCL-REG-SEND"
  1. S APPARMS("ACCEPT ACK TYPE")="AL"
  1. S APPARMS("APP ACK TYPE")="NE"
  1. S APPARMS("ACCEPT ACK RESPONSE")="COMTRESP^YSCLHLAD" ; temporary to see how COMMIT ack works
  1. S APPARMS("APP ACK RESPONSE")="APPRESP^YSCLHLAD" ; temporary to see how APP ack works
  1. S YSCLDEST="YSCL-REG-REC"
  1. S YSWHTO("RECEIVING APPLICATION")=YSCLDEST
  1. S YSWHTO("FACILITY LINK NAME")="YSCL-NCCC"
  1. S HL7RES=$$SENDONE^HLOAPI1(.HLMSTATE,.APPARMS,.YSWHTO,.YSHLERR)
  1. I 'HL7RES D APPERROR^%ZTER("HLO error sending ClozMod ADT^AD8") ; log error (D ^XTER) and continue
  1. ; leave code for future developers
  1. ;D:'$G(YSILENT)
  1. ;. W:HL7RES !,"ADT A05 message IEN=",HL7RES," generated and sent to ",YSCLDEST,!
  1. ;. W:'HL7RES !,"Error: ",$G(YSHLERR),!," No ADT A05 message sent!"
  1. ;
  1. Q HL7RES
  1. ;
  1. COMTRESP ; process COMMIT ACCEPT ACK RESPONSE
  1. ;
  1. D DT^DICRW N HDR,MSG,RES,RTNOW,YSXTMP
  1. S YSXTMP("1stNode")=$T(+0)_" "_DT ; first storage node in ^XTMP
  1. S RES=$$STARTMSG^HLOPRS(.MSG,HLMSGIEN,.HDR)
  1. S RTNOW=$$NOW^XLFDT
  1. S ^XTMP(YSXTMP("1stNode"),"COMTRESP",RTNOW,$J,"MSGIEN")=$G(HLMSGIEN)
  1. S ^XTMP(YSXTMP("1stNode"),"COMTRESP",RTNOW,$J,"RES")=RES
  1. M ^XTMP(YSXTMP("1stNode"),"COMTRESP",RTNOW,$J,"MSG")=MSG
  1. M ^XTMP(YSXTMP("1stNode"),"COMTRESP",RTNOW,$J,"HDR")=HDR
  1. ; expires in 30 days
  1. S ^XTMP(YSXTMP("1stNode"),0)=$$HTFM^XLFDT($H+30)_U_DT_U_"YSCL* HL7 RESPONSE"
  1. Q
  1. ;
  1. APPRESP ; process ACCEPT ACK RESPONSE
  1. ;
  1. N MSGIEN,RTNOW,VAR,YSXTMP
  1. S YSXTMP("1stNode")=$T(+0)_" "_DT ; first storage node in ^XTMP
  1. S RTNOW=$$NOW^XLFDT,MSGIEN=+$G(HLMSGIEN)
  1. S ^XTMP(YSXTMP("1stNode"),"APPRESP",RTNOW,MSGIEN,$J)="APP ACK RESPONSE"
  1. S VAR="HL" F S VAR=$O(@VAR) Q:'($E(VAR,1,2)="HL") M ^XTMP(YSXTMP("1stNode"),"APPRESP",RTNOW,MSGIEN,$J,VAR)=@VAR
  1. ; expires in 30 days
  1. S ^XTMP(YSXTMP("1stNode"),0)=$$HTFM^XLFDT($H+30)_U_DT_U_"YSCL* HL7 RESPONSE"
  1. Q
  1. ;