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