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

BYIMIMM2.m

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