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

XUOAAHL7.m

Go to the documentation of this file.
  1. XUOAAHL7 ;OAKCIOFO/JLG - Clinical Trainee HL7 Msg Routine;8:06 AM 22 Mar 2005
  1. ;;8.0;KERNEL;**251,324,344**;Jul 10, 1995
  1. ;
  1. OAA ; entry point for the scheduled option [XUOAA SEND HL7 MESSAGE]
  1. ; This routine generates an HL7 PMU message, Update Personnel Record,
  1. ; based on data pointed by the ^VA(200,"ATR",ien) cross-reference.
  1. ; The type of message is PMU~B02 with the following structure:
  1. ; MSH,EVN,STF,PRA,ORG,EDU
  1. ; The data generated for the STF,PRA,ORG, and EDU are not repeating.
  1. ;
  1. ; Input:
  1. ; MSGID (required) Pass by reference
  1. ; ERROR (required) Pass by reference
  1. ;
  1. ; Output:
  1. ; MSGID The message id assigned to the message when the call
  1. ; succeeds; null when call does not succeed.
  1. ; ERROR 0 if call succeeds.
  1. ; "1^description of error" if call fails
  1. ;
  1. ; Pre-conditions:
  1. ; - ^VA(200,"ATR") exists
  1. ; - XUOAA PMU event protocol and XUOAA ACK subscriber protocols are
  1. ; active.
  1. ; Postcondition:
  1. ; - An HL7 PMU-B02 message is queued for transmission.
  1. ; - the ^VA(200,"ATR") x-reference is killed when queueing is
  1. ; successful; otherwise, it is left intact for next attempt.
  1. ;
  1. N CNT,CS,ERROR,FS,INDX,RESULT,SS,TOTAL,XUCNT,XUHLDT,XUHLDT1,XUHLMID
  1. N XUMTIEN,XUOAA,XUOAAHL
  1. S TOTAL=0
  1. LOOP1 ; Generate batch messages of 100 messages long
  1. I '$D(^VA(200,"ATR")) D MAIL Q ;No "ATR" xref
  1. K ^TMP("HLS",$J),XUOAA
  1. S (INDX,XUOAA,CNT,ERROR)=0
  1. D INIT Q:ERROR
  1. D STUB Q:ERROR ; create msg stub (batch)
  1. ; iterate over list of entries (100 max) and build batch message
  1. F S INDX=$O(^VA(200,"ATR",INDX)) Q:'INDX!(XUOAA>99) D
  1. . L +^VA(200,INDX):30 Q:'$T
  1. . S XUOAA=XUOAA+1 ; message count in batch
  1. . ; temporary array to keep track of entries
  1. . S XUOAA(INDX)=$G(^VA(200,"ATR",INDX)) ; date/time recorded
  1. . D BLDMSG(INDX) ; build message for this entry
  1. . K ^VA(200,"ATR",INDX)
  1. . S TOTAL=TOTAL+1
  1. . L -^VA(200,INDX)
  1. D SEND
  1. I ERROR D RESTORE,STORENV Q
  1. I XUOAA>99 G LOOP1 ; more than 100 entries, create another batch
  1. K ^TMP("HLS",$J),XUOAA
  1. D MAIL
  1. Q
  1. ;
  1. INIT ; initialize HL variables
  1. ; "XUOAA PMU"=event protocol, XUOAAHL=hl variables
  1. ; checks for valid event protocol
  1. D INIT^HLFNC2("XUOAA PMU",.XUOAAHL)
  1. I $G(XUOAAHL) S ERROR="1^"_$P(XUOAAHL,U,2) Q
  1. S FS=$G(XUOAAHL("FS")) ;field separator
  1. S CS=$E(XUOAAHL("ECH"),1) ;component separator
  1. S SS=$E(XUOAAHL("ECH"),4) ;sub-component separator
  1. Q
  1. ;
  1. STUB ; create msg stub for batch msg
  1. ; XUHLMID=batch msg id, XUMTIEN=file 772 ien
  1. ; XUHLDT=FM date/time, XUHLDT1=HL7 date/time
  1. D CREATE^HLTF(.XUHLMID,.XUMTIEN,.XUHLDT,.XUHLDT1)
  1. I 'XUHLMID S ERROR="1^could not create msg stub" Q
  1. Q
  1. ;
  1. BLDMSG(IEN) ;
  1. N ADDR,CITY,DEGLEV,DOB,EMAIL,ENTERDT,FACILITY,GEOLOC,IFN
  1. N LASTYR,MSGHDR,NAME,PROGSTD,RECORDT,SERVICE,SSN,STATE,STREET,TERMDT
  1. N TITLE,ZIP,XUNAME,VHATF,X,Y
  1. Q:'IEN
  1. ; extract data from Fileman and transform to HL7 datatype
  1. S XUNAME("FILE")=200,XUNAME("FIELD")=.01,XUNAME("IENS")=IEN
  1. S NAME=$$HLNAME^XLFNAME(.XUNAME,"S",CS)
  1. S STREET=$$GET1^DIQ(200,IEN,"STREET ADDRESS 1")
  1. S STREET=STREET_U_$$GET1^DIQ(200,IEN,"STREET ADDRESS 2")
  1. S STREET=STREET_U_$$GET1^DIQ(200,IEN,"STREET ADDRESS 3")
  1. S CITY=$$GET1^DIQ(200,IEN,"CITY")
  1. S STATE=$$GET1^DIQ(200,IEN,"STATE","I")
  1. S ZIP=$$GET1^DIQ(200,IEN,"ZIP CODE")
  1. S GEOLOC=CITY_U_STATE_U_ZIP_U_"USA"
  1. S ADDR=$$HLADDR^HLFNC(STREET,GEOLOC)
  1. S SSN=$$GET1^DIQ(200,IEN,"SSN")
  1. S SSN=SSN_CS_CS_CS_"USSSA"_CS_"SS"
  1. S EMAIL=$$GET1^DIQ(200,IEN,"EMAIL ADDRESS")
  1. S DEGLEV=$$GET1^DIQ(200,IEN,"CURRENT DEGREE LEVEL:ABBREVIATION")
  1. S PROGSTD=$$GET1^DIQ(200,IEN,"PROGRAM OF STUDY")
  1. S LASTYR=$$GET1^DIQ(200,IEN,"LAST TRAINING MONTH & YEAR")
  1. D
  1. . N %DT
  1. . S X=LASTYR,%DT="M"
  1. . D ^%DT
  1. . Q
  1. S LASTYR=$$FMTHL7^XLFDT(Y)
  1. S SERVICE=$$GET1^DIQ(200,IEN,"SERVICE/SECTION")
  1. S SERVICE=SERVICE_CS_CS_"SERVICE/SECTION"
  1. S TERMDT=$$GET1^DIQ(200,IEN,"DATE NO LONGER TRAINEE","I")
  1. S TERMDT=$$FMTHL7^XLFDT(TERMDT)
  1. S:'TERMDT TERMDT=""
  1. S TITLE=$$GET1^DIQ(200,IEN,"TITLE")
  1. S ENTERDT=$$GET1^DIQ(200,IEN,"START OF TRAINING","I")
  1. S ENTERDT=$$FMTHL7^XLFDT(ENTERDT)
  1. S:'ENTERDT ENTERDT=""
  1. ; date recorded
  1. S RECORDT=$$FMTHL7^XLFDT($G(XUOAA(IEN)))
  1. S FACILITY=$$NS^XUAF4($$KSP^XUPARAM("INST"))
  1. S FACILITY=$P(FACILITY,U,2)_CS_$P(FACILITY,U)
  1. D
  1. . S VHATF=+$$GET1^DIQ(200,IEN,"VHA TRAINING FACILITY","I")
  1. . I VHATF<1 S VHATF="^" Q ;Both pieces Null
  1. . I VHATF>0 S VHATF=$$NS^XUAF4(VHATF)
  1. . Q
  1. S VHATF=$P(VHATF,U,2)_CS_$P(VHATF,U)
  1. ; IFN= internal file number
  1. S IFN=IEN_CS_"IEN"_CS_"NEW PERSON"
  1. S DOB=$$GET1^DIQ(200,IEN,"DOB","I")
  1. S DOB=$$FMTHL7^XLFDT(DOB)
  1. ; create msg header per entry
  1. ; XUOAAHL=hl array from INIT, XUHLMID=batch msg id from STUB
  1. ; XUOAA=message count, MSGHDR=message header
  1. D MSH^HLFNC2(.XUOAAHL,XUHLMID_"-"_XUOAA,.MSGHDR)
  1. ; build temporary MSG TEXT array
  1. S CNT=CNT+1
  1. S ^TMP("HLS",$J,CNT)=MSGHDR
  1. S CNT=CNT+1
  1. S ^TMP("HLS",$J,CNT)="EVN"_FS_XUOAAHL("ETN")_FS_RECORDT_FS_FS_FS_FS_FS_FACILITY
  1. S CNT=CNT+1
  1. S ^TMP("HLS",$J,CNT)="STF"_FS_IFN_FS_SSN_FS_NAME_FS_FS_FS_DOB_FS_FS_FS_SERVICE_FS_FS_ADDR_FS_FS_FS_FS_EMAIL_FS_FS_FS_TITLE
  1. S CNT=CNT+1
  1. S ^TMP("HLS",$J,CNT)="PRA"_FS_FS_FS_"OAA"_FS_FS_PROGSTD_CS_CS_CS_CS_LASTYR
  1. S CNT=CNT+1
  1. S ^TMP("HLS",$J,CNT)="ORG"_FS_1_FS_VHATF_FS_SERVICE_FS_FS_FS_FS_FS_CS_PROGSTD_CS_"PROGRAM OF STUDY"_FS_ENTERDT_CS_TERMDT
  1. S CNT=CNT+1
  1. S ^TMP("HLS",$J,CNT)="EDU"_FS_"1"_FS_DEGLEV
  1. D
  1. . ; Update Trainee's Date Transmitted to OAA
  1. . N DIERR,ZERR,FDA
  1. . S FDA(200,$S(IEN[",":IEN,1:IEN_","),12.5)=DT
  1. . D FILE^DIE("I","FDA","ZERR")
  1. Q
  1. ;
  1. SEND ; send complete batch message
  1. ; "XUOAA PMU"=event protocol, LB=batch array type
  1. ; RESULT="msgid^error code^error msg" , XUMTIEN=file 772 ien from STUB
  1. D GENERATE^HLMA("XUOAA PMU","GB",1,.RESULT,XUMTIEN)
  1. I +$P(RESULT,U,2) D Q
  1. . S ERROR="1^"_$P(RESULT,U,3)
  1. S MSGID=+RESULT
  1. Q
  1. ;
  1. RESTORE ; message could not be sent, restore x-ref
  1. S INDX=0 F S INDX=$O(XUOAA(INDX)) Q:'INDX D
  1. . S ^VA(200,"ATR",INDX)=$G(XUOAA(INDX))
  1. Q
  1. ;
  1. RECACK ; receive application acknoledgement from HL7
  1. I $G(HL("ACKCD"))'="AA" D
  1. . D STORENV("RECACK")
  1. Q
  1. ;
  1. STORENV ; store environmental variables for logging purposes
  1. N APP,XTMP,X
  1. S APP="Clinical Trainee Core Dataset",XTMP="XUOAA"_DT
  1. S ^XTMP(XTMP,0)=$$FMADD^XLFDT(DT,14)_U_$$NOW^XLFDT_U_APP
  1. S X="^XTMP("""_XTMP_""","
  1. D DOLRO^%ZOSV
  1. Q
  1. ;
  1. MAIL ;Send mail message to G.XUOAA CLIN TRAINEE TRANS
  1. N LN,MSGTXT,MSGSBJ
  1. S LN=1
  1. S MSGSBJ="Clinical Trainee Transmission Count"
  1. S MSGTXT=""
  1. S MSGTXT(LN)=" ",LN=LN+1
  1. S MSGTXT(LN)="Number of trainees transmitted to OAA: "_TOTAL
  1. ;Check to see if Mail Group has members
  1. I '$$GOTLOCAL^XMXAPIG("XUOAA CLIN TRAINEE TRANS") D SENDMSG^XMXAPI(DUZ,MSGSBJ,"MTEXT",DUZ) Q
  1. ; Mail Group Has Memebers so send the message
  1. D SENDMSG^XMXAPI(DUZ,MSGSBJ,"MSGTXT","G.XUOAA CLIN TRAINEE TRANS")
  1. Q