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

BYIMIMM4.m

Go to the documentation of this file. 
  1. BYIMIMM4 ;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.  ;
  1.  ;-----
  1. MULT ;EP;PROCESS MULTIPLE INBOUND MESSAGES
  1.  K BYIMQUIT
  1.  N AUTOIMP,AUTOADD,DIR,FILE
  1.  S AUTOIMP=1
  1.  S AUTOADD=0
  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=""  D
  1.  .S:XX["izdata"&(XX[".dat"!(XX[".hl7")) FILE=XX
  1.  .Q:FILE=""
  1.  .N DA
  1.  .S DA=0
  1.  .F  S DA=$O(^BYIMPARA("FILE",FILE,$$DUZ^BYIMIMM(),DA)) Q:'DA  I $P($G(^BYIMPARA($$DUZ^BYIMIMM(),2,+DA,0)),U,3)="I" S BYIMQUIT=""
  1.  .I $D(BYIMQUIT) K BYIMQUIT Q
  1.  .D I1^BYIMIMM1
  1.  Q
  1.  ;-----
  1. ASITE(BYIMDA) ;EP;ADDITIONAL EXPORT SITES
  1.  Q:'$G(BYIMDA)
  1.  I $O(^BYIMPARA(BYIMDA,3,0)) D AS Q
  1.  K DIR
  1.  S DIR(0)="YO"
  1.  S DIR("A")="Add export/import information for additional states"
  1.  S DIR("B")="NO"
  1.  W !!
  1.  D ^DIR
  1.  K DIR
  1.  Q:'Y
  1. AS N BYIMAS
  1.  S BYIMQUIT=0
  1.  F  D ASACT Q:BYIMQUIT
  1.  Q
  1.  ;-----
  1. ASACT ;ADDITIONAL SITE ACTION
  1.  I '$O(^BYIMPARA(BYIMDA,3,0)) D ASADD
  1.  I '$O(^BYIMPARA(BYIMDA,3,0)) S BYIMQUIT=1 Q
  1.  D ASD
  1.  K DIR
  1.  S DIR(0)="SO^1:Edit site;2:Add site;3:Delete site"
  1.  W !!
  1.  D ^DIR
  1.  K DIR
  1.  I 'Y S BYIMQUIT=1 Q
  1.  I Y=1 D ASEDIT Q
  1.  I Y=2 D ASADD Q
  1.  I Y=3 D ASDEL
  1.  Q
  1.  ;-----
  1. ASSEL ;SELECT ADDITION SITE
  1.  I J=1 S Y=1 D ASSEL1 Q
  1.  K DIR
  1.  S DIR(0)="NO^1:"_J
  1.  S DIR("A")="Select site number"
  1.  W !!
  1.  D ^DIR
  1.  K DIR
  1. ASSEL1 Q:'Y
  1.  Q:'$G(BYIMAS(Y))
  1.  S DA=BYIMAS(Y)
  1.  Q
  1.  ;-----
  1. ASD ;DISPLAY SITES
  1.  W @IOF
  1.  W !!?10,"Additional EXPORT/IMPORT Site Directories"
  1.  W !!?5,"NUM",?10,"SITE/STATE"
  1.  W !?5,"---",?10,"--------------------------------------------------"
  1.  N X0,X1
  1.  S J=0
  1.  S BYIMAS=0
  1.  F  S BYIMAS=$O(^BYIMPARA(BYIMDA,3,BYIMAS)) Q:'BYIMAS  D
  1.  .S X0=$G(^BYIMPARA(BYIMDA,3,BYIMAS,0))
  1.  .S X1=$G(^BYIMPARA(BYIMDA,3,BYIMAS,1))
  1.  .S J=J+1
  1.  .S BYIMAS(J)=BYIMAS
  1.  .W !?5,J,?10,$P(X0,U)
  1.  .W !?15,"OUTBOUND: ",$P(X0,U,2)
  1.  .W !?15," INBOUND: ",$P(X0,U,3)
  1.  Q
  1.  ;-----
  1. ASADD ;ADD SITES
  1.  N BYIMQUIT
  1.  S BYIMQUIT=0
  1.  S J=0
  1.  N BYIMAS
  1.  S J=J+1
  1.  K DIR
  1.  S DIR(0)="FO^1:10"
  1.  S DIR("A")="NEW interface state name"
  1.  S DIR("?")="Enter a name to identify the additional interface state, 3-10 characters"
  1.  W !!
  1.  D ^DIR
  1.  K DIR
  1.  K DIE,DIC,DINUM,DR,DA,DD,DO,DIK,DLAYGO
  1.  I X=""!(X[U) S BYIMQUIT=1 Q
  1.  S (NSITE,BYIMAS(J))=X
  1.  S DA(1)=BYIMDA
  1.  S DIC="^BYIMPARA("_BYIMDA_",3,"
  1.  S DIC(0)="L"
  1.  S:'$D(^BYIMPARA(BYIMDA,3,0)) ^BYIMPARA(BYIMDA,3,0)="^90480.03"
  1.  D FILE^DICN
  1.  I Y<0 S BYIMQUIT=1 Q
  1.  K DIE,DIC,DINUM,DR,DA,DD,DO,DIK,DLAYGO
  1.  N NSDA
  1.  S (NSDA,DA)=+Y
  1.  N X,Y,Z,ZZ
  1.  S X=$P(^BYIMPARA(BYIMDA,0),U,2)
  1.  S V=$S(X["\":"\",1:"/")
  1.  S NSITE=$$LC(NSITE)
  1.  S X=$$LC(X)
  1.  I X["hlrbridge" D  I 1
  1.  .S X=$P(X,"hl7bridge")
  1.  .S:$E(X,$L(X))'=V X=X_V
  1.  .S Y=X_"hl7bridge"_V_NSITE_V_"responses"
  1.  .S X=X_"hl7bridge"_V_NSITE_V_"requests"
  1.  E  D
  1.  .S X=$P(X,"requests")
  1.  .S:$E(X,$L(X))'=V X=X_V
  1.  .S Y=X_NSITE_V_"responses"
  1.  .S X=X_NSITE_V_"requests"
  1.  S $P(^BYIMPARA(BYIMDA,3,NSDA,0),U,2)=X
  1.  S $P(^BYIMPARA(BYIMDA,3,NSDA,0),U,3)=Y
  1.  S $P(^BYIMPARA(BYIMDA,3,NSDA,0),U,4,13)=$P(^BYIMPARA(BYIMDA,0),U,4,13)
  1.  S DA=NSDA
  1.  D ASE1
  1.  Q
  1.  ;-----
  1. ASEDIT ;EDIT
  1.  D ASSEL
  1.  Q:'$G(DA)
  1. ASE1 S DA(1)=BYIMDA
  1.  ;INCLUDE AGE TO EXPORT FOR ADD. SITES
  1.  S DR=".01T;.02T;.03T;.06T;1.03T;1.04T;1.05T;.07T;1.06T;1.07T;6.03T;6.04T;6.05T;1.08T;.15T;6.11T;6.08T;6.01T;6.02T;6.09T;.17T;6.1T;.08T;.1T;6.07T;.14T;.16T"
  1.  S DIE="^BYIMPARA("_BYIMDA_",3,"
  1.  W !!
  1.  D ^DIE
  1.  K DA,DR,DIE
  1.  Q
  1.  ;-----
  1. ASDEL ;DELETE
  1.  D ASSEL
  1.  ;PATCH 8 CR 08549
  1.  ;Q:DA
  1.  Q:'$G(DA)
  1.  ;PATCH 8 END
  1.  S X=^BYIMPARA(BYIMDA,3,DA,0)
  1.  W !?10,$P(X,U)
  1.  K DIR
  1.  S DIR(0)="YO"
  1.  S DIR("A")="Delete export/import site: "_$P(X,U)
  1.  S DIR("B")="NO"
  1.  W !
  1.  D ^DIR
  1.  K DIR
  1.  Q:Y'=1
  1.  S DA(1)=BYIMDA
  1.  S DIK="^BYIMPARA("_BYIMDA_",3,"
  1.  D ^DIK
  1.  K DA,DIK
  1.  Q
  1.  ;-----
  1. CP(DFN) ;EP;DETERMINE VARICELLA EXPOSURE
  1.  ;DFN = PATIENT DFN
  1.  Q:'$D(^BIPC("B",+DFN))
  1.  N BIX,VDAT
  1.  S BIX=0
  1.  F  S BIX=$O(^BIPC("B",DFN,BIX)) Q:'BIX  S:$P($G(^BIPC(BIX,0)),U,3)=12 VDAT=$P(^(0),U,4)
  1.  Q:$L($G(VDAT))'=7
  1.  S VDAT=VDAT+17000000
  1.  S RXA="RXA|0|1|"_VDAT_"|"_VDAT_"|998^No vaccine administered^CVX|999"
  1.  S OBX="OBX|1|CE|59784-9^Disease with presumed immunity ^LN|1|38907003^Varicella infection^SCT||||||F|CR|"
  1.  N LINE
  1.  S LINE=$O(^UTILITY("INH",$J,9999999999),-1)+1
  1.  S X=U_"UTILITY(""INH"","_$J_","_LINE_")"
  1.  S @X=RXA
  1.  S X=U_"UTILITY(""INH"","_$J_","_(LINE+1)_")"
  1.  S @X=OBX
  1.  Q
  1.  ;-----
  1. IMMDUP ;EP;DEDUP IMMUNIZATIONS
  1.  S DIK="^AUPNVIMM("
  1.  S DFN=0
  1.  F  S DFN=$O(^AUPNVIMM("AC",DFN)) Q:'DFN  D
  1.  .K TMP
  1.  .S IEN=0
  1.  .F  S IEN=$O(^AUPNVIMM("AC",DFN,IEN)) Q:'IEN  D
  1.  ..S X=$P($G(^AUPNVIMM(IEN,0)),U,1,3)
  1.  ..S VIS=$P(X,U,3)
  1.  ..Q:'$P(X,U,2)!'X!'VIS
  1.  ..S DAT=$P($G(^AUPNVSIT(VIS,0)),".")
  1.  ..Q:'DAT
  1.  ..S X=$P(X,U,1,2)_U_DAT
  1.  ..I +X=242 S $P(X,U)=148
  1.  ..I +X=243 S $P(X,U)=148
  1.  ..S TMP(X,IEN)=""
  1.  .S X=""
  1.  .F  S X=$O(TMP(X)) Q:X=""  D
  1.  ..S J=0
  1.  ..S IEN=0
  1.  ..F  S IEN=$O(TMP(X,IEN)) Q:'IEN  D
  1.  ...S J=J+1
  1.  ...Q:J<2
  1.  ...W:'$D(ZTQUEUED) !,DFN,?10,J,?15,IEN,?25,X,?45,$P(^AUTTIMM(+X,0),U,3)
  1.  ...M ^BYIMTMP("BYIM IMM DUPS",DA)=^AUPNVIMM(DA)
  1.  ...S DA=IEN
  1.  ...;D ^DIK
  1.  Q
  1.  ;-----
  1. DEXIT ;EP;CLEAN UP AFTER IZAD
  1.  K ^BYIMTMP($J,"BYIM DISP")
  1.  Q
  1.  ;-----
  1. ALOT(LDA,IVDA) ;EP;ACTIVATE LOT NUMBER
  1.  Q:'LDA
  1.  Q:'$D(^AUTTIML(LDA,0))
  1.  S NEWLOT(LDA)=^AUTTIML(LDA,0)
  1.  I '$P(NEWLOT(LDA),U,4) D
  1.  .S $P(NEWLOT(LDA),U,4)=IVDA
  1.  .S ^AUTTIML("C",IVDA,LDA)=""
  1.  S $P(^AUTTIML(LDA,0),U,3)=0
  1.  S $P(^AUTTIML(LDA,0),U,4)=IVDA
  1.  Q
  1.  ;-----
  1. ILOT(LDA) ;EP;INACTIVATE LOT NUMBER
  1.  Q:'LDA
  1.  Q:'$D(^AUTTIML(LDA,0))
  1.  S:$G(NEWLOT(LDA))]"" ^AUTTIML(LDA,0)=$G(NEWLOT(LDA))
  1.  K NEWLOT
  1.  Q
  1.  ;-----
  1. LV(DFN,IVDA,LOTDA) ;EP;CALCULATE LAST V IMM FOR PAT
  1.  Q:'$G(DFN)!'$G(IVDA)!'$G(LOTDA)
  1.  N XX,YY,ZZ
  1.  S XX=$O(^AUPNVIMM("AC",DFN,9999999999),-1)
  1.  Q:'XX
  1.  S XX0=$G(^AUPNVIMM(XX,0))
  1.  Q:+XX0'=IVDA
  1.  Q:$P(XX0,U,5)
  1.  S $P(^AUPNVIMM(XX,0),U,5)=LOTDA
  1.  Q
  1.  ;-----
  1. MAN(MAN) ;EP;CHECK IMMUNIZATION MAN.
  1.  Q:MAN=""
  1.  S:MAN["\T\" MAN=$P(MAN,"\T\")_"&"_$P(MAN,"\T\",2)
  1.  N X,Y,Z
  1.  S X=MAN
  1.  X ^%ZOSF("UPPERCASE")
  1.  S MAN=Y
  1.  S MANA=$P(MAN,U)
  1.  S MANN=$P(MAN,U,2)
  1.  S MANDA=$O(^AUTTIMAN("B",MANN,0))
  1.  Q:MANDA
  1.  S X=MANN
  1.  S DIC="^AUTTIMAN("
  1.  S DIC(0)="L"
  1.  S DIC("DR")=".02////"_MANA
  1.  D FILE^DICN
  1.  I Y>0 S MANDA=+Y
  1.  Q
  1.  ;-----
  1. LOT(LOT,MAN,IVDA) ;EP;EVALUATE LOT AND MANUFACTURER DATA
  1.  S LOTDA=""
  1.  S MANDA=""
  1.  Q:$G(LOT)=""
  1.  D:MAN]"" MAN^BYIMIMM4(MAN)
  1.  S X=LOT
  1.  X ^%ZOSF("UPPERCASE")
  1.  S LOT=Y
  1.  S LOTDA=$O(^AUTTIML("B",LOT,0))
  1.  I LOTDA D ALOT(LOTDA,IVDA) Q
  1.  S X=LOT
  1.  S DIC="^AUTTIML("
  1.  S DIC(0)="L"
  1.  S DIC("DR")=".02////"_$G(MANDA)_";.03////1;.04////"_IVDA
  1.  D FILE^DICN
  1.  Q:Y<0
  1.  S LOTDA=+Y
  1.  D ALOT(LOTDA,IVDA)
  1.  Q
  1.  ;-----
  1. LOG(FILE,ACT,DFNCNT,IMMCNT,NODFNCNT,NEWIMCNT,ADDIMCNT,PATH,DFN) ;EP;LOG AUTO IMPORT FILES THAT HAVE BEEN PROCESSED
  1.  ;FILE     = NAME OF FILE IMPORTED OR EXPORTED
  1.  ;ACT      = ACTION - 'I'MPORT OR 'E'XPORT
  1.  ;DFNCNT   = NUMBER OF PATIENTS
  1.  ;IMMCNT   = NUMBER OF IMMUNIZATIONS
  1.  ;NODFNCNT = NUMBER OF PATIENTS FOR WHOM THERE IS NO PATIENT MATCH
  1.  ;NEWIMCNT = NUMBER OF NEW IMMUNIZATIONS
  1.  ;ADDIMCNT = NUMBER OF NEW IMMUNIZATIONS ADDED TO V IMMUNIZATIONS
  1.  ;PATH     = DRIVE/DIRECTORY FILE SENT TO
  1.  Q:$G(FILE)=""!($G(ACT)="")
  1.  S X=FILE
  1.  K DIE,DIC,DINUM,DR,DA,DD,DO,DIK,DLAYGO
  1.  S DA(1)=$$DUZ^BYIMIMM()
  1.  S DIC="^BYIMPARA("_DA(1)_",2,"
  1.  S DIC(0)="L"
  1.  S DIC("DR")=".02////"_DT_";.03////"_ACT_";.04////"_$G(DFNCNT)_";.05////"_$G(IMMCNT)
  1.  S:$G(NODFNCNT) DIC("DR")=DIC("DR")_";.06////"_NODFNCNT
  1.  S:$G(NEWIMCNT) DIC("DR")=DIC("DR")_";.07////"_NEWIMCNT
  1.  S:$G(ADDIMCNT) DIC("DR")=DIC("DR")_";.08////"_ADDIMCNT
  1.  S:$G(PATH)]"" DIC("DR")=DIC("DR")_";.09////"_PATH
  1.  D FILE^DICN
  1.  K DIE,DIC,DINUM,DR,DA,DD,DO,DIK,DLAYGO
  1.  N BYIMACT
  1.  S BYIMACT=$S(ACT="I":"imported from",1:"exported to")
  1.  ;-----
  1. BULLETIN ;EP;CREATE EXPORT/IMPORT BULLETIN
  1.  N %X,%Y,X,XMB,XMDT,XMDUZ,Y1
  1.  S XMB="BYIM EXPORT/IMPORT MESSAGE"
  1.  S XMB(1)="The file '"_FILE_"' was "_BYIMACT_" the State Immunization Registry on "_$$HTE^XLFDT($H)
  1.  S XMDUZ=.5
  1.  D ^XMB
  1.  Q
  1.  ;-----
  1. EXPBULL(BYIMHFNM,DEST,BYIMHDIR) ;EP;EXPORT FILE CREATION FAILED
  1.  N %X,%Y,X,XMB,XMDT,XMDUZ,Y1
  1.  S XMB="BYIM EXPORT FILE FAILED"
  1.  S XMB(1)=BYIMHFNM
  1.  S XMB(2)=$P($G(^INRHD(+DEST,0)),U)
  1.  S XMB(3)=BYIMHDIR
  1.  S XMDUZ=.5
  1.  D ^XMB
  1.  Q
  1.  ;-----
  1. LC(X) ;LOWERCASE
  1.  S X=$TR(X,"ABCDEFGHIJKLMNOPQRSTUVWXYZ ","abcdefghijklmnopqrstuvwxyz_")
  1.  Q X
  1.  ;-----
  1. QPATH(BYIMDA) ;EP;QUERY DIRECTORIES
  1.  Q
  1.  Q:'$G(BYIMDA)
  1.  N V,X,Y,Z
  1.  S X=$P($G(^BYIMPARA(BYIMDA,0)),U,2)
  1.  S X=$$LC(X)
  1.  S V=$S(X["\":"\",1:"/")
  1.  I X["hl7bridge" D  I 1
  1.  .S X=$P(X,"hl7bridge")
  1.  .S:$E(X,$L(X))'=V X=X_V
  1.  .S Y=X_"hl7bridge"_V_"queries"
  1.  .S Z=X_"hl7bridge"_V_"qresponses"
  1.  E  D
  1.  .S X=$P(X,"requests")
  1.  .S:$E(X,$L(X))'=V X=X_V
  1.  .S Y=X_"queries"
  1.  .S Z=X_"qresponses"
  1.  S $P(^BYIMPARA(BYIMDA,1),U)=Y
  1.  S $P(^BYIMPARA(BYIMDA,1),U,2)=Z
  1.  Q
  1.  ;-----
  1. LOGDFN ;EP;LOG PATIENTS INCLUDED IN EXPORT
  1.  N DFN,TYPE
  1.  S TYPE="E"
  1.  S DFN=0
  1.  F  S DFN=$O(^BYIMTMP("LOG",DFN)) Q:'DFN  D
  1.  .D LOGD(DFN,TYPE)
  1.  .K ^BYIMTMP("LOG",DFN)
  1.  Q
  1.  ;-----
  1. LOGD(DFN,TYPE) ;EP;LOG EACH EXPORTED OR IMPORTED IMM
  1.  N IMM,X,Y,Z
  1.  S:$G(TYPE)="" TYPE="E"
  1.  ;S DFNCNT=$G(DFNCNT)+1
  1.  S IMM=0
  1.  F  S IMM=$O(^BYIMTMP("LOG",DFN,IMM)) Q:'IMM  D
  1.  .I $G(BYIMALL)'=2,$D(^BYIMEXP("D",IMM)) Q
  1.  .Q:$G(BYIMMU2)
  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////"_DT_";.03////"_IMM_";.04////"_TYPE_";.05////"_$G(XQY)_";.06////"_$G(BYIMALL)
  1.  .S X=DFN
  1.  .D FILE^DICN
  1.  .K DIE,DIC,DINUM,DR,DA,DD,DO,DIK,DLAYGO
  1.  Q
  1.  ;-----
  1. DFN(UIF) ;FIND PATIENT DFN
  1.  N X,Y,Z,LOC,HRN,DFN
  1.  S X=$P($P($G(^INTHU(UIF,3,2,0)),"|",4),U)
  1.  S LOC=$E(X,1,6)
  1.  S HRN=+$E(X,7,12)
  1.  Q:'LOC!'HRN ""
  1.  S LOC=$O(^AUTTLOC("C",LOC,0))
  1.  Q:'LOC ""
  1.  S DFN=""
  1.  S X=0
  1.  F  S X=$O(^AUPNPAT("D",HRN,X)) Q:'X!DFN  S Y=0 F  S Y=$O(^AUPNPAT("D",HRN,X,Y)) Q:'Y!DFN  S:Y=LOC DFN=X
  1.  Q DFN
  1.  ;-----
  1. HFSA(DEST,BYIMHDIR,BYIMHFNM) ;EP - export from this destination
  1.  ;PATCH 8 CR 08549 CHANGES TO CREATE MULTIPLE STATE FILES
  1.  I '$G(DEST) D  Q
  1.  .S ^BYIMTMP("EXP FAIL",$H,"NO DEST")=BYIMHDIR_U_BYIMHFNM_U_DUZ
  1.  .S BYIMFAIL=$G(BYIMFAIL)+1
  1.  I '$D(^INLHDEST(DEST)) D  Q
  1.  .S ^BYIMTMP("EXP FAIL",$H,DEST,"NO MESSAGE")=BYIMHDIR_U_BYIMHFNM_U_DUZ
  1.  .S BYIMFAIL=$G(BYIMFAIL)+1
  1.  S BYIMDUZ=$$DUZ^BYIMIMM()
  1.  K ^BYIMTMP("DEST")
  1.  M ^BYIMTMP("DEST",BYIMDUZ,DEST)=^INLHDEST(DEST)
  1.  N X
  1.  S X=0
  1.  F  S X=$O(^BYIMPARA(BYIMDUZ,3,X)) Q:'X  I X'=BYIMDUZ M ^BYIMTMP("DEST",X,DEST)=^INLHDEST(DEST)
  1.  N BYIMH,BYIMU
  1.  S STATE=0
  1.  F  S STATE=$O(^BYIMTMP("DEST",STATE)) Q:'STATE  D HFSA1(DEST,STATE,BYIMHFNM)
  1.  ;PATCH 8 CR 08549 END
  1.  Q
  1.  ;-----
  1. HFSA1(DEST,STATE,BYIMHFNM) ;PROCESS EACH EXPORT FILE
  1.  N XX,X0,X1,X6,PATH,FE,PI,ESSN
  1.  ;MOVE ASSET CALL TO BYIMIMM5
  1.  D ASSET^BYIMIMM5(STATE)
  1.  ;PATCH 8 CR 08385 - allow 'hl7' or 'dat' file extension
  1.  S BYIMHFNM=$P(BYIMHFNM,".")_"."_$S($G(FE)]"":FE,1:"dat")
  1.  ;PATCH 8 CR 08385 END
  1.  S Y=$$OPEN^%ZISH(PATH,BYIMHFNM,"W")
  1.  I Y D  Q
  1.  .D EXPBULL(BYIMHFNM,DEST,PATH)
  1.  .S ^BYIMTMP("EXP FAIL",$H,DEST,"NO OPEN")=PATH_U_BYIMHFNM_U_DUZ
  1.  .S BYIMFAIL=$G(BYIMFAIL)+1
  1.  S BYIMH=""
  1.  F  S BYIMH=$O(^BYIMTMP("DEST",STATE,DEST,0,BYIMH)) Q:BYIMH=""  D
  1.  .S BYIMU=0
  1.  .F  S BYIMU=$O(^BYIMTMP("DEST",STATE,DEST,0,BYIMH,BYIMU)) Q:'BYIMU  D
  1.  ..K ^BYIMTMP("ORIG",BYIMU)
  1.  ..M ^BYIMTMP("ORIG",BYIMU)=^INTHU(BYIMU)
  1.  ..I $G(^INTHU(BYIMU,3,1,0))["VXU^V04" D  Q:'DFN
  1.  ...S DFN=$$DFN(BYIMU)
  1.  ...I 'DFN D  Q
  1.  ....K ^INLHDEST(DEST,0,BYIMH,BYIMU)
  1.  ....K ^BYIMTMP("DEST",STATE,DEST,0,BYIMH,BYIMU)
  1.  ...S ^BYIMTMP("BYIMIMM4",BYIMU)=DFN
  1.  ...D REFUSAL^BYIMSEG1(DFN,BYIMU)
  1.  ..D LP(BYIMU,STATE)
  1.  ..K ^INTHU(BYIMU)
  1.  ..M ^INTHU(BYIMU)=^BYIMTMP("ORIG",BYIMU)
  1.  ..K ^INLHDEST(DEST,0,BYIMH,BYIMU)
  1.  ..K ^BYIMTMP("DEST",STATE,DEST,0,BYIMH,BYIMU)
  1.  K ^BYIMTMP("BYIMIMM4")
  1.  K ^BYIMTMP("ORIG")
  1.  D ^%ZISC
  1.  D LOGDFN:'$G(BYIMTEST)
  1.  Q
  1.  ;-----
  1. LP(BYIMUIEN,AS)       ;EP - loop through UIF and set to file
  1.  ;INCLUDE AGE TO EXPORT CHECK FOR ADD. SITES
  1.  I 'AGE,$P(^BYIMPARA(BYIMDUZ,0),U,6) Q:$$AGECHK^BYIMIMM5(BYIMUIEN)
  1.  I IO["\\" D
  1.  .F J=1:1:$L(IO,"\\") S X=$P(IO,"\\",J)_"\"
  1.  .S IO=$E(X,1,$L(X)-1)
  1.  I IO["//" D
  1.  .F J=1:1:$L(IO,"//") S X=$P(IO,"//",J)_"/"
  1.  .S IO=$E(X,1,$L(X)-1)
  1.  I $G(PI),$G(^INTHU(BYIMUIEN,3,1,0))["VXU^V04",$$PI(BYIMUIEN) Q
  1.  N BYIMUDA
  1.  S BYIMUDA=0
  1.  F  S BYIMUDA=$O(^INTHU(BYIMUIEN,3,BYIMUDA)) Q:'BYIMUDA  D
  1.  .S SEGX=$G(^INTHU(BYIMUIEN,3,BYIMUDA,0))
  1.  .Q:SEGX=""
  1.  .I SEGX["PID|",$G(ESSN),SEGX["SSA^SS"!($P(SEGX,"|",20)]"") D ESSN(SEGX)
  1.  .I SEGX["PID|"!(SEGX["IN1|"),$G(DFN),SEGX["MEDICARE"!(SEGX["MCR^MC") D MCR(SEGX)
  1.  .I SEGX'["|CR|" D
  1.  ..S BYIMUDA=BYIMUDA+1
  1.  ..S SEGX=SEGX_$G(^INTHU(BYIMUIEN,3,BYIMUDA,0))
  1.  ..Q:SEGX["|CR|"
  1.  ..S BYIMUDA=BYIMUDA+1
  1.  ..S SEGX=SEGX_$G(^INTHU(BYIMUIEN,3,BYIMUDA,0))
  1.  .Q:SEGX'["|CR|"
  1.  .;PATCH 8 CR 08781 - CPT CODE
  1.  .I SEGX["RXA|",$G(CPT)]"" D CPT(CPT)
  1.  .;PATCH 8 CR 08781 END
  1.  .I SEGX["FHS|" S $P(SEGX,"|",9)=BYIMHFNM,$P(SEGX,"|",11)=$E($TR($H,","),1,7)
  1.  .I SEGX["BHS|" S $P(SEGX,"|",11)=$E($TR($H,","),1,7)
  1.  .I '$G(IN1),SEGX["IN1|"!(SEGX["IN2|") Q
  1.  .S:"|MSH|FHS|BHS|BTS|FTS|"'[("|"_$E(SEGX,1,3)_"|") SEGX=$TR(SEGX,"\&")
  1.  .Q:$E(SEGX,1,4)'?2U1UN1"|"
  1.  .I "|BTS|FTS|"'[("|"_$E(SEGX,1,3)_"|") D AE
  1.  .U IO W $P(SEGX,"|CR|"),!
  1.  Q
  1.  ;-----
  1. AE ;PROCESS ADDITIONAL SITE EXPORT FILE
  1.  I $E(SEGX,1,4)="PID|",$G(ESSN),SEGX["SSA^SS" D ESSN(SEGX)
  1.  D SET
  1.  Q
  1.  ;-----
  1. SET ;CUSTOMIZE MSH SEGMENT
  1.  N A,B,X,Y,Z
  1.  S SEG=$E(SEGX,1,3)
  1.  S X=0
  1.  F  S X=$O(XX(SEG,X)) Q:'X  D
  1.  .S Y=0
  1.  .F  S Y=$O(XX(SEG,X,Y)) Q:'Y  S Z=XX(SEG,X,Y) D:Z]""
  1.  ..I SEG="MSH",X=11,'$G(BYIMTEST) Q
  1.  ..I SEG="RXA",X=6,Y=1,$P(SEGX,"|",7),$P(SEGX,"|",7)<100 Q
  1.  ..S B=X
  1.  ..S:"MSHFHSBHS"'[SEG B=X+1
  1.  ..S A=$P(SEGX,"|",B)
  1.  ..S $P(A,U,Y)=Z
  1.  ..S $P(SEGX,"|",B)=A
  1.  Q
  1.  ;-----
  1. PI(UIEN) ;ELIMINATE HL7 MESSAGE IF PATIENT PRIVACY NOT ON FILE
  1.  N HRN,LOC,X,Y,Z,XX
  1.  S DFN=+$G(^BYIMTMP("BYIMIMM4",UIEN))
  1.  I 'DFN S DFN=+$$DFN(UIEN)
  1.  Q:'DFN 1
  1.  Q:$P($G(^BIP(DFN,0)),U,24) 0
  1.  Q 1
  1.  ;-----
  1. CPT(CPT) ;ADJUST RXA-5 FOR CPT
  1.  ;PATCH 8 CR 08781 - CPT CODE
  1.  N X,Y,Z
  1.  S X=$P(SEGX,"|",6)
  1.  Q:CPT=123
  1.  I CPT=0 S X=$P(X,"~")
  1.  I CPT=1,$P(X,"~",2)]"" S X=$P(X,"~",2)
  1.  I CPT=2 S X=$P(X,"~",1,2)
  1.  ;I CPT=1 S X=$P(X,"~")
  1.  ;I CPT=2,$P(X,"~",2)="" S X=$P(X,"~",2)
  1.  ;I CPT=3,$P(X,"~",3)]"" S X=$P(X,"~",3)
  1.  ;I CPT=12 S X=$P(X,"~",1,2)
  1.  ;I CPT=13 S X=$P(X,"~")_"~"_$P(X,"~",3)
  1.  ;I CPT=23 S X=$P(X,"~",2)_"~"_$P(X,"~",3)
  1.  S $P(SEGX,"|",6)=X
  1.  Q
  1.  ;-----
  1. ESSN(SEGX) ;REMOVE SSN
  1.  N J,X,Y,Z,XX
  1.  S X=$P(SEGX,"|",4)
  1.  S XX=""
  1.  F J=1:1 S Y=$P(X,"~",J) Q:Y=""  I Y["SSA^SS" S XX=$P(X,"~",1,J-1) S:$P(X,"~",J+1)]"" XX=XX_"~"_$P(X,"~",J+1,99)
  1.  S $P(SEGX,"|",4)=XX
  1.  S $P(SEGX,"|",20)=""
  1.  Q
  1.  ;-----
  1. MCR(SEGX) ;REMOVE SSN
  1.  N J,X,Y,Z,XX
  1.  S X=$P(SEGX,"|",4)
  1.  S XX=""
  1.  F J=1:1 S Y=$P(X,"~",J) Q:Y=""  I Y["MEDICARE"!(Y["MCR^MC") S XX=$P($P(X,"~",J),U) S:XX[$P($G(^DPT(DFN,0)),U,9) XX=$P(X,"~",1,J-1)_"~"_$P(X,"~",J+1,99)
  1.  S $P(SEGX,"|",4)=XX
  1.  S:SEGX["PID|" $P(SEGX,"|",20)=""
  1.  Q
  1.  ;-----