BYIMIMM2 ;IHS/CIM/THL - IMMUNIZATION DATA EXCHANGE;
;;2.0;BYIM IMMUNIZATION DATA EXCHANGE;**3,4,5,6,7,8,9**;JUL 11, 2017;Build 22
;;CONTINUATION OF BYIMIMM
;
;-----
MATCH ;EP;COUNT NUMBER OF MATCHES
N A,B,C,DOB,K
S K=0
S DOB=0
F S DOB=$O(^BYIMXTMP("BYIM",DOB)) Q:'DOB D
.S A=""
.F S A=$O(^BYIMXTMP("BYIM",DOB,A)) Q:A="" D
..S B=0
..F S B=$O(^BYIMXTMP("BYIM",DOB,A,B)) Q:'B D
...S C=0
...F S C=$O(^BYIMXTMP("BYIM",DOB,A,B,C)) Q:'C D
....S X=0
....F S X=$O(^BYIMXTMP("BYIM",DOB,A,B,C,X)) Q:'X D
.....S K=K+1
S K=K-BYIMNCNT
U 0
W !!,"Import information:"
W !,"-------------------"
W !,"Number of immunizations already listed in IZAD prior to this import"
W !,"that need to be reviewed to be added to RPMS: ",BYIMNCNT
W !,"Number of patients in this import file.....: ",MSGCNT
W !,"Number of immunizations in this import file: ",RXACNT
W !,"Number of immunizations in this import that can be added to RPMS..: ",K
W !,"Number of immunizations in this import that can't be added to RPMS: ",RXACNT-K
W !,"(No Patient match or immunization already in RPMS)",!
D PAUSE^BYIMIMM6
Q:'$O(^BYIMPARA($$DUZ^BYIMIMM(),4,0))
;-----
NN ;EP;TO SELECT DEVICE FOR THE NO MATCH REPORT
N NMXREF,NMDATE,NMDOB,NMX,NMY,NMZ,NMXX,NMYY,NMZZ
W @IOF
W !?10,"Select sequence for NO MATCH report"
K DIR
S DIR(0)="SO^1:Patient Name;2:Date of Birth;3:Import File Date"
S DIR("A")="Report sequence"
D ^DIR
K DIR
Q:'Y
I Y=1 D
.S NMXREF="NMNAME"
.S NMXX="------------------------------"
.S NMYY="--------"
.S NMZZ="--------"
.S NMX="PATIENT NAME"
.S NMY="DOB"
.S NMZ="IMP DATE"
I Y=2 D
.S NMXREF="NMDOB"
.S NMXX="--------"
.S NMYY="------------------------------"
.S NMZZ="--------"
.S NMX="DOB"
.S NMY="PATIENT NAME"
.S NMZ="IMP DATE"
I Y=3 D
.S NMXREF="NMDATE"
.S NMXX="--------"
.S NMYY="------------------------------"
.S NMZZ="--------"
.S NMX="IMP DATE"
.S NMY="PATIENT NAME"
.S NMZ="DOB"
S BYIMRTN="NONAME^BYIMIMM2"
D ZIS^BYIMXIS
Q
;-----
NONAME ;EP;TO DISPLAY NO MATCH REPORT
K BYIMQUIT
F D NONAME1 Q:$D(BYIMQUIT)
K ^BYIMXTMP("BYIM","NO MATCH NAME")
Q
NONAME1 ;
N XX,YY,J,JJ,XXX,BYIMX
D NN1
S J=0
S XXX=""
S DFN=""
F S DFN=$O(^BYIMPARA(NMXREF,DFN)) Q:DFN=""!(XXX=U) D
.S YY=0
.F S YY=$O(^BYIMPARA(NMXREF,DFN,$$DUZ^BYIMIMM(),YY)) Q:'YY!(XXX=U) D
..S Y=^BYIMPARA($$DUZ^BYIMIMM(),4,YY,0)
..D N1
I 'JJ S BYIMQUIT=1 Q
I $D(ZTQUEUED) S BYIMQUIT=1 Q
I IO'=$P(IO("HOME"),U,2) S BYIMQUIT=1 Q
S DIR(0)="LO^1:"_JJ
S DIR("A")="Select Names to Remove from the No Match List"
W !
D ^DIR
K DIR
I 'Y S BYIMQUIT=1 Q
N XX,BYIMY,JJ
M BYIMY=Y
S XX=""
F S XX=$O(BYIMY(XX)) Q:XX="" D
.S YY=BYIMY(XX)
.F JJ=1:1 S ZZ=$P(YY,",",JJ) Q:ZZ="" D
..S DA(1)=$$DUZ^BYIMIMM()
..S DA=$G(BYIMX(ZZ))
..Q:'DA
..S DIK="^BYIMPARA("_$$DUZ^BYIMIMM()_",4,"
..D ^DIK
W @IOF
Q
;-----
N1 S NAME=$P(Y,U)
S DOB=$P(Y,U,2)
S:$L(DOB)=7 DOB=DOB+17000000
S FILE=$P(Y,U,3)
S SEX=$P(Y,U,4)
S MM=$P(Y,U,5)
S MES=$P(Y,U,6)
I NMXREF="NMNAME" S X=DFN,Y=DOB,Z=FILE
I NMXREF="NMDATE" S X=DFN,Y=NAME,Z=DOB
I NMXREF="NMDOB" S X=DFN,Y=NAME,Z=FILE
S J=J+1
S BYIMX(J)=YY
W !,J,?4,X
I NMXREF="NMNAME" W ?35
I NMXREF="NMDATE"!(NMXREF="NMDOB") W ?13
W Y,?44,Z,?53,SEX
N XPAT
S XPAT=$O(^DPT("B",X,0))
I 'XPAT!(MM]"") W " (",$S(MM]"":MM,1:"NAME")," MISMATCH)"
S ^BYIMXTMP("BYIM","NO MATCH NAME",J)=$$DUZ^BYIMIMM()_U_YY
I '$D(ZTQUEUED),IO=$P(IO("HOME"),U,2),J#20=0 W ! D PAUSE^BYIMIMM6 S:X["^" BYIMQUIT="",XXX=U
Q
;-----
NN1 ;NO NAME HEADER
S JJ=0
S X=0
F S X=$O(^BYIMPARA($$DUZ^BYIMIMM(),4,X)) Q:'X S JJ=JJ+1
W !!,"Patients for whom there is no matching patient in RPMS: (TOTAL: ",JJ,")"
W !!,"#",?4,NMX
I NMXREF="NMNAME" W ?35
I NMXREF="NMDATE"!(NMXREF="NMDOB") W ?13
W NMY
W ?44,NMZ,?53,"SEX"
W !,"---",?4,NMXX
I NMXREF="NMNAME" W ?35
I NMXREF="NMDATE"!(NMXREF="NMDOB") W ?13
W NMYY
W ?44,"--------",?53,"---"
Q
;-----
AUTOIMP ;EP;TO AUTOMATICALLY IMPORT IMMUNIZATIONS
K BYIMQUIT
N AUTOIMP,AUTOADD,DIR,FILE
S AUTOIMP=$P($G(^BYIMPARA($$DUZ^BYIMIMM(),0)),U,4)
S AUTOADD=$P($G(^BYIMPARA($$DUZ^BYIMIMM(),0)),U,5)
D PATH^BYIMIMM6
Q:IPATH=""
S DIR=$$LIST^%ZISH(IPATH,"*",.DIR)
S FILE=""
S XX=0
F S XX=$O(DIR(XX)) Q:'XX S:DIR(XX)]"" FILE(DIR(XX))=""
S XX=""
F S XX=$O(FILE(XX)) Q:XX="" S:XX["izdata"&(XX[".dat"!(XX[".hl7")) FILE=XX
Q:FILE=""
N DA,BYIMQUIT
S DA=0
F S DA=$O(^BYIMPARA("FILE",FILE,$$DUZ^BYIMIMM(),DA)) Q:'DA D
.I $P($G(^BYIMPARA($$DUZ^BYIMIMM(),2,+DA,0)),U,3)="I" S BYIMQUIT=1
I $G(BYIMQUIT) K BYIMQUIT Q
D I1^BYIMIMM1
Q
;-----
FLIP ;EP;FLIP OLD HIPAA FORMAT TO NEW
W !!,"Please standby and do not interrupt this process..."
N DATE,BYIMDFN,IMM,XX
S XX=0
F S XX=$O(^BYIMPARA(XX)) Q:'XX D F1
Q
;-----
F1 S DATE=0
M ^BYIMTEMP(XX,"LAST EXPORT")=^BYIMPARA(XX,"LAST EXPORT")
F S DATE=$O(^BYIMPARA(XX,"LAST EXPORT",DATE)) Q:'DATE D
.S IMM=0
.F S IMM=$O(^BYIMPARA(XX,"LAST EXPORT",DATE,1,IMM)) Q:'IMM D
..S BYIMDFN=$P($G(^AUPNVIMM(IMM,0)),U,2)
..Q:'BYIMDFN
..Q:$D(^BYIMEXP("AC",BYIMDFN,DATE))
..K DIE,DIC,DINUM,DR,DA,DD,DO,DIK,DLAYGO
..S DIC="^BYIMEXP("
..S DIC(0)="L"
..S DIC("DR")=".02////"_DATE_";.03////"_IMM
..S X=BYIMDFN
..D FILE^DICN
..K DIE,DIC,DINUM,DR,DA,DD,DO,DIK,DLAYGO
..K ^BYIMPARA(XX,"LAST EXPORT",DATE,1,IMM)
Q
;-----
SHOW ;EP;TO SHOW ALL EXPORTS FOR SELECTED PATIENT
K BYIMQUIT
F D S1 Q:$D(BYIMQUIT)
Q
;-----
S1 ;SELECT PATIENT AND DATE
D SKILL
D SPAT
Q:'$G(BYIMDFN)
D SZIS
Q
;-----
SKILL ;KILL SHOW VARIABLES
K BYIMDFN,DIC,DIE,DIR,DA,DR,XX,BYIMDATE
Q
;-----
SPAT ;SELECT SHOW PATIENT
S DIC="^DPT("
S DIC(0)="AEMQZ"
S DIC("A")="Enter Name, HRN or DOB: "
S DIC("S")="I $D(^BYIMEXP(""B"",+Y))"
W !,@IOF
W !!,?10,"Select the patient to review:",!!
D ^DIC
K DIC,DINUM,DR,DA,DLAYGO
I +Y<1 S BYIMQUIT="" Q
S BYIMDFN=+Y
Q
;-----
SDATE ;SELECT EXPORT DATE
S DIR(0)="DO^:"_DT
S DIR("A")="Select EXPORT DATE"
D ^DIR
K DIR
Q:$L(Y)'=7
S BYIMDATE=Y
Q
;-----
SZIS ;SELECT DEVICE AND DISPLAY REPORT
S BYIMRTN="SDISP^BYIMIMM2"
D ZIS^BYIMXIS
Q
;-----
SDISP ;EP;SHOW DISPLAY OF PATIENT'S IMMUNIZATIONS EXPORTED
;PATCH 4
S TYPE="E"
;END PATCH 4
S NAME=$P(^DPT(BYIMDFN,0),U)
S DOB=$P(^DPT(BYIMDFN,0),U,3)+17000000
S HRN=$P(^AUPNPAT(BYIMDFN,41,$$DUZ^BYIMIMM(),0),U,2)
D SHEAD
S J=0
S XX=0
F S XX=$O(^BYIMEXP("B",BYIMDFN,XX)) Q:'XX!$D(BYIMQUIT) D
.S X=^BYIMEXP(XX,0)
.I $G(TYPE)]"" Q:$P(X,U,4)'=TYPE
.S DAT=$P(X,U,2)+17000000
.S IMM=$P(X,U,3)
.Q:'IMM
.;TO SHOW DELETED V IMMUNIZATIONS
.;Q:'$D(^AUPNVIMM(IMM,0))
.;Q:'$P(^AUPNVIMM(IMM,0),U,3)
.S DAT=$E(DAT,5,6)_"/"_$E(DAT,7,8)_"/"_$E(DAT,1,4)
.S VIS=$P($G(^AUPNVSIT(+$P($G(^AUPNVIMM(+IMM,0)),U,3),0)),".")
.;Q:'VIS
.S:$L(VIS)=7 VIS=VIS+17000000
.S INAM=$P($G(^AUTTIMM(+$G(^AUPNVIMM(+IMM,0)),0)),U)
.S:VIS VIS=$E(VIS,5,6)_"/"_$E(VIS,7,8)_"/"_$E(VIS,1,4)
.W !?5,DAT,?18,$E(INAM,1,20),?40,VIS
.I '$D(^AUPNVIMM(IMM,0)) W:VIS]"" ! W "V IMMUNIZATION has been deleted"
.;END
.S J=J+1
.I IOST["C-",J#15=0 D READ,SHEAD
K BYIMQUIT
;-----
READ N XXX
I '$D(ZTQUEUED) D PAUSE^BYIMIMM6 S:X["^" BYIMQUIT="" Q
Q
;-----
SHEAD ;EP;HEADER FOR EXPORT LIST DISPLAY
W @IOF
W !!,"Immunization Export summary for: "
W !,NAME,?30,"DOB: ",$E(DOB,5,6),"/",$E(DOB,7,8),"/",$E(DOB,1,4),?47,"HRN: ",HRN
W !!?5,"Export Date",?18,"Immunization",?40,"Admin Date"
W !?5,"-----------",?18,"--------------------",?40,"----------"
Q
;-----
INSET ;EP;TO PROCESS INCOMING HL7 MESSAGES
N MSH
S MSH=$E(X,1,3)
S:MSH="MSH" MSHX=X
Q:MSHX'["|VX"&(MSHX'["^V0")
Q:MSH["|"
S BYIMX=X
I MSH="MSH" D
.S MSGCNT=MSGCNT+1
.S J=J+1
.D NEWMSG
.S ^INTHU(INHDA,3,1,0)=BYIMX
.I '$D(ZTQUEUED) U 0 W "."
S:MSH="PID" ^INTHU(INHDA,3,2,0)=BYIMX
S:MSH="RXA" BYIMJ=BYIMJ+1,^INTHU(INHDA,3,BYIMJ,0)=BYIMX,RXACNT=RXACNT+1
Q
;-----
NEWMSG ;CREATE NEW INTHU ENTRY
D NOW^%DTC
S X=%
K DIE,DIC,DINUM,DR,DA,DD,DO,DIK,DLAYGO
S DIC="^INTHU("
S DIC(0)="L"
S DLAYGO=4001
D FILE^DICN
K DIE,DIC,DINUM,DR,DA,DD,DO,DIK,DLAYGO
S INHDA=+Y
S BYIMJ=2
S ^BYIMTMP($J,"BYIM IMM",INHDA)=""
Q
;-----
KILL ;EP;KILL TEMP GLOBAL ENTRY IF THERE IS EXACT MATCH OR MATCH FOR
;AN EQUIVALENT IMMUNIZATION OR IMMUNIZATION MATCH WITHIN 5 DAYS
N KILL,K,ZB,ZA,X,ZZ,DO
S KILL=$P(^AUTTIMM(+Y,0),U,12)
S:+Y=103 KILL=$P(^AUTTIMM(133,0),U,12)
S:+Y=106 KILL=$P(^AUTTIMM(107,0),U,12)
S:+Y=148 KILL=KILL_",140,141"
S:+Y=242 KILL=KILL_",15,141"
S:+Y=243 KILL=KILL_",15,140"
S Y=+$P($G(^AUTTIMM(+Y,0)),U,3)
S KILL=Y_","_KILL
S DO="T"_Y
S X=$T(@DO)
D:X]"" @DO
D K1
Q
;-----
K1 ;KILL TEMP GLOBAL IF EQUIVALENT IMM ON FILE
I "^20^22^28^50^102^106^"[(U_Y_U) S KILL="1,20,22,28,50,102,106,"_KILL
I "^10^"[(U_Y_U) S KILL="2,10,"_KILL
I "^49^"[(U_Y_U) S KILL="120,"_KILL
I "^42^43^44^45^51^104^"[(U_Y_U) S KILL="8,42,43,44,45,51,104,"_KILL
F K=1:1 S Y=$P(KILL,",",K) Q:Y="" D:$D(^BYIMXTMP("BYIM",DOB,NAME,DFN,Y))
.S ^BYIMXTMP("BYIM",DOB,NAME,DFN,Y,Z)=""
.K ^BYIMXTMP("BYIM",DOB,NAME,DFN,Y,Z)
.Q:'$D(^BYIMXTMP("BYIM",DOB,NAME,DFN,Y))
.S (X1,ZZ)=$O(^BYIMXTMP("BYIM",DOB,NAME,DFN,Y,Z),-1)
.D:X1
..S X2=Z
..D ^%DTC
..S:X<0 X=X*-1
..I X<6 K ^BYIMXTMP("BYIM",DOB,NAME,DFN,Y,ZZ),^(Z)
.S (X1,ZZ)=$O(^BYIMXTMP("BYIM",DOB,NAME,DFN,Y,Z))
.Q:'X1
.S X2=Z
.D ^%DTC
.S:X<0 X=X*-1
.I X<6 K ^BYIMXTMP("BYIM",DOB,NAME,DFN,Y,ZZ),^(Z)
Q
;-----
T1 D T20
Q
;-----
T2 S KILL=2
Q
;-----
T5 S KILL=$P(KILL,",94")_$P(KILL,",94",2)
Q
;-----
T6 S KILL=$P(KILL,",94")_$P(KILL,",94",2)
Q
;-----
T7 S KILL=$P(KILL,",94")_$P(KILL,",94",2)
Q
;-----
T8 S KILL=$P(KILL,",51")_$P(KILL,",51",2)
S KILL=$P(KILL,",110")_$P(KILL,",110",2)
S KILL=$P(KILL,",104")_$P(KILL,",104",2)
Q
;-----
T10 S KILL=10
Q
;-----
T17 S KILL=$P(KILL,",110")_$P(KILL,",110",2)
Q
;-----
T20 S KILL=$P(KILL,",110")_$P(KILL,",110",2)
S KILL=$P(KILL,",50")_$P(KILL,",50",2)
Q
;-----
T21 S KILL=21
Q
;-----
T28 S KILL=$P(KILL,",110")_$P(KILL,",110",2)
S KILL=$P(KILL,",50")_$P(KILL,",50",2)
Q
;-----
T38 S KILL=$P(KILL,",94")_$P(KILL,",94",2)
Q
;-----
T42 S KILL=$P(KILL,",104")_$P(KILL,",104",2)
Q
;-----
T43 S KILL=$P(KILL,",104")_$P(KILL,",104",2)
Q
;-----
T44 S KILL=$P(KILL,",104")_$P(KILL,",104",2)
Q
;-----
T45 S KILL=$P(KILL,",51")_$P(KILL,",51",2)
S KILL=$P(KILL,",110")_$P(KILL,",110",2)
S KILL=$P(KILL,",104")_$P(KILL,",104",2)
Q
;-----
T50 S KILL=$P(KILL,",110")_$P(KILL,",110",2)
S KILL=$P(KILL,",51")_$P(KILL,",51",2)
Q
;-----
T52 S KILL=$P(KILL,",104")_$P(KILL,",104",2)
Q
;-----
T83 S KILL=$P(KILL,",104")_$P(KILL,",104",2)
Q
;-----
T84 S KILL=$P(KILL,",104")_$P(KILL,",104",2)
Q
;-----
T85 S KILL=$P(KILL,",104")_$P(KILL,",104",2)
Q
;-----
T104 S KILL=$P(KILL,",51")_$P(KILL,",51",2)
S KILL=$P(KILL,",110")_$P(KILL,",110",2)
Q
;-----
T106 S KILL=$P(KILL,",110")_$P(KILL,",110",2)
S KILL=$P(KILL,",50")_$P(KILL,",50",2)
Q
;-----
T107 S KILL=$P(KILL,",110")_$P(KILL,",110",2)
S KILL=$P(KILL,",50")_$P(KILL,",50",2)
Q
;-----
T110 S KILL=$P(KILL,",22")_$P(KILL,",22",2)
S KILL=$P(KILL,",102")_$P(KILL,",102",2)
S KILL=$P(KILL,",50")_$P(KILL,",50",2)
Q
;-----
T120 S KILL=$P(KILL,",51")_$P(KILL,",51",2)
S KILL=$P(KILL,",102")_$P(KILL,",102",2)
S KILL=$P(KILL,",110")_$P(KILL,",110",2)
Q
;-----
T121 S KILL=$P(KILL,",94")_$P(KILL,",94",2)
S KILL=$P(KILL,",117")_$P(KILL,",117",2)
Q
;-----
P2 ;EP;FOR PATCH 2 POST INSTALL PROCESSING
;PATCH 2
D LOC^BYIMIMM3
I $P($G(^DIC(9.4,+$O(^DIC(9.4,"C","BYIM",0)),"VERSION")),U)=2.01 S $P(^("VERSION"),U)="2.0"
N TMP
S TMP=0
F S TMP=$O(^BYIMTMP(TMP)) Q:'TMP K ^(TMP,"NUM")
S NAME=""
F S NAME=$O(^BYIMPARA("NMNAME",NAME)) Q:NAME="" D
.S DA(1)=0
.F S DA(1)=$O(^BYIMPARA("NMNAME",NAME,DA(1))) Q:'DA(1) D
..S J=0
..S DA=0
..F S DA=$O(^BYIMPARA("NMNAME",NAME,DA(1),DA)) Q:'DA S J=J+1 D:J>1
...S DIK="^BYIMPARA("_DA(1)_",4,"
...D ^DIK
Q
;-----
NCNT ;COUNT NEW IMMS PRIOR TO NEW IMPORT
N A,B,C,DOB
S BYIMNCNT=0
S DOB=0
F S DOB=$O(^BYIMXTMP("BYIM",DOB)) Q:'DOB D
.S A=""
.F S A=$O(^BYIMXTMP("BYIM",DOB,A)) Q:A="" D
..S B=0
..F S B=$O(^BYIMXTMP("BYIM",DOB,A,B)) Q:'B D
...S C=0
...F S C=$O(^BYIMXTMP("BYIM",DOB,A,B,C)) Q:'C D
....S X=0
....F S X=$O(^BYIMXTMP("BYIM",DOB,A,B,C,X)) Q:'X D
.....S BYIMNCNT=BYIMNCNT+1
Q
;-----
P4 ;EP;FOR VERSION 2.0 PATCH 4
Q
;-----
P5 ;EP;FOR VERSION 2.0 PATCH 5
;IMPROVED IZFS DISPLAY
;CORRECT HFSA^BYIMIMM6 CALL
;CORRECT SCRN^BYIMIMMT BYIMALL VARIABLE
;RE-COMPILE 'HL IHS IZV04 OUT'
;SET ALL 'LAST EXPORT' PIECE 2 $H
S MESS=$O(^INTHL7M("B","HL IHS IZV04 OUT",0))
Q:'MESS
S SEG=""
S X=0
F S X=$O(^INTHL7M(MESS,1,X)) Q:'X I $G(^(X,4))["$$SCRN" S ^(4)="I $$SCRN^BYIMIMM6(.INDA)",SEG=X
Q:'SEG
S SCR=$O(^INRHS("B","Generated: HL IHS IZV04 OUT-O",0))
Q:SCR'=$P($G(^INTHL7M(MESS,"S")),U,2)
S Y=MESS
S INGALL=1
S INSS=SCR
D EN^INHSGZ
N X
S X=0
F S X=$O(^BYIMPARA($$DUZ^BYIMIMM(),"LAST EXPORT",X)) Q:'X I X'=DT,$G(^(X)),'$P(^(X),U,2) S $P(^BYIMPARA($$DUZ^BYIMIMM(),"LAST EXPORT",X),U,2)=$P(^BYIMPARA($$DUZ^BYIMIMM(),"LAST EXPORT",X),U)
Q
;-----
P6 ;EP;FOR VERSION 2.0 PATCH 6
N X,Y,Z
S X=+$O(^INTHL7F("B","HL IHS IZV04 MSH-05 RECEIVING APP",0))
K ^INTHL7F(X,5)
Q
;-----
P7 ;EP;FOR VERSION 2.0 PATCH 7
Q
;-----
P8 ;EP;FOR VERSION 2.0 PATCH 8
Q
;-----
P9 ;EP;FOR VERSION 2.0 PATCH 9
F X="XPO1","XPZ1","XPZ2","XPI1" S XPDDIQ(X)=0
Q
;-----
P10 ;EP;
D SCREEN
Q
;-----
SCREEN ;EP;ADD SCREEN CALL TO HL7 MESSAGE
N X,Y,Z
S X=$O(^INTHL7M("B","HL IHS IZV04 OUT",0))
Q:'X
S Y=$O(^INTHL7S("B","HL IHS IZV04 ORC",0))
Q:'Y
S Z=$O(^INTHL7M(X,1,"B",Y,0))
Q:'Z
S ^INTHL7M(X,1,Z,4)="I $$SCRN^BYIMIMM6(.INDA)"
S Y=X
S INGALL=1
D EN^INHSGZ
Q
;-----
P3 ;EP;FOR VERSION 2.0 PATCH 3
Q
;-----
V3 ;EP;FOR VERSION 3.0 POST INSTALL RE-INDEX
N X
S X=$O(^DIC(9.4,"C","BYIM",0))
S:X $P(^DIC(9.4,X,"VERSION"),U)="2.0"
Q:$D(^BYIMEXP("D"))
N J,X,Y,Z
S J=0
S X=0
F S X=$O(^BYIMEXP(X)) Q:'X S Y=^(X,0) I $P(Y,U,4)="E" D
.S ^BYIMEXP("D",+$P(Y,U,3),X)=""
.S J=J+1
.W:J#10000=0 "."
Q
;-----
BYIMIMM2 ;IHS/CIM/THL - IMMUNIZATION DATA EXCHANGE;
+1 ;;2.0;BYIM IMMUNIZATION DATA EXCHANGE;**3,4,5,6,7,8,9**;JUL 11, 2017;Build 22
+2 ;;CONTINUATION OF BYIMIMM
+3 ;
+4 ;-----
MATCH ;EP;COUNT NUMBER OF MATCHES
+1 NEW A,B,C,DOB,K
+2 SET K=0
+3 SET DOB=0
+4 FOR
SET DOB=$ORDER(^BYIMXTMP("BYIM",DOB))
IF 'DOB
QUIT
Begin DoDot:1
+5 SET A=""
+6 FOR
SET A=$ORDER(^BYIMXTMP("BYIM",DOB,A))
IF A=""
QUIT
Begin DoDot:2
+7 SET B=0
+8 FOR
SET B=$ORDER(^BYIMXTMP("BYIM",DOB,A,B))
IF 'B
QUIT
Begin DoDot:3
+9 SET C=0
+10 FOR
SET C=$ORDER(^BYIMXTMP("BYIM",DOB,A,B,C))
IF 'C
QUIT
Begin DoDot:4
+11 SET X=0
+12 FOR
SET X=$ORDER(^BYIMXTMP("BYIM",DOB,A,B,C,X))
IF 'X
QUIT
Begin DoDot:5
+13 SET K=K+1
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+14 SET K=K-BYIMNCNT
+15 USE 0
+16 WRITE !!,"Import information:"
+17 WRITE !,"-------------------"
+18 WRITE !,"Number of immunizations already listed in IZAD prior to this import"
+19 WRITE !,"that need to be reviewed to be added to RPMS: ",BYIMNCNT
+20 WRITE !,"Number of patients in this import file.....: ",MSGCNT
+21 WRITE !,"Number of immunizations in this import file: ",RXACNT
+22 WRITE !,"Number of immunizations in this import that can be added to RPMS..: ",K
+23 WRITE !,"Number of immunizations in this import that can't be added to RPMS: ",RXACNT-K
+24 WRITE !,"(No Patient match or immunization already in RPMS)",!
+25 DO PAUSE^BYIMIMM6
+26 IF '$ORDER(^BYIMPARA($$DUZ^BYIMIMM(),4,0))
QUIT
+27 ;-----
NN ;EP;TO SELECT DEVICE FOR THE NO MATCH REPORT
+1 NEW NMXREF,NMDATE,NMDOB,NMX,NMY,NMZ,NMXX,NMYY,NMZZ
+2 WRITE @IOF
+3 WRITE !?10,"Select sequence for NO MATCH report"
+4 KILL DIR
+5 SET DIR(0)="SO^1:Patient Name;2:Date of Birth;3:Import File Date"
+6 SET DIR("A")="Report sequence"
+7 DO ^DIR
+8 KILL DIR
+9 IF 'Y
QUIT
+10 IF Y=1
Begin DoDot:1
+11 SET NMXREF="NMNAME"
+12 SET NMXX="------------------------------"
+13 SET NMYY="--------"
+14 SET NMZZ="--------"
+15 SET NMX="PATIENT NAME"
+16 SET NMY="DOB"
+17 SET NMZ="IMP DATE"
End DoDot:1
+18 IF Y=2
Begin DoDot:1
+19 SET NMXREF="NMDOB"
+20 SET NMXX="--------"
+21 SET NMYY="------------------------------"
+22 SET NMZZ="--------"
+23 SET NMX="DOB"
+24 SET NMY="PATIENT NAME"
+25 SET NMZ="IMP DATE"
End DoDot:1
+26 IF Y=3
Begin DoDot:1
+27 SET NMXREF="NMDATE"
+28 SET NMXX="--------"
+29 SET NMYY="------------------------------"
+30 SET NMZZ="--------"
+31 SET NMX="IMP DATE"
+32 SET NMY="PATIENT NAME"
+33 SET NMZ="DOB"
End DoDot:1
+34 SET BYIMRTN="NONAME^BYIMIMM2"
+35 DO ZIS^BYIMXIS
+36 QUIT
+37 ;-----
NONAME ;EP;TO DISPLAY NO MATCH REPORT
+1 KILL BYIMQUIT
+2 FOR
DO NONAME1
IF $DATA(BYIMQUIT)
QUIT
+3 KILL ^BYIMXTMP("BYIM","NO MATCH NAME")
+4 QUIT
NONAME1 ;
+1 NEW XX,YY,J,JJ,XXX,BYIMX
+2 DO NN1
+3 SET J=0
+4 SET XXX=""
+5 SET DFN=""
+6 FOR
SET DFN=$ORDER(^BYIMPARA(NMXREF,DFN))
IF DFN=""!(XXX=U)
QUIT
Begin DoDot:1
+7 SET YY=0
+8 FOR
SET YY=$ORDER(^BYIMPARA(NMXREF,DFN,$$DUZ^BYIMIMM(),YY))
IF 'YY!(XXX=U)
QUIT
Begin DoDot:2
+9 SET Y=^BYIMPARA($$DUZ^BYIMIMM(),4,YY,0)
+10 DO N1
End DoDot:2
End DoDot:1
+11 IF 'JJ
SET BYIMQUIT=1
QUIT
+12 IF $DATA(ZTQUEUED)
SET BYIMQUIT=1
QUIT
+13 IF IO'=$PIECE(IO("HOME"),U,2)
SET BYIMQUIT=1
QUIT
+14 SET DIR(0)="LO^1:"_JJ
+15 SET DIR("A")="Select Names to Remove from the No Match List"
+16 WRITE !
+17 DO ^DIR
+18 KILL DIR
+19 IF 'Y
SET BYIMQUIT=1
QUIT
+20 NEW XX,BYIMY,JJ
+21 MERGE BYIMY=Y
+22 SET XX=""
+23 FOR
SET XX=$ORDER(BYIMY(XX))
IF XX=""
QUIT
Begin DoDot:1
+24 SET YY=BYIMY(XX)
+25 FOR JJ=1:1
SET ZZ=$PIECE(YY,",",JJ)
IF ZZ=""
QUIT
Begin DoDot:2
+26 SET DA(1)=$$DUZ^BYIMIMM()
+27 SET DA=$GET(BYIMX(ZZ))
+28 IF 'DA
QUIT
+29 SET DIK="^BYIMPARA("_$$DUZ^BYIMIMM()_",4,"
+30 DO ^DIK
End DoDot:2
End DoDot:1
+31 WRITE @IOF
+32 QUIT
+33 ;-----
N1 SET NAME=$PIECE(Y,U)
+1 SET DOB=$PIECE(Y,U,2)
+2 IF $LENGTH(DOB)=7
SET DOB=DOB+17000000
+3 SET FILE=$PIECE(Y,U,3)
+4 SET SEX=$PIECE(Y,U,4)
+5 SET MM=$PIECE(Y,U,5)
+6 SET MES=$PIECE(Y,U,6)
+7 IF NMXREF="NMNAME"
SET X=DFN
SET Y=DOB
SET Z=FILE
+8 IF NMXREF="NMDATE"
SET X=DFN
SET Y=NAME
SET Z=DOB
+9 IF NMXREF="NMDOB"
SET X=DFN
SET Y=NAME
SET Z=FILE
+10 SET J=J+1
+11 SET BYIMX(J)=YY
+12 WRITE !,J,?4,X
+13 IF NMXREF="NMNAME"
WRITE ?35
+14 IF NMXREF="NMDATE"!(NMXREF="NMDOB")
WRITE ?13
+15 WRITE Y,?44,Z,?53,SEX
+16 NEW XPAT
+17 SET XPAT=$ORDER(^DPT("B",X,0))
+18 IF 'XPAT!(MM]"")
WRITE " (",$SELECT(MM]"":MM,1:"NAME")," MISMATCH)"
+19 SET ^BYIMXTMP("BYIM","NO MATCH NAME",J)=$$DUZ^BYIMIMM()_U_YY
+20 IF '$DATA(ZTQUEUED)
IF IO=$PIECE(IO("HOME"),U,2)
IF J#20=0
WRITE !
DO PAUSE^BYIMIMM6
IF X["^"
SET BYIMQUIT=""
SET XXX=U
+21 QUIT
+22 ;-----
NN1 ;NO NAME HEADER
+1 SET JJ=0
+2 SET X=0
+3 FOR
SET X=$ORDER(^BYIMPARA($$DUZ^BYIMIMM(),4,X))
IF 'X
QUIT
SET JJ=JJ+1
+4 WRITE !!,"Patients for whom there is no matching patient in RPMS: (TOTAL: ",JJ,")"
+5 WRITE !!,"#",?4,NMX
+6 IF NMXREF="NMNAME"
WRITE ?35
+7 IF NMXREF="NMDATE"!(NMXREF="NMDOB")
WRITE ?13
+8 WRITE NMY
+9 WRITE ?44,NMZ,?53,"SEX"
+10 WRITE !,"---",?4,NMXX
+11 IF NMXREF="NMNAME"
WRITE ?35
+12 IF NMXREF="NMDATE"!(NMXREF="NMDOB")
WRITE ?13
+13 WRITE NMYY
+14 WRITE ?44,"--------",?53,"---"
+15 QUIT
+16 ;-----
AUTOIMP ;EP;TO AUTOMATICALLY IMPORT IMMUNIZATIONS
+1 KILL BYIMQUIT
+2 NEW AUTOIMP,AUTOADD,DIR,FILE
+3 SET AUTOIMP=$PIECE($GET(^BYIMPARA($$DUZ^BYIMIMM(),0)),U,4)
+4 SET AUTOADD=$PIECE($GET(^BYIMPARA($$DUZ^BYIMIMM(),0)),U,5)
+5 DO PATH^BYIMIMM6
+6 IF IPATH=""
QUIT
+7 SET DIR=$$LIST^%ZISH(IPATH,"*",.DIR)
+8 SET FILE=""
+9 SET XX=0
+10 FOR
SET XX=$ORDER(DIR(XX))
IF 'XX
QUIT
IF DIR(XX)]""
SET FILE(DIR(XX))=""
+11 SET XX=""
+12 FOR
SET XX=$ORDER(FILE(XX))
IF XX=""
QUIT
IF XX["izdata"&(XX[".dat"!(XX[".hl7"))
SET FILE=XX
+13 IF FILE=""
QUIT
+14 NEW DA,BYIMQUIT
+15 SET DA=0
+16 FOR
SET DA=$ORDER(^BYIMPARA("FILE",FILE,$$DUZ^BYIMIMM(),DA))
IF 'DA
QUIT
Begin DoDot:1
+17 IF $PIECE($GET(^BYIMPARA($$DUZ^BYIMIMM(),2,+DA,0)),U,3)="I"
SET BYIMQUIT=1
End DoDot:1
+18 IF $GET(BYIMQUIT)
KILL BYIMQUIT
QUIT
+19 DO I1^BYIMIMM1
+20 QUIT
+21 ;-----
FLIP ;EP;FLIP OLD HIPAA FORMAT TO NEW
+1 WRITE !!,"Please standby and do not interrupt this process..."
+2 NEW DATE,BYIMDFN,IMM,XX
+3 SET XX=0
+4 FOR
SET XX=$ORDER(^BYIMPARA(XX))
IF 'XX
QUIT
DO F1
+5 QUIT
+6 ;-----
F1 SET DATE=0
+1 MERGE ^BYIMTEMP(XX,"LAST EXPORT")=^BYIMPARA(XX,"LAST EXPORT")
+2 FOR
SET DATE=$ORDER(^BYIMPARA(XX,"LAST EXPORT",DATE))
IF 'DATE
QUIT
Begin DoDot:1
+3 SET IMM=0
+4 FOR
SET IMM=$ORDER(^BYIMPARA(XX,"LAST EXPORT",DATE,1,IMM))
IF 'IMM
QUIT
Begin DoDot:2
+5 SET BYIMDFN=$PIECE($GET(^AUPNVIMM(IMM,0)),U,2)
+6 IF 'BYIMDFN
QUIT
+7 IF $DATA(^BYIMEXP("AC",BYIMDFN,DATE))
QUIT
+8 KILL DIE,DIC,DINUM,DR,DA,DD,DO,DIK,DLAYGO
+9 SET DIC="^BYIMEXP("
+10 SET DIC(0)="L"
+11 SET DIC("DR")=".02////"_DATE_";.03////"_IMM
+12 SET X=BYIMDFN
+13 DO FILE^DICN
+14 KILL DIE,DIC,DINUM,DR,DA,DD,DO,DIK,DLAYGO
+15 KILL ^BYIMPARA(XX,"LAST EXPORT",DATE,1,IMM)
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;-----
SHOW ;EP;TO SHOW ALL EXPORTS FOR SELECTED PATIENT
+1 KILL BYIMQUIT
+2 FOR
DO S1
IF $DATA(BYIMQUIT)
QUIT
+3 QUIT
+4 ;-----
S1 ;SELECT PATIENT AND DATE
+1 DO SKILL
+2 DO SPAT
+3 IF '$GET(BYIMDFN)
QUIT
+4 DO SZIS
+5 QUIT
+6 ;-----
SKILL ;KILL SHOW VARIABLES
+1 KILL BYIMDFN,DIC,DIE,DIR,DA,DR,XX,BYIMDATE
+2 QUIT
+3 ;-----
SPAT ;SELECT SHOW PATIENT
+1 SET DIC="^DPT("
+2 SET DIC(0)="AEMQZ"
+3 SET DIC("A")="Enter Name, HRN or DOB: "
+4 SET DIC("S")="I $D(^BYIMEXP(""B"",+Y))"
+5 WRITE !,@IOF
+6 WRITE !!,?10,"Select the patient to review:",!!
+7 DO ^DIC
+8 KILL DIC,DINUM,DR,DA,DLAYGO
+9 IF +Y<1
SET BYIMQUIT=""
QUIT
+10 SET BYIMDFN=+Y
+11 QUIT
+12 ;-----
SDATE ;SELECT EXPORT DATE
+1 SET DIR(0)="DO^:"_DT
+2 SET DIR("A")="Select EXPORT DATE"
+3 DO ^DIR
+4 KILL DIR
+5 IF $LENGTH(Y)'=7
QUIT
+6 SET BYIMDATE=Y
+7 QUIT
+8 ;-----
SZIS ;SELECT DEVICE AND DISPLAY REPORT
+1 SET BYIMRTN="SDISP^BYIMIMM2"
+2 DO ZIS^BYIMXIS
+3 QUIT
+4 ;-----
SDISP ;EP;SHOW DISPLAY OF PATIENT'S IMMUNIZATIONS EXPORTED
+1 ;PATCH 4
+2 SET TYPE="E"
+3 ;END PATCH 4
+4 SET NAME=$PIECE(^DPT(BYIMDFN,0),U)
+5 SET DOB=$PIECE(^DPT(BYIMDFN,0),U,3)+17000000
+6 SET HRN=$PIECE(^AUPNPAT(BYIMDFN,41,$$DUZ^BYIMIMM(),0),U,2)
+7 DO SHEAD
+8 SET J=0
+9 SET XX=0
+10 FOR
SET XX=$ORDER(^BYIMEXP("B",BYIMDFN,XX))
IF 'XX!$DATA(BYIMQUIT)
QUIT
Begin DoDot:1
+11 SET X=^BYIMEXP(XX,0)
+12 IF $GET(TYPE)]""
IF $PIECE(X,U,4)'=TYPE
QUIT
+13 SET DAT=$PIECE(X,U,2)+17000000
+14 SET IMM=$PIECE(X,U,3)
+15 IF 'IMM
QUIT
+16 ;TO SHOW DELETED V IMMUNIZATIONS
+17 ;Q:'$D(^AUPNVIMM(IMM,0))
+18 ;Q:'$P(^AUPNVIMM(IMM,0),U,3)
+19 SET DAT=$EXTRACT(DAT,5,6)_"/"_$EXTRACT(DAT,7,8)_"/"_$EXTRACT(DAT,1,4)
+20 SET VIS=$PIECE($GET(^AUPNVSIT(+$PIECE($GET(^AUPNVIMM(+IMM,0)),U,3),0)),".")
+21 ;Q:'VIS
+22 IF $LENGTH(VIS)=7
SET VIS=VIS+17000000
+23 SET INAM=$PIECE($GET(^AUTTIMM(+$GET(^AUPNVIMM(+IMM,0)),0)),U)
+24 IF VIS
SET VIS=$EXTRACT(VIS,5,6)_"/"_$EXTRACT(VIS,7,8)_"/"_$EXTRACT(VIS,1,4)
+25 WRITE !?5,DAT,?18,$EXTRACT(INAM,1,20),?40,VIS
+26 IF '$DATA(^AUPNVIMM(IMM,0))
IF VIS]""
WRITE !
WRITE "V IMMUNIZATION has been deleted"
+27 ;END
+28 SET J=J+1
+29 IF IOST["C-"
IF J#15=0
DO READ
DO SHEAD
End DoDot:1
+30 KILL BYIMQUIT
+31 ;-----
READ NEW XXX
+1 IF '$DATA(ZTQUEUED)
DO PAUSE^BYIMIMM6
IF X["^"
SET BYIMQUIT=""
QUIT
+2 QUIT
+3 ;-----
SHEAD ;EP;HEADER FOR EXPORT LIST DISPLAY
+1 WRITE @IOF
+2 WRITE !!,"Immunization Export summary for: "
+3 WRITE !,NAME,?30,"DOB: ",$EXTRACT(DOB,5,6),"/",$EXTRACT(DOB,7,8),"/",$EXTRACT(DOB,1,4),?47,"HRN: ",HRN
+4 WRITE !!?5,"Export Date",?18,"Immunization",?40,"Admin Date"
+5 WRITE !?5,"-----------",?18,"--------------------",?40,"----------"
+6 QUIT
+7 ;-----
INSET ;EP;TO PROCESS INCOMING HL7 MESSAGES
+1 NEW MSH
+2 SET MSH=$EXTRACT(X,1,3)
+3 IF MSH="MSH"
SET MSHX=X
+4 IF MSHX'["|VX"&(MSHX'["^V0")
QUIT
+5 IF MSH["|"
QUIT
+6 SET BYIMX=X
+7 IF MSH="MSH"
Begin DoDot:1
+8 SET MSGCNT=MSGCNT+1
+9 SET J=J+1
+10 DO NEWMSG
+11 SET ^INTHU(INHDA,3,1,0)=BYIMX
+12 IF '$DATA(ZTQUEUED)
USE 0
WRITE "."
End DoDot:1
+13 IF MSH="PID"
SET ^INTHU(INHDA,3,2,0)=BYIMX
+14 IF MSH="RXA"
SET BYIMJ=BYIMJ+1
SET ^INTHU(INHDA,3,BYIMJ,0)=BYIMX
SET RXACNT=RXACNT+1
+15 QUIT
+16 ;-----
NEWMSG ;CREATE NEW INTHU ENTRY
+1 DO NOW^%DTC
+2 SET X=%
+3 KILL DIE,DIC,DINUM,DR,DA,DD,DO,DIK,DLAYGO
+4 SET DIC="^INTHU("
+5 SET DIC(0)="L"
+6 SET DLAYGO=4001
+7 DO FILE^DICN
+8 KILL DIE,DIC,DINUM,DR,DA,DD,DO,DIK,DLAYGO
+9 SET INHDA=+Y
+10 SET BYIMJ=2
+11 SET ^BYIMTMP($JOB,"BYIM IMM",INHDA)=""
+12 QUIT
+13 ;-----
KILL ;EP;KILL TEMP GLOBAL ENTRY IF THERE IS EXACT MATCH OR MATCH FOR
+1 ;AN EQUIVALENT IMMUNIZATION OR IMMUNIZATION MATCH WITHIN 5 DAYS
+2 NEW KILL,K,ZB,ZA,X,ZZ,DO
+3 SET KILL=$PIECE(^AUTTIMM(+Y,0),U,12)
+4 IF +Y=103
SET KILL=$PIECE(^AUTTIMM(133,0),U,12)
+5 IF +Y=106
SET KILL=$PIECE(^AUTTIMM(107,0),U,12)
+6 IF +Y=148
SET KILL=KILL_",140,141"
+7 IF +Y=242
SET KILL=KILL_",15,141"
+8 IF +Y=243
SET KILL=KILL_",15,140"
+9 SET Y=+$PIECE($GET(^AUTTIMM(+Y,0)),U,3)
+10 SET KILL=Y_","_KILL
+11 SET DO="T"_Y
+12 SET X=$TEXT(@DO)
+13 IF X]""
DO @DO
+14 DO K1
+15 QUIT
+16 ;-----
K1 ;KILL TEMP GLOBAL IF EQUIVALENT IMM ON FILE
+1 IF "^20^22^28^50^102^106^"[(U_Y_U)
SET KILL="1,20,22,28,50,102,106,"_KILL
+2 IF "^10^"[(U_Y_U)
SET KILL="2,10,"_KILL
+3 IF "^49^"[(U_Y_U)
SET KILL="120,"_KILL
+4 IF "^42^43^44^45^51^104^"[(U_Y_U)
SET KILL="8,42,43,44,45,51,104,"_KILL
+5 FOR K=1:1
SET Y=$PIECE(KILL,",",K)
IF Y=""
QUIT
IF $DATA(^BYIMXTMP("BYIM",DOB,NAME,DFN,Y))
Begin DoDot:1
+6 SET ^BYIMXTMP("BYIM",DOB,NAME,DFN,Y,Z)=""
+7 KILL ^BYIMXTMP("BYIM",DOB,NAME,DFN,Y,Z)
+8 IF '$DATA(^BYIMXTMP("BYIM",DOB,NAME,DFN,Y))
QUIT
+9 SET (X1,ZZ)=$ORDER(^BYIMXTMP("BYIM",DOB,NAME,DFN,Y,Z),-1)
+10 IF X1
Begin DoDot:2
+11 SET X2=Z
+12 DO ^%DTC
+13 IF X<0
SET X=X*-1
+14 IF X<6
KILL ^BYIMXTMP("BYIM",DOB,NAME,DFN,Y,ZZ),^(Z)
End DoDot:2
+15 SET (X1,ZZ)=$ORDER(^BYIMXTMP("BYIM",DOB,NAME,DFN,Y,Z))
+16 IF 'X1
QUIT
+17 SET X2=Z
+18 DO ^%DTC
+19 IF X<0
SET X=X*-1
+20 IF X<6
KILL ^BYIMXTMP("BYIM",DOB,NAME,DFN,Y,ZZ),^(Z)
End DoDot:1
+21 QUIT
+22 ;-----
T1 DO T20
+1 QUIT
+2 ;-----
T2 SET KILL=2
+1 QUIT
+2 ;-----
T5 SET KILL=$PIECE(KILL,",94")_$PIECE(KILL,",94",2)
+1 QUIT
+2 ;-----
T6 SET KILL=$PIECE(KILL,",94")_$PIECE(KILL,",94",2)
+1 QUIT
+2 ;-----
T7 SET KILL=$PIECE(KILL,",94")_$PIECE(KILL,",94",2)
+1 QUIT
+2 ;-----
T8 SET KILL=$PIECE(KILL,",51")_$PIECE(KILL,",51",2)
+1 SET KILL=$PIECE(KILL,",110")_$PIECE(KILL,",110",2)
+2 SET KILL=$PIECE(KILL,",104")_$PIECE(KILL,",104",2)
+3 QUIT
+4 ;-----
T10 SET KILL=10
+1 QUIT
+2 ;-----
T17 SET KILL=$PIECE(KILL,",110")_$PIECE(KILL,",110",2)
+1 QUIT
+2 ;-----
T20 SET KILL=$PIECE(KILL,",110")_$PIECE(KILL,",110",2)
+1 SET KILL=$PIECE(KILL,",50")_$PIECE(KILL,",50",2)
+2 QUIT
+3 ;-----
T21 SET KILL=21
+1 QUIT
+2 ;-----
T28 SET KILL=$PIECE(KILL,",110")_$PIECE(KILL,",110",2)
+1 SET KILL=$PIECE(KILL,",50")_$PIECE(KILL,",50",2)
+2 QUIT
+3 ;-----
T38 SET KILL=$PIECE(KILL,",94")_$PIECE(KILL,",94",2)
+1 QUIT
+2 ;-----
T42 SET KILL=$PIECE(KILL,",104")_$PIECE(KILL,",104",2)
+1 QUIT
+2 ;-----
T43 SET KILL=$PIECE(KILL,",104")_$PIECE(KILL,",104",2)
+1 QUIT
+2 ;-----
T44 SET KILL=$PIECE(KILL,",104")_$PIECE(KILL,",104",2)
+1 QUIT
+2 ;-----
T45 SET KILL=$PIECE(KILL,",51")_$PIECE(KILL,",51",2)
+1 SET KILL=$PIECE(KILL,",110")_$PIECE(KILL,",110",2)
+2 SET KILL=$PIECE(KILL,",104")_$PIECE(KILL,",104",2)
+3 QUIT
+4 ;-----
T50 SET KILL=$PIECE(KILL,",110")_$PIECE(KILL,",110",2)
+1 SET KILL=$PIECE(KILL,",51")_$PIECE(KILL,",51",2)
+2 QUIT
+3 ;-----
T52 SET KILL=$PIECE(KILL,",104")_$PIECE(KILL,",104",2)
+1 QUIT
+2 ;-----
T83 SET KILL=$PIECE(KILL,",104")_$PIECE(KILL,",104",2)
+1 QUIT
+2 ;-----
T84 SET KILL=$PIECE(KILL,",104")_$PIECE(KILL,",104",2)
+1 QUIT
+2 ;-----
T85 SET KILL=$PIECE(KILL,",104")_$PIECE(KILL,",104",2)
+1 QUIT
+2 ;-----
T104 SET KILL=$PIECE(KILL,",51")_$PIECE(KILL,",51",2)
+1 SET KILL=$PIECE(KILL,",110")_$PIECE(KILL,",110",2)
+2 QUIT
+3 ;-----
T106 SET KILL=$PIECE(KILL,",110")_$PIECE(KILL,",110",2)
+1 SET KILL=$PIECE(KILL,",50")_$PIECE(KILL,",50",2)
+2 QUIT
+3 ;-----
T107 SET KILL=$PIECE(KILL,",110")_$PIECE(KILL,",110",2)
+1 SET KILL=$PIECE(KILL,",50")_$PIECE(KILL,",50",2)
+2 QUIT
+3 ;-----
T110 SET KILL=$PIECE(KILL,",22")_$PIECE(KILL,",22",2)
+1 SET KILL=$PIECE(KILL,",102")_$PIECE(KILL,",102",2)
+2 SET KILL=$PIECE(KILL,",50")_$PIECE(KILL,",50",2)
+3 QUIT
+4 ;-----
T120 SET KILL=$PIECE(KILL,",51")_$PIECE(KILL,",51",2)
+1 SET KILL=$PIECE(KILL,",102")_$PIECE(KILL,",102",2)
+2 SET KILL=$PIECE(KILL,",110")_$PIECE(KILL,",110",2)
+3 QUIT
+4 ;-----
T121 SET KILL=$PIECE(KILL,",94")_$PIECE(KILL,",94",2)
+1 SET KILL=$PIECE(KILL,",117")_$PIECE(KILL,",117",2)
+2 QUIT
+3 ;-----
P2 ;EP;FOR PATCH 2 POST INSTALL PROCESSING
+1 ;PATCH 2
+2 DO LOC^BYIMIMM3
+3 IF $PIECE($GET(^DIC(9.4,+$ORDER(^DIC(9.4,"C","BYIM",0)),"VERSION")),U)=2.01
SET $PIECE(^("VERSION"),U)="2.0"
+4 NEW TMP
+5 SET TMP=0
+6 FOR
SET TMP=$ORDER(^BYIMTMP(TMP))
IF 'TMP
QUIT
KILL ^(TMP,"NUM")
+7 SET NAME=""
+8 FOR
SET NAME=$ORDER(^BYIMPARA("NMNAME",NAME))
IF NAME=""
QUIT
Begin DoDot:1
+9 SET DA(1)=0
+10 FOR
SET DA(1)=$ORDER(^BYIMPARA("NMNAME",NAME,DA(1)))
IF 'DA(1)
QUIT
Begin DoDot:2
+11 SET J=0
+12 SET DA=0
+13 FOR
SET DA=$ORDER(^BYIMPARA("NMNAME",NAME,DA(1),DA))
IF 'DA
QUIT
SET J=J+1
IF J>1
Begin DoDot:3
+14 SET DIK="^BYIMPARA("_DA(1)_",4,"
+15 DO ^DIK
End DoDot:3
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;-----
NCNT ;COUNT NEW IMMS PRIOR TO NEW IMPORT
+1 NEW A,B,C,DOB
+2 SET BYIMNCNT=0
+3 SET DOB=0
+4 FOR
SET DOB=$ORDER(^BYIMXTMP("BYIM",DOB))
IF 'DOB
QUIT
Begin DoDot:1
+5 SET A=""
+6 FOR
SET A=$ORDER(^BYIMXTMP("BYIM",DOB,A))
IF A=""
QUIT
Begin DoDot:2
+7 SET B=0
+8 FOR
SET B=$ORDER(^BYIMXTMP("BYIM",DOB,A,B))
IF 'B
QUIT
Begin DoDot:3
+9 SET C=0
+10 FOR
SET C=$ORDER(^BYIMXTMP("BYIM",DOB,A,B,C))
IF 'C
QUIT
Begin DoDot:4
+11 SET X=0
+12 FOR
SET X=$ORDER(^BYIMXTMP("BYIM",DOB,A,B,C,X))
IF 'X
QUIT
Begin DoDot:5
+13 SET BYIMNCNT=BYIMNCNT+1
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;-----
P4 ;EP;FOR VERSION 2.0 PATCH 4
+1 QUIT
+2 ;-----
P5 ;EP;FOR VERSION 2.0 PATCH 5
+1 ;IMPROVED IZFS DISPLAY
+2 ;CORRECT HFSA^BYIMIMM6 CALL
+3 ;CORRECT SCRN^BYIMIMMT BYIMALL VARIABLE
+4 ;RE-COMPILE 'HL IHS IZV04 OUT'
+5 ;SET ALL 'LAST EXPORT' PIECE 2 $H
+6 SET MESS=$ORDER(^INTHL7M("B","HL IHS IZV04 OUT",0))
+7 IF 'MESS
QUIT
+8 SET SEG=""
+9 SET X=0
+10 FOR
SET X=$ORDER(^INTHL7M(MESS,1,X))
IF 'X
QUIT
IF $GET(^(X,4))["$$SCRN"
SET ^(4)="I $$SCRN^BYIMIMM6(.INDA)"
SET SEG=X
+11 IF 'SEG
QUIT
+12 SET SCR=$ORDER(^INRHS("B","Generated: HL IHS IZV04 OUT-O",0))
+13 IF SCR'=$PIECE($GET(^INTHL7M(MESS,"S")),U,2)
QUIT
+14 SET Y=MESS
+15 SET INGALL=1
+16 SET INSS=SCR
+17 DO EN^INHSGZ
+18 NEW X
+19 SET X=0
+20 FOR
SET X=$ORDER(^BYIMPARA($$DUZ^BYIMIMM(),"LAST EXPORT",X))
IF 'X
QUIT
IF X'=DT
IF $GET(^(X))
IF '$PIECE(^(X),U,2)
SET $PIECE(^BYIMPARA($$DUZ^BYIMIMM(),"LAST EXPORT",X),U,2)=$PIECE(^BYIMPARA($$DUZ^BYIMIMM(),"LAST EXPORT",X),U)
+21 QUIT
+22 ;-----
P6 ;EP;FOR VERSION 2.0 PATCH 6
+1 NEW X,Y,Z
+2 SET X=+$ORDER(^INTHL7F("B","HL IHS IZV04 MSH-05 RECEIVING APP",0))
+3 KILL ^INTHL7F(X,5)
+4 QUIT
+5 ;-----
P7 ;EP;FOR VERSION 2.0 PATCH 7
+1 QUIT
+2 ;-----
P8 ;EP;FOR VERSION 2.0 PATCH 8
+1 QUIT
+2 ;-----
P9 ;EP;FOR VERSION 2.0 PATCH 9
+1 FOR X="XPO1","XPZ1","XPZ2","XPI1"
SET XPDDIQ(X)=0
+2 QUIT
+3 ;-----
P10 ;EP;
+1 DO SCREEN
+2 QUIT
+3 ;-----
SCREEN ;EP;ADD SCREEN CALL TO HL7 MESSAGE
+1 NEW X,Y,Z
+2 SET X=$ORDER(^INTHL7M("B","HL IHS IZV04 OUT",0))
+3 IF 'X
QUIT
+4 SET Y=$ORDER(^INTHL7S("B","HL IHS IZV04 ORC",0))
+5 IF 'Y
QUIT
+6 SET Z=$ORDER(^INTHL7M(X,1,"B",Y,0))
+7 IF 'Z
QUIT
+8 SET ^INTHL7M(X,1,Z,4)="I $$SCRN^BYIMIMM6(.INDA)"
+9 SET Y=X
+10 SET INGALL=1
+11 DO EN^INHSGZ
+12 QUIT
+13 ;-----
P3 ;EP;FOR VERSION 2.0 PATCH 3
+1 QUIT
+2 ;-----
V3 ;EP;FOR VERSION 3.0 POST INSTALL RE-INDEX
+1 NEW X
+2 SET X=$ORDER(^DIC(9.4,"C","BYIM",0))
+3 IF X
SET $PIECE(^DIC(9.4,X,"VERSION"),U)="2.0"
+4 IF $DATA(^BYIMEXP("D"))
QUIT
+5 NEW J,X,Y,Z
+6 SET J=0
+7 SET X=0
+8 FOR
SET X=$ORDER(^BYIMEXP(X))
IF 'X
QUIT
SET Y=^(X,0)
IF $PIECE(Y,U,4)="E"
Begin DoDot:1
+9 SET ^BYIMEXP("D",+$PIECE(Y,U,3),X)=""
+10 SET J=J+1
+11 IF J#10000=0
WRITE "."
End DoDot:1
+12 QUIT
+13 ;-----
