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

BYIMIMM6.m

Go to the documentation of this file. 
  1. BYIMIMM6 ;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.  W @IOF
  1.  N PAC,PAH,VER,EXP,IMP,LOC,OUTPUT,FORMAT
  1.  D M1
  1.  D M2
  1.  Q
  1.  ;-----
  1. M1 ;MENU DISPLAY
  1.  D PATH
  1.  S (PAC,PAH,VER)=""
  1.  S PAC=+$O(^DIC(9.4,"C","BYIM",0))
  1.  S VER=$P($G(^DIC(9.4,PAC,"VERSION")),U)
  1.  S:VER PAH=$O(^DIC(9.4,PAC,22,"B",VER,0))
  1.  S:PAH PAH=$O(^DIC(9.4,PAC,22,PAH,"PAH","B",99999),-1)
  1.  S:PAH]"" VER=VER_" P "_PAH
  1.  S VER="BYIM VERSION: "_VER
  1.  S HL7=" HL7 VERSION: "_BYIMVER
  1.  S LOC=$P($G(^DIC(4,$$DUZ^BYIMIMM(),0)),U)
  1.  N X
  1.  S X="Immunization Data Exchange"
  1.  S EXP=$O(^DIC(19,"B","BYIM IZ AUTO EXPORT",0))
  1.  S EXP=$O(^DIC(19.2,"B",+EXP,0))
  1.  S EXP=$P($G(^DIC(19.2,+EXP,0)),U,2)
  1.  I EXP S Y=EXP D DD^%DT S EXP=$P(Y,",")_"@"_$P(Y,"@",2)
  1.  S EXP="NEXT EXP: "_$S(EXP="":"NOT SCHED",1:EXP)
  1.  S IMP=$O(^DIC(19,"B","BYIM IZ AUTO IMPORT",0))
  1.  S IMP=$O(^DIC(19.2,"B",+IMP,0))
  1.  S IMP=$P($G(^DIC(19.2,+IMP,0)),U,2)
  1.  I IMP S Y=IMP D DD^%DT S IMP=$P(Y,",")_"@"_$P(Y,"@",2)
  1.  S IMP="NEXT IMP: "_$S(IMP="":"NOT SCHED",1:IMP)
  1.  Q
  1.  ;-----
  1. ADDLOT(DFN,IVDA,LOTDA,VDATE) ;EP;TO ADD LOT NUMBER
  1.  ;DFN     - PATIENT DFN
  1.  ;IVDA    - IMMUNIZATION FILE IEN
  1.  ;LOTDA   - LOT NUMBER FILE IEN
  1.  ;VDATE   - VISIT DATE
  1.  H 1
  1.  N X,Y,Z
  1.  S X=$O(^AUPNVIMM("AC",DFN,9999999999),-1)
  1.  Q:'X
  1.  Q:+$G(^AUPNVIMM(X,0))'=IVDA
  1.  Q:$P($G(^AUPNVIMM(X,0)),U,5)
  1.  S Y=+$P($G(^AUPNVIMM(X,0)),U,3)
  1.  Q:$P($G(^AUPNVSIT(Y,0)),".")'=$P(VDATE,".")
  1.  N DIE,DIC,DINUM,DR,DA,DD,DO,DIK,DLAYGO
  1.  S DA=X
  1.  S DR=".05////"_LOTDA
  1.  S DIE="^AUPNVIMM("
  1.  D ^DIE
  1.  K DIE,DIC,DINUM,DR,DA,DD,DO,DIK,DLAYGO
  1.  Q
  1.  ;-----
  1. M2 ;VERSION 2.0 HEADER
  1.  N X
  1.  S X="Immunization Data Exchange"
  1.  W !?80-$L(X)\2,X
  1.  W !?80-$L(LOC)\2,LOC
  1.  W !!?7,VER,?47,EXP
  1.  W !?7,HL7,?47,IMP
  1.  ;PATCH 8 CR 08547 - DISPLAY CONTROLLER STATUS
  1.  S ON=$G(^%ZIS(1,+$G(IO("HOME")),"SUBTYPE"))
  1.  S:ON ON=$G(^%ZIS(2,ON,5))
  1.  S RVON=$P(ON,U,4)
  1.  S RVOFF=$P(ON,U,5)
  1.  S BON=$P(ON,U,8)
  1.  S BOFF=$P(ON,U,9)
  1.  W !?2,"OUTPUT CONTROLLER: "
  1.  I '$$VER^INHB(1) W:RVON]"" @RVON W:BON]"" @BON
  1.  W $S($$VER^INHB(1):"RUNNING",1:"NOT RUNNING-Contact IT support")
  1.  W @RVOFF
  1.  W @BOFF
  1.  W !?2,"FORMAT CONTROLLER: "
  1.  I '$$VER^INHB(2) W:RVON]"" @RVON W:BON]"" @BON
  1.  W $S($$VER^INHB(2):"RUNNING",1:"NOT RUNNING-Contact IT support")
  1.  W @BOFF
  1.  W @RVOFF
  1.  ;PATCH 8 CR 08547 END
  1.  Q
  1.  ;-----
  1. SCRN(INDA) ;EP;TO SCREEN IMM'S TO INCLUDE IN EXPORT
  1.  ;PATCH 8 CR 08626 - INCLUDE/EXCLUDE PREVIOUSLY EXPORTED
  1.  ;PATCH 8 CR 08695 - INCLUDE/EXCLUDE HISTORIC IMMS
  1.  ;PATCH 8 CR 08694 - EXCLUDE IMM PRIOR TO SELECTED DATE
  1.  K ^TMP("ADM")
  1.  N IMM,IMM12,VIS,T,BYIMALL,BYIMADM,DDATE
  1.  S IMM=$G(^AUPNVIMM(+INDA,0))
  1.  S IMM12=$G(^AUPNVIMM(+INDA,12))
  1.  S VIS=$G(^AUPNVSIT(+$P(IMM,U,3),0))
  1.  I '+IMM!'$P(IMM,U,2)!'$P(IMM,U,3) Q 0
  1.  S BYIMALL=$G(INDA("BYIMALL"))
  1.  S BYIMADM=$G(INDA("BYIMADM"))
  1.  S DDATE=$G(INDA("DDATE"))
  1.  S T=0
  1.  I BYIMALL=2,BYIMADM=2 S T=1
  1.  I BYIMALL=2,BYIMADM=1,"CTNOEDXM"'[$P(VIS,U,7) S T=1
  1.  I BYIMALL=1,BYIMADM=1,"CTNOEDXM"'[$P(VIS,U,7),'$D(^BYIMEXP("D",+INDA)) S T=1
  1.  I BYIMALL=1,BYIMADM=2,'$D(^BYIMEXP("D",+INDA)) S T=1
  1.  I $L(DDATE)=7,$P(IMM12,U,18)>DDATE S T=1
  1.  I '$G(BYIMDATE) N X S X=9999999999,BYIMDATE=0 F  S X=$O(^BYIMPARA($$DUZ^BYIMIMM(),"LAST EXPORT",X),-1) Q:'X!BYIMDATE  I $P(^(X),U,2)]"" S BYIMDATE=X
  1.  I BYIMDATE,$P($P(IMM12,U,18),".")>BYIMDATE S T=1
  1.  I '$D(^BYIMEXP("D",+INDA)),$P(IMM,U,15)!($P($G(^AUTTIMM(+$G(^AUPNVIMM(+$G(INDA),0)),0)),U,3)=999) S ^BYIMEXP("D",+INDA)="" S T=0
  1.  Q T
  1.  ;PATCH 8 CR 08626 END
  1.  ;PATCH 8 CR 08695 END
  1.  ;PATCH 8 CR 08694 END
  1.  ;-----
  1. HFSA(DEST,PRI) ;EP;TO FIND HL7 MESSAGE THAT HAVEN'T BEEN EXPORTED
  1.  Q:PRI=""!'DEST
  1.  K ^BYIMTMP("LE")
  1.  K ^BYIMTMP("OF")
  1.  N X,Y,Z,XX
  1.  S X=""
  1.  F  S X=$O(^INLHDEST(DEST,PRI,X)) Q:X=""  D
  1.  .S Y=0
  1.  .F  S Y=$O(^INLHDEST(DEST,PRI,X,Y)) Q:'Y  S ^BYIMTMP("OF",Y)="" S:$G(^INTHU(Y,3,1,0))["FHS|" XX=$P(X,",")_","_($P(X,",",2)+1)
  1.  S X=0
  1.  ;PATCH 5 change ..."LAST EXPORT"),X... to ..."LAST EXPORT",X)...
  1.  ;F  S X=$O(^BYIMPARA($$DUZ^BYIMIMM(),"LAST EXPORT",X)) Q:'X  I X'=DT,'$P(^(X),U,2) S ^BYIMTMP("LE",X+17000000)="",$P(^BYIMPARA($$DUZ^BYIMIMM(),"LAST EXPORT"),X,U,2)=$P(^BYIMPARA($$DUZ^BYIMIMM(),"LAST EXPORT",X),U)
  1.  F  S X=$O(^BYIMPARA($$DUZ^BYIMIMM(),"LAST EXPORT",X)) Q:'X  I X'=DT,'$P(^(X),U,2) S ^BYIMTMP("LE",X+17000000)="",$P(^BYIMPARA($$DUZ^BYIMIMM(),"LAST EXPORT",X),U,2)=$P(^BYIMPARA($$DUZ^BYIMIMM(),"LAST EXPORT",X),U)
  1.  ;END PATCH 5
  1.  S:$G(BYIM("MSH3.1"))="" BYIM("MSH3.1")=$P($G(^BYIMPARA($$DUZ^BYIMIMM()),1),U,3)
  1.  S:$G(BYIM("MSH3.1"))="" BYIM("MSH3.1")="RPMS"
  1.  S:'$G(XX) XX=$H
  1.  S X=0
  1.  F  S X=$O(^INTHU(X)) Q:'X  S Z=$G(^(X,3,1,0)) I Z["VXU^V04",Z["MSH|" D
  1.  .Q:$P($P(Z,"|",3),U)'=BYIM("MSH3.1")
  1.  .Q:$P(Z,"|",10)=""
  1.  .Q:$D(^BYIMTMP("OF",X))
  1.  .Q:$D(^BYIMMM("MID",$P(Z,"|",10)))
  1.  .S Y=$E($P(Z,"|",7),1,8)
  1.  .Q:'$D(^BYIMTMP("LE",Y))
  1.  .S ^BYIMMM("MID",$P(Z,"|",10))=""
  1.  .S ^INLHDEST(DEST,PRI,XX,X)=""
  1.  .S ^BYIMTMP("OF",X)=""
  1.  .S $P(^BYIMTMP("NUM"),U,2)=$P($G(^BYIMTMP("NUM")),U,2)+1
  1.  .S Y=0
  1.  .F  S Y=$O(^INTHU(X,3,Y)) Q:'Y  S:^(Y,0)["RXA|" $P(^BYIMTMP("NUM"),U,3)=$P($G(^BYIMTMP("NUM")),U,3)+1
  1.  K ^BYIMTMP("LE")
  1.  K ^BYIMTMP("OF")
  1.  Q
  1.  ;-----
  1. RLSH ;EP;TO DISPLAY AND EDIT RELATIONSHIP
  1.  K BYIMQUIT
  1.  D RUPD
  1.  D RDISPLAY
  1.  F  D REDIT Q:$D(BYIMQUIT)
  1.  Q
  1.  ;-----
  1. RUPD ;EP;TO UPDATE IZ RELATIONSHIP FILE FROM RELATIONSHIP FILE
  1.  N X,Y,Z,XX,YY,ZZ
  1.  S XX=0
  1.  F  S XX=$O(^AUTTRLSH(XX)) Q:'XX  S Y=$P(^(XX,0),U) D:'$D(^BYIMREL(XX))
  1.  .S Z=$O(^BYIMCDC("C",Y,0))
  1.  .S X=XX
  1.  .K DIC,DINUM,DR,DA
  1.  .S DINUM=X
  1.  .S DIC="^BYIMREL("
  1.  .S DIC(0)="L"
  1.  .S:Z DIC("DR")=".02////"_Z
  1.  .D FILE^DICN
  1.  .K DIC,DINUM,DR,DA
  1.  .Q:$D(ZTQUEUED)
  1.  .W !,XX,?10,$P(^AUTTRLSH(XX,0),U)," added to BYIM Relationship Table."
  1.  Q
  1.  ;-----
  1. RDISPLAY ;EP;TO DISPLAY BYIM/CDC RELATIONSHIP CROSS OVER
  1.  D RDHEAD
  1.  D PAUSE
  1.  D RD
  1.  N X,Y,Z,XX,YY,ZZ,JJ,BYIMPAUS
  1.  S BYIMPAUS=""
  1.  S JJ=0
  1.  S XX=0
  1.  F  S XX=$O(^BYIMREL(XX)) Q:'XX!$L(BYIMPAUS)  S Y=^(XX,0) D
  1.  .S Z=^AUTTRLSH(XX,0)
  1.  .S Z21=$G(^AUTTRLSH(XX,21))
  1.  .W !,$J(XX,4)
  1.  .W:$P(Y,U,2) ?10,$P(^BYIMCDC($P(Y,U,2),0),U)
  1.  .W ?20,$P(Z,U),?52,$P(Z21,U,4)
  1.  .S JJ=JJ+1
  1.  .I JJ#15=0 D PAUSE
  1.  Q
  1.  ;-----
  1. REDIT ;EP;TO EDIT RELATIONSHIP CROSS OVER
  1.  W !!,"Select No. to Edit"
  1.  K DIR
  1.  S DIR(0)="NO^1:"_$O(^BYIMREL(9999999999),-1)
  1.  S DIR("A")="LOCAL Relationship No. (or '^' to exit)"
  1.  W !
  1.  D ^DIR
  1.  K DIR
  1.  I X[U S BYIMQUIT="" Q
  1.  Q:X=""
  1.  S BYIMJ=X
  1.  I '$D(^BYIMREL(BYIMJ,0)) W !!,"No. ",BYIMJ," isn't defined." H 2 Q
  1.  W !!?10,"RPMS - RELATIONSHIP entry selected: ",$P($G(^AUTTRLSH(BYIMJ,0)),U)
  1.  S DA=BYIMJ
  1.  S DR=".02T"
  1.  S DIE="^BYIMREL("
  1.  D ^DIE
  1.  Q
  1.  ;
  1. RDHEAD ;
  1.  W @IOF
  1.  W !!?10,"CDC HL7 Table 0063 Codes and Descriptions"
  1.  W !!,"Code",?10,"Description"
  1.  W !,"-------",?10,"------------------------------"
  1.  N X,Y,Z
  1.  S X=0
  1.  F  S X=$O(^BYIMCDC(X)) Q:'X  S Y=^(X,0) D
  1.  .W !,$P(Y,U),?10,$P(Y,U,2)
  1.  Q
  1.  ;-----
  1. RD ;RELATIONSHIP LIST DISPLAY
  1.  W @IOF
  1.  W !?10,"BYIM Immunization Data Exchange"
  1.  W !?10,"Local RELATIONSHIP entry and CDC HL7 Table 0063 Code"
  1.  W !?10,"(NOTE: Local RELATIONSHIP without CDC HL7 code will be sent as 'OTH')"
  1.  W !!,?10,"CDC HL7",?52,"Local HL7"
  1.  W !,"No.",?10,"Code",?20,"Local RELATIONSHIP Description",?52,"Code"
  1.  W !,"----",?10,"---",?20,"------------------------------",?52,"---------"
  1.  Q
  1.  ;-----
  1. PATH ;EP;SET PATH
  1.  N X,X0
  1.  S X0=$G(^BYIMPARA($$DUZ^BYIMIMM(),0))
  1.  S X1=$G(^BYIMPARA($$DUZ^BYIMIMM(),1))
  1.  S X6=$G(^BYIMPARA($$DUZ^BYIMIMM(),6))
  1.  ;PATCH 8 CR 08627 - ENSURE COMPLETE PATH WITH TERMINATING / OR \
  1.  S OPATH=$P(X0,U,2)
  1.  S OPATH=$$SLASH(OPATH)
  1.  S IPATH=$P(X0,U,3)
  1.  S IPATH=$$SLASH(IPATH)
  1.  S QPATH=$P(X1,U)
  1.  S QPATH=$$SLASH(QPATH)
  1.  S RPATH=$P(X1,U,2)
  1.  S RPATH=$$SLASH(RPATH)
  1.  ;PATCH 8 CR 08627 END
  1.  S BYIMEXT=$P(X0,U,8)
  1.  S:BYIMEXT="" BYIMEXT="dat"
  1.  S BYIMIN1=$P(X0,U,16)
  1.  ;PATCH 8 CR 08781 - CPT CODE
  1.  S BYIMCVX=$P(X0,U,17)
  1.  ;PATCH 8 CR 08781 END
  1.  S X=$P(X0,U,11)
  1.  S Y=$P(^DD(90480,.11,0),U,3)
  1.  S BYIMVER=$P($P(Y,X_":",2),";")
  1.  S BYIMBDG=$P(X0,U,12)
  1.  S BYIMQT=$P(X0,U,13)
  1.  S BYIMMSH8=$P(X0,U,15)
  1.  S BYIM("MSH4.1")=$P(X0,U,7)
  1.  S BYIM("MSH3.1")=$P(X1,U,3)
  1.  S BYIM("MSH3.2")=$P(X1,U,4)
  1.  S BYIM("MSH3.3")=$P(X1,U,5)
  1.  S BYIM("MSH4.2")=$P(X1,U,6)
  1.  S BYIM("MSH4.3")=$P(X1,U,7)
  1.  S BYIM("MSH6")=$P(X1,U,8)
  1.  S BYIM("PD13.1")=$P(X6,U)
  1.  S BYIM("PD13.2")=$P(X6,U,2)
  1.  S BYIM("MSH5.1")=$P(X6,U,3)
  1.  S BYIM("MSH5.2")=$P(X6,U,4)
  1.  S BYIM("MSH5.3")=$P(X6,U,5)
  1.  S BYIMHIST=$P(X6,U,6)
  1.  S BYIMESSN=$P(X6,U,7)
  1.  ;PATCH 8 CR 08631 - PATIENT ADDRESS TYPE
  1.  S BYIMATYP=$P(X6,U,8)
  1.  ;PATCH 8 CR 08631 END
  1.  S BYIMDVOL=$P(X6,U,10)
  1.  S ASUFAC=$P($G(^AUTTLOC($$DUZ^BYIMIMM(),0)),U,10)
  1.  Q
  1.  ;-----
  1. NOPATH ;EP;NO PATH MESSAGE
  1.  I $D(ZTQUEUED) S BYIMQUIT="" Q
  1.  W @IOF
  1.  W !!,"You are logged into site: ",$P($G(^AUTTLOC($$DUZ^BYIMIMM(),0)),U,2)
  1.  W !!,"Directory path information was missing."
  1.  W !,"Please contact your Site Manager.  There must be entries in the"
  1.  W !!?10,"PATH FOR OUTNBOUND MESSAGES field and the"
  1.  W !?10,"PATH FOR INBOUND MESSAGES field of the"
  1.  W !?10,"IZ PARAMETERS file for ",$P($G(^AUTTLOC($$DUZ^BYIMIMM(),0)),U,2)
  1.  D PAUSE
  1.  Q
  1.  ;-----
  1. PAUSE ;EP;FOR PAUSE READ
  1.  Q:$E($G(IOST),1,2)'="C-"
  1.  W !
  1.  K DIR
  1.  S DIR(0)="E"
  1.  S:'$D(DIR("A")) DIR("A")="Press <ENTER> to continue or '^' to exit..."
  1.  D ^DIR
  1.  K DIR
  1.  S BYIMPAUS=X
  1.  Q
  1.  ;-----
  1. SLASH(PATH) ;ENSURE PATH HAS TERMINATING SLASH
  1.  ;PATCH 8 CR# 08627 - ENSURE COMPLETE PATH WITH TERMINATING / OR \
  1.  S X=PATH
  1.  Q:"/\"[$E(X,$L(X)) PATH
  1.  S:X["/" PATH=PATH_"/"
  1.  S:X["\" PATH=PATH_"\"
  1.  Q PATH
  1.  ;PATCH 8 CR# 08627 END
  1.  ;-----
  1. P8PREP ;SET UP FOR P8 TESTING
  1.  I 1
  1.  Q
  1.  K BYIMQUIT
  1.  N X,Y,Z,STOP
  1.  S STOP=""
  1.  I $$PROD^XUPROD() D  Q
  1.  .S BYIMQUIT=1
  1.  .W !,"This is flagged in the KERNEL SYSTEM PARMETERS as a PRODUCTION database."
  1.  .W !,"P8 Prep cannot be run on a PRODUCTION database."
  1.  .H 4
  1.  S X1=DT,X2=-14
  1.  D C^%DTC
  1.  S X14=X
  1.  S X=9999999999
  1.  F  S X=$O(^AUPNVSIT("B",X),-1) Q:'X!(X<X14)!STOP  D
  1.  .S Y=0
  1.  .F  S Y=$O(^AUPNVSIT("B",X,Y)) Q:'Y!STOP  D
  1.  ..S Z=$G(^AUPNVSIT(Y,0))
  1.  ..Q:$P($G(^DPT(+$P(Z,U,5),0)),U)["DEMO,"
  1.  ..S STOP=1
  1.  I STOP D
  1.  .W !!,"There appear to be non-DEMO patients with a VISIT within the past 14 days."
  1.  .W !,"Are you absolutley certain this is NOT a PRODUCTION database?"
  1.  .W !!,"Be absolutely certain this is NOT a PRODUCTION database before you proceed."
  1.  .H 4
  1.  K DIR,BYIMQUIT
  1.  S BYIMQUIT=""
  1.  S DIR(0)="YO"
  1.  S DIR("A")="Are you certain you are on a TEST database"
  1.  S DIR("B")="NO"
  1.  W !!,"The patch 8 preparation process should ONLY be run on a TEST database."
  1.  W !
  1.  D ^DIR
  1.  K DIR
  1.  I Y'=1 S BYIMQUIT=1 Q
  1.  S J=0
  1.  S X=9999999999
  1.  F  S X=$O(^AUPNVIMM(X),-1) Q:'X  D
  1.  .S J=J+1
  1.  .I J>199 S:'$D(^BYIMEXP("D",X)) ^BYIMEXP("D",X)="",^TMP($J,"BYIMD",X)=""
  1.  .W:X#100=0 "S"
  1.  .I J<200 D
  1.  ..K ^BYIMEXP("D",X)
  1.  ..S DAT=X
  1.  ..S P=+$P($G(^AUPNVIMM(X,0)),U,2)
  1.  ..W "K"
  1.  ..M ^BIPXX(P)=^BIP(P)
  1.  ..I X#2 S $P(^BIP(P,0),U,24)=1 W "P1"
  1.  ..I '(X#2) S $P(^BIP(P,0),U,24)=0 W "P0"
  1.  S DAT=$P($G(^AUPNVIMM(DAT,0)),U,3)
  1.  S DAT=$P($G(^AUPNVSIT(DAT,0)),".")
  1.  S DEST=+$O(^INRHD("B","HL IHS IZV04 FRAMEWORK",0))
  1.  K ^INLHDEST(DEST),^BYIMTMP("EXP FAIL"),^BYIMTMP("DEST"),^INLHSCH("ACT",DEST)
  1.  S X=""
  1.  F  S Z=$O(^INLHSCH(0,X)) Q:X=""  D
  1.  .S DA=0
  1.  .F  S DA=$O(^INLHSCH(0,X,DA)) Q:'DA  I $G(^INTHU(DA,3,1,0))["VXU^V04" K ^INLHSCH(0,X,DA)
  1.  S X=DAT
  1.  F  S X=$O(^BYIMPARA($$DUZ^BYIMIMM(),"LAST EXPORT",X)) Q:'X  K ^BYIMPARA($$DUZ^BYIMIMM(),"LAST EXPORT",X)
  1.  W !!,"Patch 8 testing prep complete."
  1.  I $L(DAT)=7 D
  1.  .S ^BYIMPARA($$DUZ^BYIMIMM(),"LAST EXPORT",DAT)=$H_U_$H
  1.  .W !!,"When you use the IZDE option to create an export file,"
  1.  .W !,"at the 'Export Immunizations given since ...: ' prompt,"
  1.  .W !,"use ",$E(DAT,4,5),"/",$E(DAT,6,7),"/",$E(DAT,1,3)+1700," for the start date of the export."
  1.  D PAUSE
  1.  Q
  1.  ;-----
  1. NEW(DFN,BYIMALL,BYIMADM,DDDATE) ;EP;DETERMINE IF PATIENT HAS IMMS THAT HAVEN'T BEEN EXPORTED
  1.  ;PATCH 8 CR 08626 - INCLUDE/EXCLUDE PREVIOUSLY EXPORTED
  1.  ;PATCH 8 CR 08695 - INCLUDE/EXCLUDE HISTORIC IMMS
  1.  ;PATCH 8 CR 08694 - EXCLUDE IMM PRIOR TO SELECTED DATE
  1.  N INDA,Y
  1.  S INDA("BYIMALL")=$G(BYIMALL)
  1.  S INDA("BYIMADM")=$G(BYIMADM)
  1.  S INDA("DDATE")=$S($G(DDDATE):DDDATE,1:$O(^BYIMPARA($$DUZ^BYIMIMM(),"LAST EXPORT",9999999999),-1))
  1.  S Y=0
  1.  S INDA=9999999999
  1.  F  S INDA=$O(^AUPNVIMM("AC",DFN,INDA),-1) Q:'INDA!Y  D
  1.  .S Y=$$SCRN^BYIMIMM6(.INDA)
  1.  Q Y
  1.  ;PATCH 8 CR 08626 END
  1.  ;PATCH 8 CR 08695 END
  1.  ;PATCH 8 CR 08694 END
  1.  ;-----
  1. BKGTST ;TEST BACKGROUND EXPORT
  1.  I 1
  1.  Q
  1.  I $G(BYIMQUIT) K BYIMQUIT Q
  1.  D NOW^%DTC
  1.  S START=%
  1.  S S1=$P(START,".")
  1.  S S2=1_$E($P(START,".",2),1,4)
  1.  S:$L(S2)<5 S2=S2_$E("00000",1,5-$L(S2))
  1.  S S2=S2+10
  1.  S:$E(S2,4,5)>59 S2=$E(S2,1,3)+1_"0"_$E(S2,5)
  1.  S:$E(S2,2,3)>23 S1=S1+1,S2="100"_$E(S2,4,5)
  1.  S S2=$E(S2,2,5)
  1.  S START=S1_"."_S2
  1.  S DIC("DR")="2////"_START
  1.  S X=$O(^DIC(19,"B","BYIM IZ AUTO EXPORT",0))
  1.  Q:'X
  1.  S DIC="^DIC(19.2,"
  1.  S DIC(0)="L"
  1.  D FILE^DICN
  1.  S START=1_$E($P(START,".",2),1,4)
  1.  S:$L(START)<5 START=START_0
  1.  S START=$E($S(START>11259:(START-1200),1:START),2,5)
  1.  W !!,"The BYIM IZ AUTO EXPORT option will run in background shortly."
  1.  W !,"Please check your '.../requests' folder for the new file in about 10 minutes."
  1.  Q
  1.  ;-----
  1. P8PREPB ;SET BACK TO PRE-P8PREP VALUES
  1.  S X=0
  1.  F  S X=$O(^TMP($J,"BYIMD",X)) Q:'X  K ^BYIMEXP("D",X)
  1.  K ^TMP($J,"BYIMD")
  1.  S X=0
  1.  F  S X=$O(^BIPXX(X)) Q:'X  M ^BIP(X,0)=^BIPXX(X,0) K ^BIPXX(X,0)
  1.  Q
  1.  ;-----