BYIMRT ;IHS/CIM/THL - IMMUNIZATION DATA EXCHANGE;
;;2.0;BYIM IMMUNIZATION DATA EXCHANGE;**3,4,5,6,7,8**;JUL 11, 2017;Build 310
;;CONTINUATION OF BYIMIMM
;
;REAL-TIME PROCESSING
;
;-----
RT ;EP;FOR REAL TIME QUERIES
F D RT1 Q:$D(BYIMQUIT)
K BYIMQUIT
Q
;-----
RT1 ;REAL TIME
D PATH^BYIMIMM6
K BYIMQTX,BYIMQUIT
S BYIMQTX=$S(BYIMQT=1:"VXQ",1:"QBP")
N RT
W @IOF
W !!?10,"Real-Time Query Options - Version: ",BYIMVER
K DIR
S DIR(0)="SO^1:Get a Patient's Immunizations FROM State IIS;2:Send a Patient's Immunizations TO State IIS;3:Review State IIS Responses;4:Check for Additional Response Messages"
S DIR("A")="Select the action type"
D ^DIR
K DIR
I 'Y S BYIMQUIT=1 Q
S RT=$S(Y=1:"VXQ",Y=2:"VXU",Y=3:"RESP",Y=4:"RTIN",1:"")
I RT="RESP" D RESP K BYIMQUIT Q
I RT="RTIN" D Q
.W !!,"Checking for query responses that have not yet been processed."
.W !!,"Please stand by..."
.H 4
.N BYIMRTIN
.S BYIMRTIN=1
.D RTIN
.W !!,"Please check 'Review State IIS Responses' for new IIS responses."
.D PAUSE^BYIMIMM6
.K BYIMQUIT
D PAT
Q:'$D(^TMP($J,"BYIM RT"))
D SEND
K ^TMP($J,"BYIM RT")
Q
;-----
PAT ;
K ^TMP($J,"BYIM RT")
I RT="VXU" D ALL
W !!,"Select patient(s) to send to the State Immunization Registry"
F D P1 Q:$D(BYIMQUIT)
K BYIMQUIT
Q
;-----
P1 ;SELECT MULTIPE PATIENTS
K DIE,DIC,DINUM,DR,DA,DD,DO,DIK,DLAYGO
S DIC=9000001
S DIC("A")="Select "_$S($D(^TMP($J,"BYIM RT")):"another ",1:"")_"patient: "
S DIC(0)="AEQM"
W !
D ^DIC
K DIE,DIC,DINUM,DR,DA,DD,DO,DIK,DLAYGO
I Y<1 S BYIMQUIT="" Q
S ^TMP($J,"BYIM RT",+Y)=""
D RTPAT
Q
;-----
SEND ;SEND RT QUERY
W !!,$S(RT="VXQ":"A 'Query for Vaccination Record ("_BYIMQTX_")'",1:"An 'Unsolicited Vaccine Record Update (VXU)'")," will be sent for:"
D RTPAT
K DIR
S DIR(0)="YO"
S DIR("A")="Do you want to proceed"
S DIR("B")="YES"
W !
D ^DIR
K DIR
Q:Y'=1
I '$D(ZTQUEUED)&$D(^TMP($J,"BYIM RT")) D
.W !!,"Please stand by. This may take a couple of seconds...",!
S DFN=0
F S DFN=$O(^TMP($J,"BYIM RT",DFN)) Q:'DFN D
.D:RT="VXQ" VXQ(DFN)
.D:RT="VXU" VXU(DFN)
.K ^TMP($J,"BYIM RT",DFN)
K ^TMP($J,"BYIM RT")
D PAUSE^BYIMIMM6
Q
;-----
RTPAT ;DISPLAY PATIENTS FOR RT QUERY
N DFN
W !
S DFN=0
F S DFN=$O(^TMP($J,"BYIM RT",DFN)) Q:'DFN D
.W !," *** ",$P(^DPT(DFN,0),U)," *** "
Q
;-----
VXQ(DFN) ;EP;TO SEND VXQ MESSAGE
W:'$D(ZTQUEUED) !,"Query being sent for: ",$J(DFN,6)," ",$P(^DPT(DFN,0),U)
D DELAY
S Y=$$VXQX(DFN)
Q
DELAY Q:$D(ZTQUEUED)
W " "
F J=1:1:3 W "." H 1
Q
;-----
VXU(DFN) ;EP;TO SEND VXU MESSAGE
N VST
S VST=$O(^AUPNVSIT("AC",DFN,9999999999),-1)
Q:'VST
S Y=$$V04^BYIMIMM(VST,BYIMALL)
W:'$D(ZTQUEUED) !,"Immunization record being sent for: ",$J(DFN,6)," ",$P(^DPT(DFN,0),U)
D DELAY
S INHF=+Y
Q:'INHF
S BYIMUIF=$O(^INTHU("AT",INHF,0))
Q:'BYIMUIF
D LOGD^BYIMIMM4(DFN,"E")
D RXR(BYIMUIF)
S BYIMSTP="VXU"
D SFILE(BYIMUIF,DFN,BYIMSTP)
D CLEANVXU(BYIMUIF)
Q
;-----
RSP ;EP;IMMUNIZATION DATA EXCHANGE
S BHLDEST="D DEST^INHUSEN"
S INDEST("RSPK11")="HL IHS IZV04 RSP IN"
X BHLDEST
Q
;-----
RESP ;EP;REVIEW RT RESPONSE FILES
K BYIMQUIT
F D RESP1 Q:$D(BYIMQUIT)
Q
;-----
RESP1 ;REVIEW RESPONSES
K BYIMQUIT
K ^TMP($J,"BYIM RT")
N DFN,RT
W @IOF
W !!?10,"Review Responses from the State IIS"
K DIR
S DIR(0)="SO^1:Review Immunizations ready to add to RPMS;2:Review Query Response Messages"
S DIR("A")="Select the action type"
W !
D ^DIR
K DIR,BYIMQUIT
I 'Y S BYIMQUIT=1 Q
S RT=$S(Y=1:"START",1:"NON")
I RT="START" D START Q
F D NON Q:$D(BYIMQUIT)
K BYIMQUIT
Q
;-----
START ;
W @IOF
W !!?10,"All NEW immunizations for Query Responses from the state"
W !!?10,"that can be added to RPMS will be listed below."
W !!
S DIR("A")="Press <ENTER> to review immunizations, press '^' to exit"
D PAUSE^BYIMIMM6
Q:'Y
D START^BYIMIMM1
Q
;-----
NON ;EP;TO REVIEW NON-IMMUNIZATION IIS RESPONSES
W @IOF
W !!?10,"Select Responses by Patient or Date"
K DIE,DIC,DINUM,DR,DA,DD,DO,DIK,DLAYGO
S DIC="^BYIMRT("
S DIC(0)="AEMQ"
S DIC("A")="Select Query Date or Patient: "
S DIC("S")="I $P(^(0),U,2)=""E"""
W !
D ^DIC
K DIE,DIC,DINUM,DR,DA,DD,DO,DIK,DLAYGO
I Y<0 S BYIMQUIT=1 Q
D DISP(+Y)
Q
;-----
RTIMP(FILE) ;EP;TO AUTOMATICALLY IMPORT REAL-TIME MESSAGES
K BYIMQUIT
N AUTOIMP,AUTOADD,DIR
S AUTOIMP=$P($G(^BYIMPARA(DUZ(2),0)),U,4)
S AUTOADD=$P($G(^BYIMPARA(DUZ(2),0)),U,5)
D PATH^BYIMIMM6
Q:IPATH=""
S Y=$$OPEN^%ZISH(IPATH,FILE,"R")
Q:Y
N BYIMJ,BYIMX,UIF
S UIF=""
S BYIMJ=0
;F U IO R BYIMX:DTIME D:BYIMX="" CLOSE^%ZISH() Q:BYIMX="" D
;.I BYIMX["MSH|" D Q:'UIF
;..D NEWUIF
;.I BYIMX["MSH|" D NEWUIF Q:'UIF
;.S BYIMJ=BYIMJ+1
;.S ^INTHU(UIF,3,BYIMJ,0)=BYIMX_"|CR|"
D LOG(UIF,"I",FILE)
N BYIMXX
S BYIMXX=0
F S BYIMXX=$O(^BYIMTMP($J,"BYIM IMM",BYIMXX)) Q:'BYIMXX D
.D SET1^BYIMIMM1(BYIMXX)
Q
;-----
LOG(UIF,ACT,FILE) ;LOG RT FILE
Q:'$G(UIF)
S ^BYIMTMP($J,"BYIM IMM",UIF)=""
N XX,DFN
S DFN=$P(FILE,"_",2)
S MID=""
S XX=0
S:MID'["IHS-" MID=""
D RTLOG(FILE,ACT,IPATH,DFN,UIF,MID,0)
Q
;-----
VXQX(BYIMPAT) ;PEP;send query request for patient IEN - BYIMPAT
;BYIMPAT - PATIENT DFN/IEN
;RETURNS GIS HL7 MESSAGE CREATION MESSAGE
;
I '$G(BYIMPAT)!'$D(^DPT(+$G(BYIMPAT),0)) Q "No Patient identified for DFN "_$G(BYIMPAT)
D PATH^BYIMIMM6
S BYIMQTX=$S(BYIMQT=1:"VXQ",1:"QBP")
N BYIMDEST,INH,INDA,INA
S INDA=BYIMPAT
S INDA(2,1)=BYIMPAT
S INDA(9000001,1)=BYIMPAT
S INA("QNM",INDA)=""
S BYIMDEST=$S(BYIMQT=1:"HL IHS IZV04 V01VXQ OUT PARENT",1:"HL IHS IZV04 QBP OUT PARENT")
D ^INHF(BYIMDEST,.INDA,.INA)
H 2
I $G(INHF) D
.S BYIMUIF=$O(^INTHU("AT",INHF,0))
.Q:'BYIMUIF
.S BYIMSTP=BYIMQTX
.D SFILE(BYIMUIF,BYIMPAT,BYIMSTP)
D EOJ^BYIMIMM
Q $$MSG^BYIMIMM(INHF)
;-----
SFILE(BYIMUIF,BYIMPAT,BYIMSTP) ;EP;TO SEND RT FILE VIA HL7 BRIDGE
;BYIMUIF - THE IEN OF THE ^INTHU( ENTRY FOR THE MESSAGE
;BYIMPAT - THE IEN OF PATIENT
;BYIMSTP - MESSAGE TYPE
Q:'$G(BYIMUIF)!'$G(BYIMPAT)
S BYIMSTP=$TR(BYIMSTP,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
S MID=""
D PATH^BYIMIMM6
D NOW^%DTC
S QFILE="izrt"_BYIMSTP_$TR(BYIMVER,".")_"_"_$E("000000",1,6-$L(BYIMPAT))_BYIMPAT_"_"_($P(%,".")+17000000)_"_"_$P(%,".",2)_$E("000000",1,6-$L($P(%,".",2)))_".dat"
S ACT="W"
D FILE(OPATH,QFILE,ACT,BYIMUIF,BYIMPAT,BYIMSTP)
Q
FILE(PATH,FILE,ACT,BYIMUIF,BYIMPAT,BYIMSTP) ;SEND FILE
;OPATH - PATH FOR TRANSMISSION
;FILE - FILE NAME
;ACT - ACTION
;BYIMUIF - IEN IN ^INTHU
;BYIMPAT - PATIENT DFN
;BYIMSTP -
S Y=$$OPEN^%ZISH(PATH,FILE,ACT)
I Y D Q
.D EXPBULL^BYIMIMM4(FILE,0,PATH)
.D RTLOG(FILE,"E",PATH,BYIMPAT,BYIMUIF,MID,1)
N X,XX
D REFUSAL^BYIMSEG1(BYIMPAT,BYIMUIF)
S X=""
S XX=0
F S XX=$O(^INTHU(BYIMUIF,3,XX)) Q:'XX S READ=^(XX,0) D F1
D CLOSE^%ZISH()
D RTLOG(QFILE,"E",OPATH,BYIMPAT,BYIMUIF,MID,0)
Q:BYIMBDG<1
N BYIMRTIN
S BYIMRTIN=0
D RTIN
Q
;-----
F1 ;WRTIE OUT EACH LINE
S X=X_$P(READ,"|CR|")
Q:READ'["|CR|"
S:X["MSH|" MID=$P(X,"|",10)
S:'BYIMIN1&($E(X,1,4)["IN1|"!($E(X,1,4)["IN2|")) X=""
S:$E(X,1,5)="RXR||" X=""
S:X["RXR|ZZZ" X=""
S:X["OBX|"&(X["V00") X=""
S:"|MSH|FHS|BHS|BTS|FTS|"'[("|"_$E(X,1,3)_"|") X=$TR(X,"\&")
I X]"" U IO W X,!
S X=""
Q
;-----
RTIN ;EP;CHECK REAL-TIME INBOUND FILES
N DIR,FILE
D PATH^BYIMIMM6
S DIR=$$LIST^%ZISH(IPATH,"izrt*",.DIR)
N IN
S IN=0
F S IN=$O(DIR(IN)) Q:'IN S FILE=DIR(IN) D:FILE]""
.Q:$D(^BYIMRT("ACT",FILE,"I"))
.D RTIMP(FILE)
.I $G(BYIMRTIN) W !,FILE," processed..."
Q
;-----
RTDEST ;EP;CHECK DESTINATION GLOBAL FOR RT MESSAGES
S BYIMDEST=$S(BYIMVER["2.3":"HL IHS IZV04 V01VXQ OUT PARENT",1:"HL IHS IZV04 QBP OUT PARENT")
S BYIMDDA=$O(^INRHD("B",BYIMDEST,0))
Q:'BYIMDDA
N PRI
S PRI=0
F S PRI=$O(^INLHDEST(BYIMDDA,PRI)) Q:'PRI D
.N BYIMDT
.S BYIMDT=""
.F S BYIMDT=$O(^INLHDEST(BYIMDDA,PRI,BYIMDT)) Q:BYIMDT="" D
..N BYIMUIF
..S BYIMUIF=0
..F S BYIMUIF=$O(^INLHDEST(BYIMDDA,PRI,BYIMDT,BYIMUIF)) Q:'BYIMUIF D
...Q:'$D(^INTHU(BYIMUIF,3))
...D UIF(BYIMUIF)
Q
;-----
UIF(BYIMUIF) ;PROCESS UIF
Q:'$G(BYIMUIF)
Q:'$D(^INTHU(BYIMUIF,3))
N XX
S XX=$G(^INTHU(BYIMUIF,3,2))
Q:XX=""
N DFN,HRN,LOC,HRN,LOCDA,X,Y,Z
S HRN=""
S:XX["PID|" HRN=$P(XX,"|",4)
S:XX["QRD|" HRN=$P($P(XX,"|",9),U)
S:XX["QPD|" HRN=$P(XX,"|",3)
S LOC=$E(HRN,1,6)
S HRN=+$E(HRN,7,12)
S LOCDA=$O(^AUTTLOC("C",LOC,0))
Q:'LOCDA!'HRN
S DFN=""
S X=0
F S X=$O(^AUPNPAT("D",HRN,X)) Q:'X!DFN I $D(^AUPNPAT("D",HRN,X,LOCDA)) S DFN=X
Q:'DFN
S BYIMSTP="IN"
D SFILE(BYIMUIF,DFN,BYIMSTP)
Q
;-----
RTLOG(FILE,ACT,PATH,DFN,UIF,MID,STAT) ;EP;
;LOG EXPORT/IMPORT FILES THAT HAVE BEEN PROCESSED
;FILE = NAME OF FILE IMPORTED OR EXPORTED
;ACT = ACTION - 'I'MPORT OR 'E'XPORT
;PATH = DRIVE/DIRECTORY FILE SENT TO
;DFN = DFN OF PATIENT FOR QUERY/RESPONSE
;UIF = IEN OF THE UNIVERSAL MESSAGE ENTRY
;MID = MESSAGE ID ASSIGNED FOR THE UNIVERSAL MESSAGE ENTRY
;STAT = TRANSMITTION STATUS
Q:$G(FILE)=""!($G(ACT)="")
K DIE,DIC,DINUM,DR,DA,DD,DO,DIK,DLAYGO
S X=FILE
S DIC="^BYIMRT("
S DIC(0)="L"
S DIC("DR")=".02////"_ACT_";.03////"_PATH_";.04////"_DFN_";.05////"_($P(FILE,"_",3)-17000000)_"."_$P($P(FILE,"_",4),".")_";.06////"_MID_";.07////"_UIF_";.08////"_$G(STAT)
D FILE^DICN
K DIE,DIC,DINUM,DR,DA,DD,DO,DIK,DLAYGO
Q:Y<1
S RTLDA=+Y
S ^BYIMRT(RTLDA,1,0)="^90480.21"
N X
S X=0
F S X=$O(^INTHU(UIF,3,X)) Q:'X S ^BYIMRT(RTLDA,1,X,0)=^(X,0),Z=X
S $P(^BYIMRT(RTLDA,1,0),U,3)=Z
S $P(^BYIMRT(RTLDA,1,0),U,4)=Z
Q
;-----
DISP(RTLDA) ;DISPLAY RESPONSE FILE
D HDR
N XX,BYIMQUIT
S MID=$P(^BYIMRT(RTLDA,0),U,6)
S FILE=$P(^BYIMRT(RTLDA,0),U)
S XX=0
S MIDDA=$O(^BYIMRT("ACT",FILE,"I",0))
I 'MIDDA D Q
.W !!,"No response on file yet for this query."
.D PAUSE^BYIMIMM6
D MID
K BYIMQUIT
Q
;-----
HDR ;QUERY RESPONSE DISPLAY HEADER
W @IOF
HDR1 W !!,"Query for Patient",?26,"Query Date",?38,"Query file"
W !,"------------------------",?26,"----------",?38,"-------------------------------"
N X0
S X0=$G(^BYIMRT(RTLDA,0))
W !,$P($G(^DPT(+$P(X0,U,4),0)),U)
S X1=$P(X0,U,5)
W ?26,$E(X1,4,5),"/",$E(X1,6,7),"/",$E(X1,1,3)+1700
W ?38,$P(X0,U)
Q
;-----
HDR2 ;DISPLAY RELATED MESSAGE
W !!!,"HL7 Response Message"
W:$P(^BYIMRT(MIDDA,0),U,6)]"" " ID: ",$P(^(0),U,6)
W !,"*******************************************************"
W !
Q
;-----
NEWUIF ;CREATE INTHU ENTRY
K DIE,DIC,DINUM,DR,DA,DD,DO,DIK,DLAYGO
D NOW^%DTC
S X=%
S DIC="^INTHU("
S DIC(0)="L"
D FILE^DICN
K DIE,DIC,DINUM,DR,DA,DD,DO,DIK,DLAYGO
S UIF=+Y
Q
;-----
MID ;DISPLAY MESSAGE RESPONSES
S MIDDA=0
F S MIDDA=$O(^BYIMRT("ACT",FILE,"I",MIDDA)) Q:'MIDDA!$G(BYIMQUIT) D MID1
K BYIMQUIT
Q
;-----
MID1 ;
D HDR2
N XX,BYIMQUIT
S XX=0
F S XX=$O(^BYIMRT(MIDDA,1,XX)) Q:'XX!$D(BYIMQUIT) S X=^(XX,0) D
.I X["MSH|",X["|VXU" D DVXU(X) S BYIMQUIT=1 Q
.W !,X
.I IOST["C-",IOSL<($Y+4) D PAUSE^BYIMIMM6 S:X[U BYIMQUIT=1 W @IOF
D PAUSE^BYIMIMM6
Q
;-----
VXQV01(UIF) ;EP;TO DISPLAY VXQ^V01 QUERY
;UIF - IEN OF THE UNIVERSAL INTERFACE ENTRY
Q:'$G(UIF)
S MSH=$G(^INTHU(UIF,3,1,0))
S QRD=$G(^INTHU(UIF,3,2,0))
S QRF=$G(^INTHU(UIF,3,1,0))
Q:MSH=""
W !!,"Message ID: ",$P(MSH,"|",10)
W !,"Patient HRN: ",+$E($P(QRD,"|",9),7,12)," Facility: ",$P($G(^DIC(4,+$E($P(QRD,"|",9),1,6),0)),U)
Q
;-----
RXR(BYIMUIF) ;EP;CLEAN OUT BLANK RXR AND '0' OBX segments
N X,Y
S X=0
F S X=$O(^INTHU(BYIMUIF,3,X)) Q:'X S Y=^(X,0) D
.K:$E(Y,1,5)="RXR||" ^INTHU(BYIMUIF,3,X,0)
.K:Y["OBX|"&(Y["V00") ^INTHU(BYIMUIF,3,X,0)
Q
;-----
DVXU(X) ;DISPLAY RT VXU MESSAGE
N DISP,HDR
S XX=XX
F S XX=$O(^BYIMRT(MIDDA,1,XX)) Q:'XX!$G(BYIMQUIT) S X=^(XX,0) D
.D:X["PID|" PID(X)
.D:X["RXA|" RXA(X)
Q:'$D(DISP)
F J=1:1:6 W !,HDR(J)
N XX,YY
S XX=""
F S XX=$O(DISP(XX)) Q:XX=""!$G(BYIMQUIT) D
.S YY=""
.F S YY=$O(DISP(XX,YY)) Q:YY=""!$G(BYIMQUIT) S Z=DISP(XX,YY) D
..W !,XX,?12,YY
..W ?39,$J($P(Z,U),4)
..W ?45,$P(Z,U,2)
..W ?54,$P(Z,U,3)
..W ?69,$P(Z,U,4)
.I IOST["C-",IOSL<($Y+4) D
..D PAUSE^BYIMIMM6
..S:X[U BYIMQUIT=1
..Q:$G(BYIMQUIT)
..W @IOF
..F J=1:1:6 W !,HDR(J)
Q
MSH ;DISPLAY RT MSH SEGMENT
W !,$TR($P(X,"|",3),"^"," ")," ",$TR($P(X,"|",4),"^"," ")," "
S Y=$P(X,"|",7)
W $E(Y,1,4),"-",$E(Y,5,6),"-",$E(Y,7,8)," ",$P(X,"|",9)," ",$P(X,"|",11)
Q
;-----
PID(X) ;DISPLAY RT PID SEGMENT
N Y,Z
S Y="NAME"
S $E(Y,33)="DOB"
S $E(Y,45)="SEX"
S HDR(1)=Y
S HDR(2)="------------------------------ ---------- ---"
S Y=$P(X,"|",6)
S Y=$P(Y,U)_","_$P(Y,U,2)_" "_$P(Y,U,3)
S Z=$P(X,"|",8)
S $E(Y,33)=$E(Z,1,4)_"-"_$E(Z,5,6)_"-"_$E(Z,7,8)
S $E(Y,45)=$P(X,"|",9)
S HDR(3)=Y
S HDR(4)=""
S Y="ADMIN DATE"
S $E(Y,13)="CVX VACCINE NAME"
S $E(Y,40)="QUAN"
S $E(Y,46)="TYPE"
S $E(Y,55)="LOT NO."
S $E(Y,70)="EXP. DATE"
S HDR(5)=Y
S Y="----------"
S $E(Y,13)="--- --------------------"
S $E(Y,40)="----"
S $E(Y,46)="-------"
S $E(Y,55)="-------------"
S $E(Y,70)="---------"
S HDR(6)=Y
Q
;-----
RXA(X) ;DISPLAY RT RXA SEGMENT
N Y,Z,AD,IMM,QUAN,TYPE,LOT,EXP
S Y=$P(X,"|",4)
S AD=$E(Y,1,4)_"-"_$E(Y,5,6)_"-"_$E(Y,7,8)
S Y=$P(X,"|",6)
S CVX=$P(Y,U)
S IMM=$J(CVX,3)_" "_$E($P(Y,U,2),1,20)
S QUAN=$TR($P(X,"|",7),"^")
S TYPE=$TR($E($P($P(X,"|",10),U,2),1,7),"^")
S LOT=$TR($P(X,"|",16),"^")
S Y=$TR($P(X,"|",17),"^")
S EXP=$E(Y,1,4)_"-"_$E(Y,5,6)_"-"_$E(Y,7,8)
S DISP(AD,IMM)=QUAN_U_TYPE_U_LOT_U_EXP
Q
;-----
ALL ;EP;TO SPECIFY NEW ONLY OR ALL IMMUNIZATIONS
K BYIMALL
W !!,"Which immunizations should be include:"
K DIR
S DIR(0)="SO^1:NEW/EDITED Immunizations (not previously exported);2:ALL Immunizations for exported patient(s)"
S DIR("A")="Send NEW or ALL Immunizations"
S DIR("B")="NEW/EDITED Immunizations"
D ^DIR
K DIR
I 'Y S BYIMQUIT=1 Q
S BYIMALL=+Y
Q
;-----
CLEANVXU(BYIMUIF) ;REMOVE INLHDEST REMNANT FOR RT MESSAGES
Q:'$G(BYIMUIF)
N X,Y,Z
S X=0
F S X=$O(^INLHDEST(X)) Q:'X D
.S Y=""
.F S Y=$O(^INLHDEST(X,Y)) Q:Y="" D
..S Z=""
..F S Z=$O(^INLHDEST(X,Y,Z)) Q:Z="" K ^INLHDEST(X,Y,Z,BYIMUIF)
Q
;
BYIMRT ;IHS/CIM/THL - IMMUNIZATION DATA EXCHANGE;
+1 ;;2.0;BYIM IMMUNIZATION DATA EXCHANGE;**3,4,5,6,7,8**;JUL 11, 2017;Build 310
+2 ;;CONTINUATION OF BYIMIMM
+3 ;
+4 ;REAL-TIME PROCESSING
+5 ;
+6 ;-----
RT ;EP;FOR REAL TIME QUERIES
+1 FOR
DO RT1
IF $DATA(BYIMQUIT)
QUIT
+2 KILL BYIMQUIT
+3 QUIT
+4 ;-----
RT1 ;REAL TIME
+1 DO PATH^BYIMIMM6
+2 KILL BYIMQTX,BYIMQUIT
+3 SET BYIMQTX=$SELECT(BYIMQT=1:"VXQ",1:"QBP")
+4 NEW RT
+5 WRITE @IOF
+6 WRITE !!?10,"Real-Time Query Options - Version: ",BYIMVER
+7 KILL DIR
+8 SET DIR(0)="SO^1:Get a Patient's Immunizations FROM State IIS;2:Send a Patient's Immunizations TO State IIS;3:Review State IIS Responses;4:Check for Additional Response Messages"
+9 SET DIR("A")="Select the action type"
+10 DO ^DIR
+11 KILL DIR
+12 IF 'Y
SET BYIMQUIT=1
QUIT
+13 SET RT=$SELECT(Y=1:"VXQ",Y=2:"VXU",Y=3:"RESP",Y=4:"RTIN",1:"")
+14 IF RT="RESP"
DO RESP
KILL BYIMQUIT
QUIT
+15 IF RT="RTIN"
Begin DoDot:1
+16 WRITE !!,"Checking for query responses that have not yet been processed."
+17 WRITE !!,"Please stand by..."
+18 HANG 4
+19 NEW BYIMRTIN
+20 SET BYIMRTIN=1
+21 DO RTIN
+22 WRITE !!,"Please check 'Review State IIS Responses' for new IIS responses."
+23 DO PAUSE^BYIMIMM6
+24 KILL BYIMQUIT
End DoDot:1
QUIT
+25 DO PAT
+26 IF '$DATA(^TMP($JOB,"BYIM RT"))
QUIT
+27 DO SEND
+28 KILL ^TMP($JOB,"BYIM RT")
+29 QUIT
+30 ;-----
PAT ;
+1 KILL ^TMP($JOB,"BYIM RT")
+2 IF RT="VXU"
DO ALL
+3 WRITE !!,"Select patient(s) to send to the State Immunization Registry"
+4 FOR
DO P1
IF $DATA(BYIMQUIT)
QUIT
+5 KILL BYIMQUIT
+6 QUIT
+7 ;-----
P1 ;SELECT MULTIPE PATIENTS
+1 KILL DIE,DIC,DINUM,DR,DA,DD,DO,DIK,DLAYGO
+2 SET DIC=9000001
+3 SET DIC("A")="Select "_$SELECT($DATA(^TMP($JOB,"BYIM RT")):"another ",1:"")_"patient: "
+4 SET DIC(0)="AEQM"
+5 WRITE !
+6 DO ^DIC
+7 KILL DIE,DIC,DINUM,DR,DA,DD,DO,DIK,DLAYGO
+8 IF Y<1
SET BYIMQUIT=""
QUIT
+9 SET ^TMP($JOB,"BYIM RT",+Y)=""
+10 DO RTPAT
+11 QUIT
+12 ;-----
SEND ;SEND RT QUERY
+1 WRITE !!,$SELECT(RT="VXQ":"A 'Query for Vaccination Record ("_BYIMQTX_")'",1:"An 'Unsolicited Vaccine Record Update (VXU)'")," will be sent for:"
+2 DO RTPAT
+3 KILL DIR
+4 SET DIR(0)="YO"
+5 SET DIR("A")="Do you want to proceed"
+6 SET DIR("B")="YES"
+7 WRITE !
+8 DO ^DIR
+9 KILL DIR
+10 IF Y'=1
QUIT
+11 IF '$DATA(ZTQUEUED)&$DATA(^TMP($JOB,"BYIM RT"))
Begin DoDot:1
+12 WRITE !!,"Please stand by. This may take a couple of seconds...",!
End DoDot:1
+13 SET DFN=0
+14 FOR
SET DFN=$ORDER(^TMP($JOB,"BYIM RT",DFN))
IF 'DFN
QUIT
Begin DoDot:1
+15 IF RT="VXQ"
DO VXQ(DFN)
+16 IF RT="VXU"
DO VXU(DFN)
+17 KILL ^TMP($JOB,"BYIM RT",DFN)
End DoDot:1
+18 KILL ^TMP($JOB,"BYIM RT")
+19 DO PAUSE^BYIMIMM6
+20 QUIT
+21 ;-----
RTPAT ;DISPLAY PATIENTS FOR RT QUERY
+1 NEW DFN
+2 WRITE !
+3 SET DFN=0
+4 FOR
SET DFN=$ORDER(^TMP($JOB,"BYIM RT",DFN))
IF 'DFN
QUIT
Begin DoDot:1
+5 WRITE !," *** ",$PIECE(^DPT(DFN,0),U)," *** "
End DoDot:1
+6 QUIT
+7 ;-----
VXQ(DFN) ;EP;TO SEND VXQ MESSAGE
+1 IF '$DATA(ZTQUEUED)
WRITE !,"Query being sent for: ",$JUSTIFY(DFN,6)," ",$PIECE(^DPT(DFN,0),U)
+2 DO DELAY
+3 SET Y=$$VXQX(DFN)
+4 QUIT
DELAY IF $DATA(ZTQUEUED)
QUIT
+1 WRITE " "
+2 FOR J=1:1:3
WRITE "."
HANG 1
+3 QUIT
+4 ;-----
VXU(DFN) ;EP;TO SEND VXU MESSAGE
+1 NEW VST
+2 SET VST=$ORDER(^AUPNVSIT("AC",DFN,9999999999),-1)
+3 IF 'VST
QUIT
+4 SET Y=$$V04^BYIMIMM(VST,BYIMALL)
+5 IF '$DATA(ZTQUEUED)
WRITE !,"Immunization record being sent for: ",$JUSTIFY(DFN,6)," ",$PIECE(^DPT(DFN,0),U)
+6 DO DELAY
+7 SET INHF=+Y
+8 IF 'INHF
QUIT
+9 SET BYIMUIF=$ORDER(^INTHU("AT",INHF,0))
+10 IF 'BYIMUIF
QUIT
+11 DO LOGD^BYIMIMM4(DFN,"E")
+12 DO RXR(BYIMUIF)
+13 SET BYIMSTP="VXU"
+14 DO SFILE(BYIMUIF,DFN,BYIMSTP)
+15 DO CLEANVXU(BYIMUIF)
+16 QUIT
+17 ;-----
RSP ;EP;IMMUNIZATION DATA EXCHANGE
+1 SET BHLDEST="D DEST^INHUSEN"
+2 SET INDEST("RSPK11")="HL IHS IZV04 RSP IN"
+3 XECUTE BHLDEST
+4 QUIT
+5 ;-----
RESP ;EP;REVIEW RT RESPONSE FILES
+1 KILL BYIMQUIT
+2 FOR
DO RESP1
IF $DATA(BYIMQUIT)
QUIT
+3 QUIT
+4 ;-----
RESP1 ;REVIEW RESPONSES
+1 KILL BYIMQUIT
+2 KILL ^TMP($JOB,"BYIM RT")
+3 NEW DFN,RT
+4 WRITE @IOF
+5 WRITE !!?10,"Review Responses from the State IIS"
+6 KILL DIR
+7 SET DIR(0)="SO^1:Review Immunizations ready to add to RPMS;2:Review Query Response Messages"
+8 SET DIR("A")="Select the action type"
+9 WRITE !
+10 DO ^DIR
+11 KILL DIR,BYIMQUIT
+12 IF 'Y
SET BYIMQUIT=1
QUIT
+13 SET RT=$SELECT(Y=1:"START",1:"NON")
+14 IF RT="START"
DO START
QUIT
+15 FOR
DO NON
IF $DATA(BYIMQUIT)
QUIT
+16 KILL BYIMQUIT
+17 QUIT
+18 ;-----
START ;
+1 WRITE @IOF
+2 WRITE !!?10,"All NEW immunizations for Query Responses from the state"
+3 WRITE !!?10,"that can be added to RPMS will be listed below."
+4 WRITE !!
+5 SET DIR("A")="Press <ENTER> to review immunizations, press '^' to exit"
+6 DO PAUSE^BYIMIMM6
+7 IF 'Y
QUIT
+8 DO START^BYIMIMM1
+9 QUIT
+10 ;-----
NON ;EP;TO REVIEW NON-IMMUNIZATION IIS RESPONSES
+1 WRITE @IOF
+2 WRITE !!?10,"Select Responses by Patient or Date"
+3 KILL DIE,DIC,DINUM,DR,DA,DD,DO,DIK,DLAYGO
+4 SET DIC="^BYIMRT("
+5 SET DIC(0)="AEMQ"
+6 SET DIC("A")="Select Query Date or Patient: "
+7 SET DIC("S")="I $P(^(0),U,2)=""E"""
+8 WRITE !
+9 DO ^DIC
+10 KILL DIE,DIC,DINUM,DR,DA,DD,DO,DIK,DLAYGO
+11 IF Y<0
SET BYIMQUIT=1
QUIT
+12 DO DISP(+Y)
+13 QUIT
+14 ;-----
RTIMP(FILE) ;EP;TO AUTOMATICALLY IMPORT REAL-TIME MESSAGES
+1 KILL BYIMQUIT
+2 NEW AUTOIMP,AUTOADD,DIR
+3 SET AUTOIMP=$PIECE($GET(^BYIMPARA(DUZ(2),0)),U,4)
+4 SET AUTOADD=$PIECE($GET(^BYIMPARA(DUZ(2),0)),U,5)
+5 DO PATH^BYIMIMM6
+6 IF IPATH=""
QUIT
+7 SET Y=$$OPEN^%ZISH(IPATH,FILE,"R")
+8 IF Y
QUIT
+9 NEW BYIMJ,BYIMX,UIF
+10 SET UIF=""
+11 SET BYIMJ=0
+12 ;F U IO R BYIMX:DTIME D:BYIMX="" CLOSE^%ZISH() Q:BYIMX="" D
+13 ;.I BYIMX["MSH|" D Q:'UIF
+14 ;..D NEWUIF
+15 ;.I BYIMX["MSH|" D NEWUIF Q:'UIF
+16 ;.S BYIMJ=BYIMJ+1
+17 ;.S ^INTHU(UIF,3,BYIMJ,0)=BYIMX_"|CR|"
+18 DO LOG(UIF,"I",FILE)
+19 NEW BYIMXX
+20 SET BYIMXX=0
+21 FOR
SET BYIMXX=$ORDER(^BYIMTMP($JOB,"BYIM IMM",BYIMXX))
IF 'BYIMXX
QUIT
Begin DoDot:1
+22 DO SET1^BYIMIMM1(BYIMXX)
End DoDot:1
+23 QUIT
+24 ;-----
LOG(UIF,ACT,FILE) ;LOG RT FILE
+1 IF '$GET(UIF)
QUIT
+2 SET ^BYIMTMP($JOB,"BYIM IMM",UIF)=""
+3 NEW XX,DFN
+4 SET DFN=$PIECE(FILE,"_",2)
+5 SET MID=""
+6 SET XX=0
+7 IF MID'["IHS-"
SET MID=""
+8 DO RTLOG(FILE,ACT,IPATH,DFN,UIF,MID,0)
+9 QUIT
+10 ;-----
VXQX(BYIMPAT) ;PEP;send query request for patient IEN - BYIMPAT
+1 ;BYIMPAT - PATIENT DFN/IEN
+2 ;RETURNS GIS HL7 MESSAGE CREATION MESSAGE
+3 ;
+4 IF '$GET(BYIMPAT)!'$DATA(^DPT(+$GET(BYIMPAT),0))
QUIT "No Patient identified for DFN "_$GET(BYIMPAT)
+5 DO PATH^BYIMIMM6
+6 SET BYIMQTX=$SELECT(BYIMQT=1:"VXQ",1:"QBP")
+7 NEW BYIMDEST,INH,INDA,INA
+8 SET INDA=BYIMPAT
+9 SET INDA(2,1)=BYIMPAT
+10 SET INDA(9000001,1)=BYIMPAT
+11 SET INA("QNM",INDA)=""
+12 SET BYIMDEST=$SELECT(BYIMQT=1:"HL IHS IZV04 V01VXQ OUT PARENT",1:"HL IHS IZV04 QBP OUT PARENT")
+13 DO ^INHF(BYIMDEST,.INDA,.INA)
+14 HANG 2
+15 IF $GET(INHF)
Begin DoDot:1
+16 SET BYIMUIF=$ORDER(^INTHU("AT",INHF,0))
+17 IF 'BYIMUIF
QUIT
+18 SET BYIMSTP=BYIMQTX
+19 DO SFILE(BYIMUIF,BYIMPAT,BYIMSTP)
End DoDot:1
+20 DO EOJ^BYIMIMM
+21 QUIT $$MSG^BYIMIMM(INHF)
+22 ;-----
SFILE(BYIMUIF,BYIMPAT,BYIMSTP) ;EP;TO SEND RT FILE VIA HL7 BRIDGE
+1 ;BYIMUIF - THE IEN OF THE ^INTHU( ENTRY FOR THE MESSAGE
+2 ;BYIMPAT - THE IEN OF PATIENT
+3 ;BYIMSTP - MESSAGE TYPE
+4 IF '$GET(BYIMUIF)!'$GET(BYIMPAT)
QUIT
+5 SET BYIMSTP=$TRANSLATE(BYIMSTP,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
+6 SET MID=""
+7 DO PATH^BYIMIMM6
+8 DO NOW^%DTC
+9 SET QFILE="izrt"_BYIMSTP_$TRANSLATE(BYIMVER,".")_"_"_$EXTRACT("000000",1,6-$LENGTH(BYIMPAT))_BYIMPAT_"_"_($PIECE(%,".")+17000000)_"_"_$PIECE(%,".",2)_$EXTRACT("000000",1,6-$LENGTH($PIECE(%,".",2)))_".dat"
+10 SET ACT="W"
+11 DO FILE(OPATH,QFILE,ACT,BYIMUIF,BYIMPAT,BYIMSTP)
+12 QUIT
FILE(PATH,FILE,ACT,BYIMUIF,BYIMPAT,BYIMSTP) ;SEND FILE
+1 ;OPATH - PATH FOR TRANSMISSION
+2 ;FILE - FILE NAME
+3 ;ACT - ACTION
+4 ;BYIMUIF - IEN IN ^INTHU
+5 ;BYIMPAT - PATIENT DFN
+6 ;BYIMSTP -
+7 SET Y=$$OPEN^%ZISH(PATH,FILE,ACT)
+8 IF Y
Begin DoDot:1
+9 DO EXPBULL^BYIMIMM4(FILE,0,PATH)
+10 DO RTLOG(FILE,"E",PATH,BYIMPAT,BYIMUIF,MID,1)
End DoDot:1
QUIT
+11 NEW X,XX
+12 DO REFUSAL^BYIMSEG1(BYIMPAT,BYIMUIF)
+13 SET X=""
+14 SET XX=0
+15 FOR
SET XX=$ORDER(^INTHU(BYIMUIF,3,XX))
IF 'XX
QUIT
SET READ=^(XX,0)
DO F1
+16 DO CLOSE^%ZISH()
+17 DO RTLOG(QFILE,"E",OPATH,BYIMPAT,BYIMUIF,MID,0)
+18 IF BYIMBDG<1
QUIT
+19 NEW BYIMRTIN
+20 SET BYIMRTIN=0
+21 DO RTIN
+22 QUIT
+23 ;-----
F1 ;WRTIE OUT EACH LINE
+1 SET X=X_$PIECE(READ,"|CR|")
+2 IF READ'["|CR|"
QUIT
+3 IF X["MSH|"
SET MID=$PIECE(X,"|",10)
+4 IF 'BYIMIN1&($EXTRACT(X,1,4)["IN1|"!($EXTRACT(X,1,4)["IN2|"))
SET X=""
+5 IF $EXTRACT(X,1,5)="RXR||"
SET X=""
+6 IF X["RXR|ZZZ"
SET X=""
+7 IF X["OBX|"&(X["V00")
SET X=""
+8 IF "|MSH|FHS|BHS|BTS|FTS|"'[("|"_$EXTRACT(X,1,3)_"|")
SET X=$TRANSLATE(X,"\&")
+9 IF X]""
USE IO
WRITE X,!
+10 SET X=""
+11 QUIT
+12 ;-----
RTIN ;EP;CHECK REAL-TIME INBOUND FILES
+1 NEW DIR,FILE
+2 DO PATH^BYIMIMM6
+3 SET DIR=$$LIST^%ZISH(IPATH,"izrt*",.DIR)
+4 NEW IN
+5 SET IN=0
+6 FOR
SET IN=$ORDER(DIR(IN))
IF 'IN
QUIT
SET FILE=DIR(IN)
IF FILE]""
Begin DoDot:1
+7 IF $DATA(^BYIMRT("ACT",FILE,"I"))
QUIT
+8 DO RTIMP(FILE)
+9 IF $GET(BYIMRTIN)
WRITE !,FILE," processed..."
End DoDot:1
+10 QUIT
+11 ;-----
RTDEST ;EP;CHECK DESTINATION GLOBAL FOR RT MESSAGES
+1 SET BYIMDEST=$SELECT(BYIMVER["2.3":"HL IHS IZV04 V01VXQ OUT PARENT",1:"HL IHS IZV04 QBP OUT PARENT")
+2 SET BYIMDDA=$ORDER(^INRHD("B",BYIMDEST,0))
+3 IF 'BYIMDDA
QUIT
+4 NEW PRI
+5 SET PRI=0
+6 FOR
SET PRI=$ORDER(^INLHDEST(BYIMDDA,PRI))
IF 'PRI
QUIT
Begin DoDot:1
+7 NEW BYIMDT
+8 SET BYIMDT=""
+9 FOR
SET BYIMDT=$ORDER(^INLHDEST(BYIMDDA,PRI,BYIMDT))
IF BYIMDT=""
QUIT
Begin DoDot:2
+10 NEW BYIMUIF
+11 SET BYIMUIF=0
+12 FOR
SET BYIMUIF=$ORDER(^INLHDEST(BYIMDDA,PRI,BYIMDT,BYIMUIF))
IF 'BYIMUIF
QUIT
Begin DoDot:3
+13 IF '$DATA(^INTHU(BYIMUIF,3))
QUIT
+14 DO UIF(BYIMUIF)
End DoDot:3
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;-----
UIF(BYIMUIF) ;PROCESS UIF
+1 IF '$GET(BYIMUIF)
QUIT
+2 IF '$DATA(^INTHU(BYIMUIF,3))
QUIT
+3 NEW XX
+4 SET XX=$GET(^INTHU(BYIMUIF,3,2))
+5 IF XX=""
QUIT
+6 NEW DFN,HRN,LOC,HRN,LOCDA,X,Y,Z
+7 SET HRN=""
+8 IF XX["PID|"
SET HRN=$PIECE(XX,"|",4)
+9 IF XX["QRD|"
SET HRN=$PIECE($PIECE(XX,"|",9),U)
+10 IF XX["QPD|"
SET HRN=$PIECE(XX,"|",3)
+11 SET LOC=$EXTRACT(HRN,1,6)
+12 SET HRN=+$EXTRACT(HRN,7,12)
+13 SET LOCDA=$ORDER(^AUTTLOC("C",LOC,0))
+14 IF 'LOCDA!'HRN
QUIT
+15 SET DFN=""
+16 SET X=0
+17 FOR
SET X=$ORDER(^AUPNPAT("D",HRN,X))
IF 'X!DFN
QUIT
IF $DATA(^AUPNPAT("D",HRN,X,LOCDA))
SET DFN=X
+18 IF 'DFN
QUIT
+19 SET BYIMSTP="IN"
+20 DO SFILE(BYIMUIF,DFN,BYIMSTP)
+21 QUIT
+22 ;-----
RTLOG(FILE,ACT,PATH,DFN,UIF,MID,STAT) ;EP;
+1 ;LOG EXPORT/IMPORT FILES THAT HAVE BEEN PROCESSED
+2 ;FILE = NAME OF FILE IMPORTED OR EXPORTED
+3 ;ACT = ACTION - 'I'MPORT OR 'E'XPORT
+4 ;PATH = DRIVE/DIRECTORY FILE SENT TO
+5 ;DFN = DFN OF PATIENT FOR QUERY/RESPONSE
+6 ;UIF = IEN OF THE UNIVERSAL MESSAGE ENTRY
+7 ;MID = MESSAGE ID ASSIGNED FOR THE UNIVERSAL MESSAGE ENTRY
+8 ;STAT = TRANSMITTION STATUS
+9 IF $GET(FILE)=""!($GET(ACT)="")
QUIT
+10 KILL DIE,DIC,DINUM,DR,DA,DD,DO,DIK,DLAYGO
+11 SET X=FILE
+12 SET DIC="^BYIMRT("
+13 SET DIC(0)="L"
+14 SET DIC("DR")=".02////"_ACT_";.03////"_PATH_";.04////"_DFN_";.05////"_($PIECE(FILE,"_",3)-17000000)_"."_$PIECE($PIECE(FILE,"_",4),".")_";.06////"_MID_";.07////"_UIF_";.08////"_$GET(STAT)
+15 DO FILE^DICN
+16 KILL DIE,DIC,DINUM,DR,DA,DD,DO,DIK,DLAYGO
+17 IF Y<1
QUIT
+18 SET RTLDA=+Y
+19 SET ^BYIMRT(RTLDA,1,0)="^90480.21"
+20 NEW X
+21 SET X=0
+22 FOR
SET X=$ORDER(^INTHU(UIF,3,X))
IF 'X
QUIT
SET ^BYIMRT(RTLDA,1,X,0)=^(X,0)
SET Z=X
+23 SET $PIECE(^BYIMRT(RTLDA,1,0),U,3)=Z
+24 SET $PIECE(^BYIMRT(RTLDA,1,0),U,4)=Z
+25 QUIT
+26 ;-----
DISP(RTLDA) ;DISPLAY RESPONSE FILE
+1 DO HDR
+2 NEW XX,BYIMQUIT
+3 SET MID=$PIECE(^BYIMRT(RTLDA,0),U,6)
+4 SET FILE=$PIECE(^BYIMRT(RTLDA,0),U)
+5 SET XX=0
+6 SET MIDDA=$ORDER(^BYIMRT("ACT",FILE,"I",0))
+7 IF 'MIDDA
Begin DoDot:1
+8 WRITE !!,"No response on file yet for this query."
+9 DO PAUSE^BYIMIMM6
End DoDot:1
QUIT
+10 DO MID
+11 KILL BYIMQUIT
+12 QUIT
+13 ;-----
HDR ;QUERY RESPONSE DISPLAY HEADER
+1 WRITE @IOF
HDR1 WRITE !!,"Query for Patient",?26,"Query Date",?38,"Query file"
+1 WRITE !,"------------------------",?26,"----------",?38,"-------------------------------"
+2 NEW X0
+3 SET X0=$GET(^BYIMRT(RTLDA,0))
+4 WRITE !,$PIECE($GET(^DPT(+$PIECE(X0,U,4),0)),U)
+5 SET X1=$PIECE(X0,U,5)
+6 WRITE ?26,$EXTRACT(X1,4,5),"/",$EXTRACT(X1,6,7),"/",$EXTRACT(X1,1,3)+1700
+7 WRITE ?38,$PIECE(X0,U)
+8 QUIT
+9 ;-----
HDR2 ;DISPLAY RELATED MESSAGE
+1 WRITE !!!,"HL7 Response Message"
+2 IF $PIECE(^BYIMRT(MIDDA,0),U,6)]""
WRITE " ID: ",$PIECE(^(0),U,6)
+3 WRITE !,"*******************************************************"
+4 WRITE !
+5 QUIT
+6 ;-----
NEWUIF ;CREATE INTHU ENTRY
+1 KILL DIE,DIC,DINUM,DR,DA,DD,DO,DIK,DLAYGO
+2 DO NOW^%DTC
+3 SET X=%
+4 SET DIC="^INTHU("
+5 SET DIC(0)="L"
+6 DO FILE^DICN
+7 KILL DIE,DIC,DINUM,DR,DA,DD,DO,DIK,DLAYGO
+8 SET UIF=+Y
+9 QUIT
+10 ;-----
MID ;DISPLAY MESSAGE RESPONSES
+1 SET MIDDA=0
+2 FOR
SET MIDDA=$ORDER(^BYIMRT("ACT",FILE,"I",MIDDA))
IF 'MIDDA!$GET(BYIMQUIT)
QUIT
DO MID1
+3 KILL BYIMQUIT
+4 QUIT
+5 ;-----
MID1 ;
+1 DO HDR2
+2 NEW XX,BYIMQUIT
+3 SET XX=0
+4 FOR
SET XX=$ORDER(^BYIMRT(MIDDA,1,XX))
IF 'XX!$DATA(BYIMQUIT)
QUIT
SET X=^(XX,0)
Begin DoDot:1
+5 IF X["MSH|"
IF X["|VXU"
DO DVXU(X)
SET BYIMQUIT=1
QUIT
+6 WRITE !,X
+7 IF IOST["C-"
IF IOSL<($Y+4)
DO PAUSE^BYIMIMM6
IF X[U
SET BYIMQUIT=1
WRITE @IOF
End DoDot:1
+8 DO PAUSE^BYIMIMM6
+9 QUIT
+10 ;-----
VXQV01(UIF) ;EP;TO DISPLAY VXQ^V01 QUERY
+1 ;UIF - IEN OF THE UNIVERSAL INTERFACE ENTRY
+2 IF '$GET(UIF)
QUIT
+3 SET MSH=$GET(^INTHU(UIF,3,1,0))
+4 SET QRD=$GET(^INTHU(UIF,3,2,0))
+5 SET QRF=$GET(^INTHU(UIF,3,1,0))
+6 IF MSH=""
QUIT
+7 WRITE !!,"Message ID: ",$PIECE(MSH,"|",10)
+8 WRITE !,"Patient HRN: ",+$EXTRACT($PIECE(QRD,"|",9),7,12)," Facility: ",$PIECE($GET(^DIC(4,+$EXTRACT($PIECE(QRD,"|",9),1,6),0)),U)
+9 QUIT
+10 ;-----
RXR(BYIMUIF) ;EP;CLEAN OUT BLANK RXR AND '0' OBX segments
+1 NEW X,Y
+2 SET X=0
+3 FOR
SET X=$ORDER(^INTHU(BYIMUIF,3,X))
IF 'X
QUIT
SET Y=^(X,0)
Begin DoDot:1
+4 IF $EXTRACT(Y,1,5)="RXR||"
KILL ^INTHU(BYIMUIF,3,X,0)
+5 IF Y["OBX|"&(Y["V00")
KILL ^INTHU(BYIMUIF,3,X,0)
End DoDot:1
+6 QUIT
+7 ;-----
DVXU(X) ;DISPLAY RT VXU MESSAGE
+1 NEW DISP,HDR
+2 SET XX=XX
+3 FOR
SET XX=$ORDER(^BYIMRT(MIDDA,1,XX))
IF 'XX!$GET(BYIMQUIT)
QUIT
SET X=^(XX,0)
Begin DoDot:1
+4 IF X["PID|"
DO PID(X)
+5 IF X["RXA|"
DO RXA(X)
End DoDot:1
+6 IF '$DATA(DISP)
QUIT
+7 FOR J=1:1:6
WRITE !,HDR(J)
+8 NEW XX,YY
+9 SET XX=""
+10 FOR
SET XX=$ORDER(DISP(XX))
IF XX=""!$GET(BYIMQUIT)
QUIT
Begin DoDot:1
+11 SET YY=""
+12 FOR
SET YY=$ORDER(DISP(XX,YY))
IF YY=""!$GET(BYIMQUIT)
QUIT
SET Z=DISP(XX,YY)
Begin DoDot:2
+13 WRITE !,XX,?12,YY
+14 WRITE ?39,$JUSTIFY($PIECE(Z,U),4)
+15 WRITE ?45,$PIECE(Z,U,2)
+16 WRITE ?54,$PIECE(Z,U,3)
+17 WRITE ?69,$PIECE(Z,U,4)
End DoDot:2
+18 IF IOST["C-"
IF IOSL<($Y+4)
Begin DoDot:2
+19 DO PAUSE^BYIMIMM6
+20 IF X[U
SET BYIMQUIT=1
+21 IF $GET(BYIMQUIT)
QUIT
+22 WRITE @IOF
+23 FOR J=1:1:6
WRITE !,HDR(J)
End DoDot:2
End DoDot:1
+24 QUIT
MSH ;DISPLAY RT MSH SEGMENT
+1 WRITE !,$TRANSLATE($PIECE(X,"|",3),"^"," ")," ",$TRANSLATE($PIECE(X,"|",4),"^"," ")," "
+2 SET Y=$PIECE(X,"|",7)
+3 WRITE $EXTRACT(Y,1,4),"-",$EXTRACT(Y,5,6),"-",$EXTRACT(Y,7,8)," ",$PIECE(X,"|",9)," ",$PIECE(X,"|",11)
+4 QUIT
+5 ;-----
PID(X) ;DISPLAY RT PID SEGMENT
+1 NEW Y,Z
+2 SET Y="NAME"
+3 SET $EXTRACT(Y,33)="DOB"
+4 SET $EXTRACT(Y,45)="SEX"
+5 SET HDR(1)=Y
+6 SET HDR(2)="------------------------------ ---------- ---"
+7 SET Y=$PIECE(X,"|",6)
+8 SET Y=$PIECE(Y,U)_","_$PIECE(Y,U,2)_" "_$PIECE(Y,U,3)
+9 SET Z=$PIECE(X,"|",8)
+10 SET $EXTRACT(Y,33)=$EXTRACT(Z,1,4)_"-"_$EXTRACT(Z,5,6)_"-"_$EXTRACT(Z,7,8)
+11 SET $EXTRACT(Y,45)=$PIECE(X,"|",9)
+12 SET HDR(3)=Y
+13 SET HDR(4)=""
+14 SET Y="ADMIN DATE"
+15 SET $EXTRACT(Y,13)="CVX VACCINE NAME"
+16 SET $EXTRACT(Y,40)="QUAN"
+17 SET $EXTRACT(Y,46)="TYPE"
+18 SET $EXTRACT(Y,55)="LOT NO."
+19 SET $EXTRACT(Y,70)="EXP. DATE"
+20 SET HDR(5)=Y
+21 SET Y="----------"
+22 SET $EXTRACT(Y,13)="--- --------------------"
+23 SET $EXTRACT(Y,40)="----"
+24 SET $EXTRACT(Y,46)="-------"
+25 SET $EXTRACT(Y,55)="-------------"
+26 SET $EXTRACT(Y,70)="---------"
+27 SET HDR(6)=Y
+28 QUIT
+29 ;-----
RXA(X) ;DISPLAY RT RXA SEGMENT
+1 NEW Y,Z,AD,IMM,QUAN,TYPE,LOT,EXP
+2 SET Y=$PIECE(X,"|",4)
+3 SET AD=$EXTRACT(Y,1,4)_"-"_$EXTRACT(Y,5,6)_"-"_$EXTRACT(Y,7,8)
+4 SET Y=$PIECE(X,"|",6)
+5 SET CVX=$PIECE(Y,U)
+6 SET IMM=$JUSTIFY(CVX,3)_" "_$EXTRACT($PIECE(Y,U,2),1,20)
+7 SET QUAN=$TRANSLATE($PIECE(X,"|",7),"^")
+8 SET TYPE=$TRANSLATE($EXTRACT($PIECE($PIECE(X,"|",10),U,2),1,7),"^")
+9 SET LOT=$TRANSLATE($PIECE(X,"|",16),"^")
+10 SET Y=$TRANSLATE($PIECE(X,"|",17),"^")
+11 SET EXP=$EXTRACT(Y,1,4)_"-"_$EXTRACT(Y,5,6)_"-"_$EXTRACT(Y,7,8)
+12 SET DISP(AD,IMM)=QUAN_U_TYPE_U_LOT_U_EXP
+13 QUIT
+14 ;-----
ALL ;EP;TO SPECIFY NEW ONLY OR ALL IMMUNIZATIONS
+1 KILL BYIMALL
+2 WRITE !!,"Which immunizations should be include:"
+3 KILL DIR
+4 SET DIR(0)="SO^1:NEW/EDITED Immunizations (not previously exported);2:ALL Immunizations for exported patient(s)"
+5 SET DIR("A")="Send NEW or ALL Immunizations"
+6 SET DIR("B")="NEW/EDITED Immunizations"
+7 DO ^DIR
+8 KILL DIR
+9 IF 'Y
SET BYIMQUIT=1
QUIT
+10 SET BYIMALL=+Y
+11 QUIT
+12 ;-----
CLEANVXU(BYIMUIF) ;REMOVE INLHDEST REMNANT FOR RT MESSAGES
+1 IF '$GET(BYIMUIF)
QUIT
+2 NEW X,Y,Z
+3 SET X=0
+4 FOR
SET X=$ORDER(^INLHDEST(X))
IF 'X
QUIT
Begin DoDot:1
+5 SET Y=""
+6 FOR
SET Y=$ORDER(^INLHDEST(X,Y))
IF Y=""
QUIT
Begin DoDot:2
+7 SET Z=""
+8 FOR
SET Z=$ORDER(^INLHDEST(X,Y,Z))
IF Z=""
QUIT
KILL ^INLHDEST(X,Y,Z,BYIMUIF)
End DoDot:2
End DoDot:1
+9 QUIT
+10 ;
