XUOAAHL7 ;OAKCIOFO/JLG - Clinical Trainee HL7 Msg Routine;8:06 AM 22 Mar 2005
;;8.0;KERNEL;**251,324,344**;Jul 10, 1995
;
OAA ; entry point for the scheduled option [XUOAA SEND HL7 MESSAGE]
; This routine generates an HL7 PMU message, Update Personnel Record,
; based on data pointed by the ^VA(200,"ATR",ien) cross-reference.
; The type of message is PMU~B02 with the following structure:
; MSH,EVN,STF,PRA,ORG,EDU
; The data generated for the STF,PRA,ORG, and EDU are not repeating.
;
; Input:
; MSGID (required) Pass by reference
; ERROR (required) Pass by reference
;
; Output:
; MSGID The message id assigned to the message when the call
; succeeds; null when call does not succeed.
; ERROR 0 if call succeeds.
; "1^description of error" if call fails
;
; Pre-conditions:
; - ^VA(200,"ATR") exists
; - XUOAA PMU event protocol and XUOAA ACK subscriber protocols are
; active.
; Postcondition:
; - An HL7 PMU-B02 message is queued for transmission.
; - the ^VA(200,"ATR") x-reference is killed when queueing is
; successful; otherwise, it is left intact for next attempt.
;
N CNT,CS,ERROR,FS,INDX,RESULT,SS,TOTAL,XUCNT,XUHLDT,XUHLDT1,XUHLMID
N XUMTIEN,XUOAA,XUOAAHL
S TOTAL=0
LOOP1 ; Generate batch messages of 100 messages long
I '$D(^VA(200,"ATR")) D MAIL Q ;No "ATR" xref
K ^TMP("HLS",$J),XUOAA
S (INDX,XUOAA,CNT,ERROR)=0
D INIT Q:ERROR
D STUB Q:ERROR ; create msg stub (batch)
; iterate over list of entries (100 max) and build batch message
F S INDX=$O(^VA(200,"ATR",INDX)) Q:'INDX!(XUOAA>99) D
. L +^VA(200,INDX):30 Q:'$T
. S XUOAA=XUOAA+1 ; message count in batch
. ; temporary array to keep track of entries
. S XUOAA(INDX)=$G(^VA(200,"ATR",INDX)) ; date/time recorded
. D BLDMSG(INDX) ; build message for this entry
. K ^VA(200,"ATR",INDX)
. S TOTAL=TOTAL+1
. L -^VA(200,INDX)
D SEND
I ERROR D RESTORE,STORENV Q
I XUOAA>99 G LOOP1 ; more than 100 entries, create another batch
K ^TMP("HLS",$J),XUOAA
D MAIL
Q
;
INIT ; initialize HL variables
; "XUOAA PMU"=event protocol, XUOAAHL=hl variables
; checks for valid event protocol
D INIT^HLFNC2("XUOAA PMU",.XUOAAHL)
I $G(XUOAAHL) S ERROR="1^"_$P(XUOAAHL,U,2) Q
S FS=$G(XUOAAHL("FS")) ;field separator
S CS=$E(XUOAAHL("ECH"),1) ;component separator
S SS=$E(XUOAAHL("ECH"),4) ;sub-component separator
Q
;
STUB ; create msg stub for batch msg
; XUHLMID=batch msg id, XUMTIEN=file 772 ien
; XUHLDT=FM date/time, XUHLDT1=HL7 date/time
D CREATE^HLTF(.XUHLMID,.XUMTIEN,.XUHLDT,.XUHLDT1)
I 'XUHLMID S ERROR="1^could not create msg stub" Q
Q
;
BLDMSG(IEN) ;
N ADDR,CITY,DEGLEV,DOB,EMAIL,ENTERDT,FACILITY,GEOLOC,IFN
N LASTYR,MSGHDR,NAME,PROGSTD,RECORDT,SERVICE,SSN,STATE,STREET,TERMDT
N TITLE,ZIP,XUNAME,VHATF,X,Y
Q:'IEN
; extract data from Fileman and transform to HL7 datatype
S XUNAME("FILE")=200,XUNAME("FIELD")=.01,XUNAME("IENS")=IEN
S NAME=$$HLNAME^XLFNAME(.XUNAME,"S",CS)
S STREET=$$GET1^DIQ(200,IEN,"STREET ADDRESS 1")
S STREET=STREET_U_$$GET1^DIQ(200,IEN,"STREET ADDRESS 2")
S STREET=STREET_U_$$GET1^DIQ(200,IEN,"STREET ADDRESS 3")
S CITY=$$GET1^DIQ(200,IEN,"CITY")
S STATE=$$GET1^DIQ(200,IEN,"STATE","I")
S ZIP=$$GET1^DIQ(200,IEN,"ZIP CODE")
S GEOLOC=CITY_U_STATE_U_ZIP_U_"USA"
S ADDR=$$HLADDR^HLFNC(STREET,GEOLOC)
S SSN=$$GET1^DIQ(200,IEN,"SSN")
S SSN=SSN_CS_CS_CS_"USSSA"_CS_"SS"
S EMAIL=$$GET1^DIQ(200,IEN,"EMAIL ADDRESS")
S DEGLEV=$$GET1^DIQ(200,IEN,"CURRENT DEGREE LEVEL:ABBREVIATION")
S PROGSTD=$$GET1^DIQ(200,IEN,"PROGRAM OF STUDY")
S LASTYR=$$GET1^DIQ(200,IEN,"LAST TRAINING MONTH & YEAR")
D
. N %DT
. S X=LASTYR,%DT="M"
. D ^%DT
. Q
S LASTYR=$$FMTHL7^XLFDT(Y)
S SERVICE=$$GET1^DIQ(200,IEN,"SERVICE/SECTION")
S SERVICE=SERVICE_CS_CS_"SERVICE/SECTION"
S TERMDT=$$GET1^DIQ(200,IEN,"DATE NO LONGER TRAINEE","I")
S TERMDT=$$FMTHL7^XLFDT(TERMDT)
S:'TERMDT TERMDT=""
S TITLE=$$GET1^DIQ(200,IEN,"TITLE")
S ENTERDT=$$GET1^DIQ(200,IEN,"START OF TRAINING","I")
S ENTERDT=$$FMTHL7^XLFDT(ENTERDT)
S:'ENTERDT ENTERDT=""
; date recorded
S RECORDT=$$FMTHL7^XLFDT($G(XUOAA(IEN)))
S FACILITY=$$NS^XUAF4($$KSP^XUPARAM("INST"))
S FACILITY=$P(FACILITY,U,2)_CS_$P(FACILITY,U)
D
. S VHATF=+$$GET1^DIQ(200,IEN,"VHA TRAINING FACILITY","I")
. I VHATF<1 S VHATF="^" Q ;Both pieces Null
. I VHATF>0 S VHATF=$$NS^XUAF4(VHATF)
. Q
S VHATF=$P(VHATF,U,2)_CS_$P(VHATF,U)
; IFN= internal file number
S IFN=IEN_CS_"IEN"_CS_"NEW PERSON"
S DOB=$$GET1^DIQ(200,IEN,"DOB","I")
S DOB=$$FMTHL7^XLFDT(DOB)
; create msg header per entry
; XUOAAHL=hl array from INIT, XUHLMID=batch msg id from STUB
; XUOAA=message count, MSGHDR=message header
D MSH^HLFNC2(.XUOAAHL,XUHLMID_"-"_XUOAA,.MSGHDR)
; build temporary MSG TEXT array
S CNT=CNT+1
S ^TMP("HLS",$J,CNT)=MSGHDR
S CNT=CNT+1
S ^TMP("HLS",$J,CNT)="EVN"_FS_XUOAAHL("ETN")_FS_RECORDT_FS_FS_FS_FS_FS_FACILITY
S CNT=CNT+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
S CNT=CNT+1
S ^TMP("HLS",$J,CNT)="PRA"_FS_FS_FS_"OAA"_FS_FS_PROGSTD_CS_CS_CS_CS_LASTYR
S CNT=CNT+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
S CNT=CNT+1
S ^TMP("HLS",$J,CNT)="EDU"_FS_"1"_FS_DEGLEV
D
. ; Update Trainee's Date Transmitted to OAA
. N DIERR,ZERR,FDA
. S FDA(200,$S(IEN[",":IEN,1:IEN_","),12.5)=DT
. D FILE^DIE("I","FDA","ZERR")
Q
;
SEND ; send complete batch message
; "XUOAA PMU"=event protocol, LB=batch array type
; RESULT="msgid^error code^error msg" , XUMTIEN=file 772 ien from STUB
D GENERATE^HLMA("XUOAA PMU","GB",1,.RESULT,XUMTIEN)
I +$P(RESULT,U,2) D Q
. S ERROR="1^"_$P(RESULT,U,3)
S MSGID=+RESULT
Q
;
RESTORE ; message could not be sent, restore x-ref
S INDX=0 F S INDX=$O(XUOAA(INDX)) Q:'INDX D
. S ^VA(200,"ATR",INDX)=$G(XUOAA(INDX))
Q
;
RECACK ; receive application acknoledgement from HL7
I $G(HL("ACKCD"))'="AA" D
. D STORENV("RECACK")
Q
;
STORENV ; store environmental variables for logging purposes
N APP,XTMP,X
S APP="Clinical Trainee Core Dataset",XTMP="XUOAA"_DT
S ^XTMP(XTMP,0)=$$FMADD^XLFDT(DT,14)_U_$$NOW^XLFDT_U_APP
S X="^XTMP("""_XTMP_""","
D DOLRO^%ZOSV
Q
;
MAIL ;Send mail message to G.XUOAA CLIN TRAINEE TRANS
N LN,MSGTXT,MSGSBJ
S LN=1
S MSGSBJ="Clinical Trainee Transmission Count"
S MSGTXT=""
S MSGTXT(LN)=" ",LN=LN+1
S MSGTXT(LN)="Number of trainees transmitted to OAA: "_TOTAL
;Check to see if Mail Group has members
I '$$GOTLOCAL^XMXAPIG("XUOAA CLIN TRAINEE TRANS") D SENDMSG^XMXAPI(DUZ,MSGSBJ,"MTEXT",DUZ) Q
; Mail Group Has Memebers so send the message
D SENDMSG^XMXAPI(DUZ,MSGSBJ,"MSGTXT","G.XUOAA CLIN TRAINEE TRANS")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUOAAHL7 6924 printed Sep 23, 2025@19:47:36 Page 2
XUOAAHL7 ;OAKCIOFO/JLG - Clinical Trainee HL7 Msg Routine;8:06 AM 22 Mar 2005
+1 ;;8.0;KERNEL;**251,324,344**;Jul 10, 1995
+2 ;
OAA ; entry point for the scheduled option [XUOAA SEND HL7 MESSAGE]
+1 ; This routine generates an HL7 PMU message, Update Personnel Record,
+2 ; based on data pointed by the ^VA(200,"ATR",ien) cross-reference.
+3 ; The type of message is PMU~B02 with the following structure:
+4 ; MSH,EVN,STF,PRA,ORG,EDU
+5 ; The data generated for the STF,PRA,ORG, and EDU are not repeating.
+6 ;
+7 ; Input:
+8 ; MSGID (required) Pass by reference
+9 ; ERROR (required) Pass by reference
+10 ;
+11 ; Output:
+12 ; MSGID The message id assigned to the message when the call
+13 ; succeeds; null when call does not succeed.
+14 ; ERROR 0 if call succeeds.
+15 ; "1^description of error" if call fails
+16 ;
+17 ; Pre-conditions:
+18 ; - ^VA(200,"ATR") exists
+19 ; - XUOAA PMU event protocol and XUOAA ACK subscriber protocols are
+20 ; active.
+21 ; Postcondition:
+22 ; - An HL7 PMU-B02 message is queued for transmission.
+23 ; - the ^VA(200,"ATR") x-reference is killed when queueing is
+24 ; successful; otherwise, it is left intact for next attempt.
+25 ;
+26 NEW CNT,CS,ERROR,FS,INDX,RESULT,SS,TOTAL,XUCNT,XUHLDT,XUHLDT1,XUHLMID
+27 NEW XUMTIEN,XUOAA,XUOAAHL
+28 SET TOTAL=0
LOOP1 ; Generate batch messages of 100 messages long
+1 ;No "ATR" xref
IF '$DATA(^VA(200,"ATR"))
DO MAIL
QUIT
+2 KILL ^TMP("HLS",$JOB),XUOAA
+3 SET (INDX,XUOAA,CNT,ERROR)=0
+4 DO INIT
if ERROR
QUIT
+5 ; create msg stub (batch)
DO STUB
if ERROR
QUIT
+6 ; iterate over list of entries (100 max) and build batch message
+7 FOR
SET INDX=$ORDER(^VA(200,"ATR",INDX))
if 'INDX!(XUOAA>99)
QUIT
Begin DoDot:1
+8 LOCK +^VA(200,INDX):30
if '$TEST
QUIT
+9 ; message count in batch
SET XUOAA=XUOAA+1
+10 ; temporary array to keep track of entries
+11 ; date/time recorded
SET XUOAA(INDX)=$GET(^VA(200,"ATR",INDX))
+12 ; build message for this entry
DO BLDMSG(INDX)
+13 KILL ^VA(200,"ATR",INDX)
+14 SET TOTAL=TOTAL+1
+15 LOCK -^VA(200,INDX)
End DoDot:1
+16 DO SEND
+17 IF ERROR
DO RESTORE
DO STORENV
QUIT
+18 ; more than 100 entries, create another batch
IF XUOAA>99
GOTO LOOP1
+19 KILL ^TMP("HLS",$JOB),XUOAA
+20 DO MAIL
+21 QUIT
+22 ;
INIT ; initialize HL variables
+1 ; "XUOAA PMU"=event protocol, XUOAAHL=hl variables
+2 ; checks for valid event protocol
+3 DO INIT^HLFNC2("XUOAA PMU",.XUOAAHL)
+4 IF $GET(XUOAAHL)
SET ERROR="1^"_$PIECE(XUOAAHL,U,2)
QUIT
+5 ;field separator
SET FS=$GET(XUOAAHL("FS"))
+6 ;component separator
SET CS=$EXTRACT(XUOAAHL("ECH"),1)
+7 ;sub-component separator
SET SS=$EXTRACT(XUOAAHL("ECH"),4)
+8 QUIT
+9 ;
STUB ; create msg stub for batch msg
+1 ; XUHLMID=batch msg id, XUMTIEN=file 772 ien
+2 ; XUHLDT=FM date/time, XUHLDT1=HL7 date/time
+3 DO CREATE^HLTF(.XUHLMID,.XUMTIEN,.XUHLDT,.XUHLDT1)
+4 IF 'XUHLMID
SET ERROR="1^could not create msg stub"
QUIT
+5 QUIT
+6 ;
BLDMSG(IEN) ;
+1 NEW ADDR,CITY,DEGLEV,DOB,EMAIL,ENTERDT,FACILITY,GEOLOC,IFN
+2 NEW LASTYR,MSGHDR,NAME,PROGSTD,RECORDT,SERVICE,SSN,STATE,STREET,TERMDT
+3 NEW TITLE,ZIP,XUNAME,VHATF,X,Y
+4 if 'IEN
QUIT
+5 ; extract data from Fileman and transform to HL7 datatype
+6 SET XUNAME("FILE")=200
SET XUNAME("FIELD")=.01
SET XUNAME("IENS")=IEN
+7 SET NAME=$$HLNAME^XLFNAME(.XUNAME,"S",CS)
+8 SET STREET=$$GET1^DIQ(200,IEN,"STREET ADDRESS 1")
+9 SET STREET=STREET_U_$$GET1^DIQ(200,IEN,"STREET ADDRESS 2")
+10 SET STREET=STREET_U_$$GET1^DIQ(200,IEN,"STREET ADDRESS 3")
+11 SET CITY=$$GET1^DIQ(200,IEN,"CITY")
+12 SET STATE=$$GET1^DIQ(200,IEN,"STATE","I")
+13 SET ZIP=$$GET1^DIQ(200,IEN,"ZIP CODE")
+14 SET GEOLOC=CITY_U_STATE_U_ZIP_U_"USA"
+15 SET ADDR=$$HLADDR^HLFNC(STREET,GEOLOC)
+16 SET SSN=$$GET1^DIQ(200,IEN,"SSN")
+17 SET SSN=SSN_CS_CS_CS_"USSSA"_CS_"SS"
+18 SET EMAIL=$$GET1^DIQ(200,IEN,"EMAIL ADDRESS")
+19 SET DEGLEV=$$GET1^DIQ(200,IEN,"CURRENT DEGREE LEVEL:ABBREVIATION")
+20 SET PROGSTD=$$GET1^DIQ(200,IEN,"PROGRAM OF STUDY")
+21 SET LASTYR=$$GET1^DIQ(200,IEN,"LAST TRAINING MONTH & YEAR")
+22 Begin DoDot:1
+23 NEW %DT
+24 SET X=LASTYR
SET %DT="M"
+25 DO ^%DT
+26 QUIT
End DoDot:1
+27 SET LASTYR=$$FMTHL7^XLFDT(Y)
+28 SET SERVICE=$$GET1^DIQ(200,IEN,"SERVICE/SECTION")
+29 SET SERVICE=SERVICE_CS_CS_"SERVICE/SECTION"
+30 SET TERMDT=$$GET1^DIQ(200,IEN,"DATE NO LONGER TRAINEE","I")
+31 SET TERMDT=$$FMTHL7^XLFDT(TERMDT)
+32 if 'TERMDT
SET TERMDT=""
+33 SET TITLE=$$GET1^DIQ(200,IEN,"TITLE")
+34 SET ENTERDT=$$GET1^DIQ(200,IEN,"START OF TRAINING","I")
+35 SET ENTERDT=$$FMTHL7^XLFDT(ENTERDT)
+36 if 'ENTERDT
SET ENTERDT=""
+37 ; date recorded
+38 SET RECORDT=$$FMTHL7^XLFDT($GET(XUOAA(IEN)))
+39 SET FACILITY=$$NS^XUAF4($$KSP^XUPARAM("INST"))
+40 SET FACILITY=$PIECE(FACILITY,U,2)_CS_$PIECE(FACILITY,U)
+41 Begin DoDot:1
+42 SET VHATF=+$$GET1^DIQ(200,IEN,"VHA TRAINING FACILITY","I")
+43 ;Both pieces Null
IF VHATF<1
SET VHATF="^"
QUIT
+44 IF VHATF>0
SET VHATF=$$NS^XUAF4(VHATF)
+45 QUIT
End DoDot:1
+46 SET VHATF=$PIECE(VHATF,U,2)_CS_$PIECE(VHATF,U)
+47 ; IFN= internal file number
+48 SET IFN=IEN_CS_"IEN"_CS_"NEW PERSON"
+49 SET DOB=$$GET1^DIQ(200,IEN,"DOB","I")
+50 SET DOB=$$FMTHL7^XLFDT(DOB)
+51 ; create msg header per entry
+52 ; XUOAAHL=hl array from INIT, XUHLMID=batch msg id from STUB
+53 ; XUOAA=message count, MSGHDR=message header
+54 DO MSH^HLFNC2(.XUOAAHL,XUHLMID_"-"_XUOAA,.MSGHDR)
+55 ; build temporary MSG TEXT array
+56 SET CNT=CNT+1
+57 SET ^TMP("HLS",$JOB,CNT)=MSGHDR
+58 SET CNT=CNT+1
+59 SET ^TMP("HLS",$JOB,CNT)="EVN"_FS_XUOAAHL("ETN")_FS_RECORDT_FS_FS_FS_FS_FS_FACILITY
+60 SET CNT=CNT+1
+61 SET ^TMP("HLS",$JOB,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
+62 SET CNT=CNT+1
+63 SET ^TMP("HLS",$JOB,CNT)="PRA"_FS_FS_FS_"OAA"_FS_FS_PROGSTD_CS_CS_CS_CS_LASTYR
+64 SET CNT=CNT+1
+65 SET ^TMP("HLS",$JOB,CNT)="ORG"_FS_1_FS_VHATF_FS_SERVICE_FS_FS_FS_FS_FS_CS_PROGSTD_CS_"PROGRAM OF STUDY"_FS_ENTERDT_CS_TERMDT
+66 SET CNT=CNT+1
+67 SET ^TMP("HLS",$JOB,CNT)="EDU"_FS_"1"_FS_DEGLEV
+68 Begin DoDot:1
+69 ; Update Trainee's Date Transmitted to OAA
+70 NEW DIERR,ZERR,FDA
+71 SET FDA(200,$SELECT(IEN[",":IEN,1:IEN_","),12.5)=DT
+72 DO FILE^DIE("I","FDA","ZERR")
End DoDot:1
+73 QUIT
+74 ;
SEND ; send complete batch message
+1 ; "XUOAA PMU"=event protocol, LB=batch array type
+2 ; RESULT="msgid^error code^error msg" , XUMTIEN=file 772 ien from STUB
+3 DO GENERATE^HLMA("XUOAA PMU","GB",1,.RESULT,XUMTIEN)
+4 IF +$PIECE(RESULT,U,2)
Begin DoDot:1
+5 SET ERROR="1^"_$PIECE(RESULT,U,3)
End DoDot:1
QUIT
+6 SET MSGID=+RESULT
+7 QUIT
+8 ;
RESTORE ; message could not be sent, restore x-ref
+1 SET INDX=0
FOR
SET INDX=$ORDER(XUOAA(INDX))
if 'INDX
QUIT
Begin DoDot:1
+2 SET ^VA(200,"ATR",INDX)=$GET(XUOAA(INDX))
End DoDot:1
+3 QUIT
+4 ;
RECACK ; receive application acknoledgement from HL7
+1 IF $GET(HL("ACKCD"))'="AA"
Begin DoDot:1
+2 DO STORENV("RECACK")
End DoDot:1
+3 QUIT
+4 ;
STORENV ; store environmental variables for logging purposes
+1 NEW APP,XTMP,X
+2 SET APP="Clinical Trainee Core Dataset"
SET XTMP="XUOAA"_DT
+3 SET ^XTMP(XTMP,0)=$$FMADD^XLFDT(DT,14)_U_$$NOW^XLFDT_U_APP
+4 SET X="^XTMP("""_XTMP_""","
+5 DO DOLRO^%ZOSV
+6 QUIT
+7 ;
MAIL ;Send mail message to G.XUOAA CLIN TRAINEE TRANS
+1 NEW LN,MSGTXT,MSGSBJ
+2 SET LN=1
+3 SET MSGSBJ="Clinical Trainee Transmission Count"
+4 SET MSGTXT=""
+5 SET MSGTXT(LN)=" "
SET LN=LN+1
+6 SET MSGTXT(LN)="Number of trainees transmitted to OAA: "_TOTAL
+7 ;Check to see if Mail Group has members
+8 IF '$$GOTLOCAL^XMXAPIG("XUOAA CLIN TRAINEE TRANS")
DO SENDMSG^XMXAPI(DUZ,MSGSBJ,"MTEXT",DUZ)
QUIT
+9 ; Mail Group Has Memebers so send the message
+10 DO SENDMSG^XMXAPI(DUZ,MSGSBJ,"MSGTXT","G.XUOAA CLIN TRAINEE TRANS")
+11 QUIT
