BYIMIMM3.m

BYIMIMM3 ;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

 ;

 ;-----

SELECT ;EP;

 F  D S1 Q:$D(BYIMQUIT)

 K BYIMQUIT

 Q

 ;-----

S1 NEW XREF,BYIMBEG,BYIMEND

 W @IOF

 W !!?20,"Select the FILE report option"

 W !

 K DIR

 S DIR(0)="SO^1:File Name;2:By Date range"

 D ^DIR

 K DIR

 I 'Y S BYIMQUIT="" Q

 I Y=1 D FN S Y=1 I $D(BYIMQUIT) K BYIMQUIT Q

 I Y=2 D DR

 I $D(BYIMQUIT) K BYIMQUIT Q

ZIS ;SELECT DEVICE FOR DISPLAY

 S BYIMRTN="DISP^BYIMIMM3"

 D ZIS^BYIMXIS

 Q

 ;-----

FN ;SELECT FILE NAME TO DISPLAY

 N X,Y,Z

 K DIR

 S DIR(0)="FO^1:50"

 S DIR("A")="Select FILE NAME to display"

 W !

 D ^DIR

 K DIR

 I X="" S BYIMQUIT="" Q

 I '$O(^BYIMPARA("FILE",X,$$DUZ^BYIMIMM(),0)) D  Q

 .W !!,"No file with this name - ",X," - on file."

 .H 4

 .S BYIMQUIT=""

 S BYIMBEG=X

 S XREF="FILE"

 Q

 ;-----

DR ;SELECT DATE RANGE FOR DISPLAY

 K DIR

 S DIR(0)="DO"

 S DIR("A")="Beginning Date FILE STATISTICS Report"

 S Y=DT

 X ^DD("DD")

 S DIR("B")=Y

 W !

 D ^DIR

 K DIR

 I 'Y D  Q

 .S BYIMQUIT=""

 .W !!,"To display FILE STATS by date range"

 .W !,"the Beginning Date must be selected."

 S BYIMBEG=Y

 K DIR

 S DIR(0)="DO"

 S DIR("A")="Ending Date FILE STATISTICS Report"

 S Y=DT

 X ^DD("DD")

 S DIR("B")=Y

 W !

 D ^DIR

 K DIR

 I 'Y S BYIMQUIT="" Q

 S BYIMEND=Y

 S XREF="DATE"

 Q

 ;-----

DISP ;EP;TO DISPLAY FILE STATS REPORT

 K BYIMQUIT

 N X,Y,Z,JJ,XX,YY,ZZ,XXX,BYIMPREF

 S JJ=0

 D HDR

 S BYIMPREF=""

 S XX=BYIMBEG

 S:'XX XX=$E(XX,1,$L(XX)-1)

 S:XX XX=XX-1

 F  S XX=$O(^BYIMPARA(XREF,XX)) Q:XX=""!($S(BYIMBEG:XX>BYIMEND,1:XX'[BYIMBEG))!(BYIMPREF]"")  D

 .S YY=0

 .F  S YY=$O(^BYIMPARA(XREF,XX,$$DUZ^BYIMIMM(),YY)) Q:'YY!(BYIMPREF]"")  D

 ..S X=$G(^BYIMPARA($$DUZ^BYIMIMM(),2,YY,0))

 ..S Y=$P(X,U),(BYIMPREF,BYIMPREF(1))="File Name Prefix: "_$S($L(Y,"_")<3:"izdata",1:$P(Y,"_",1,2)_"_")

 S XX=BYIMBEG

 S:'XX XX=$E(XX,1,$L(XX)-1)

 S:XX XX=XX-1

 F  S XX=$O(^BYIMPARA(XREF,XX)) Q:XX=""!($S(BYIMBEG:XX>BYIMEND,1:XX'[BYIMBEG))!$D(BYIMQUIT)  D

 .S YY=0

 .F  S YY=$O(^BYIMPARA(XREF,XX,$$DUZ^BYIMIMM(),YY)) Q:'YY!$D(BYIMQUIT)  D D1

 I '$D(ZTQUEUED) W !! D PAUSE^BYIMIMM6

 Q

 ;-----

D1 ;GET FILE INFO

 I JJ=6 W !,BYIMPREF

 S X=$G(^BYIMPARA($$DUZ^BYIMIMM(),2,YY,0))

 S Y=$P(X,U)

 S BYIMPREF="File Name Prefix: "_$S($L(Y,"_")<3:"izdata",1:$P(Y,"_",1,2)_"_")

 S Y=$S($L(Y,"_")<3:$P(Y,"izdata",2),1:$P($P(Y,U),"_",3,99))

 S DATE=$P(X,U,2)

 S DATE=$E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_($E(DATE,1,3)+1700)

 S $E(Y,21)=DATE

 S MODE=$P(X,U,3)

 S MODE=$S(MODE="E":"EXPORT",MODE="I":"IMPORT",1:"")

 S $E(Y,33)=MODE

 S $E(Y,41)=$J($P(X,U,4),5)

 S $E(Y,49)=$J($P(X,U,5),5)

 S $E(Y,57)=$J($P(X,U,6),5)

 S $E(Y,65)=$J($P(X,U,7),5)

 S $E(Y,73)=$J($P(X,U,8),5)

 I BYIMPREF'=BYIMPREF(1) W !!,BYIMPREF S BYIMPREF(1)=BYIMPREF

 W !,Y

 S JJ=JJ+1

 I '$D(ZTQUEUED),JJ#IOSL=0 D

 .W !!

 .D PAUSE^BYIMIMM6

 .I X[U S BYIMQUIT="" Q

 .D HDR

 Q

 ;-----

OL(INDA) ;EP;TO SET OUTSIDE LOCATION

 S VDA=$P($G(^AUPNVIMM(INDA,0)),U,3)

 S OL=$P($G(^AUPNVSIT(+VDA,21)),U)

 Q:OL]"" OL

 S OL=$P($G(^AUPNVSIT(VDA,0)),U,6)

 S OL=$P($G(^DIC(4,+OL,0)),U)

 Q OL

 ;-----

HX1(X) ;EP;TO RETURN HX CODE

 N VIS,I0,V0,TYPE,CB,MFI

 D VINFO(X)

 Q:CB=.5!$L(MFI) "02"

 Q:"CTNOEDXM"[TYPE "01"

 Q "00"

 ;-----

HX2(X) ;EP;TO RETURN HX CODE

 N VIS,I0,V0,TYPE,CB,MFI

 D VINFO(X)

 Q:CB=.5!$G(MFI) "HISTORICAL INFORMATION - OTHER PROVIDER"

 Q:TYPE="E"!'VIS "HISTORICAL INFORMATION - SOURCE UNSPECIFIED"

 Q "NEW IMMUNIZATION RECORD"

 ;-----

VINFO(X) ;GET VISIT INFOR

 N X1,X2

 S I0=$G(^AUPNVIMM(+$G(X),0))

 S VIS=+$P(I0,U,3)

 S V0=$G(^AUPNVSIT(VIS,0))

 S TYPE=$P(V0,U,7)

 I $G(BYIMHIST),BYIMHIST>+V0!'$P(I0,U,5) S TYPE="E"

 S CB=$P(V0,U,23)

 S MFI=$P($G(^AUPNVSIT(VIS,11)),U,13)

 Q

 ;-----

VFC(INDA) ;EP;TO RETURN PATIENT LEVEL PV1-20 VFC CODE

 N X,Y,Z,DFN

 S VSIT=+$G(INDA)

 S DFN=+$P($G(^AUPNVSIT(VSIT,0)),U,5)

 S X=$P($G(^AUPNPAT(DFN,11)),U,11)

 N MCD

 S MCD=$O(^AUPNMCD(DFN,11,9999999999),-1)

 I MCD,'$P($G(^AUPNMCD(DFN,11,MCD,0)),U,2) S X=2

 S X=$S(X=2:2,X=1:4,1:1)

 I $P($G(^DPT(DFN,0)),U,3)<(DT-190000) S X=1

 S X="V0"_X

 S X=X_U_$$VFCD(VSIT)

 Q:$G(BYIMVER)<2.5 X

 I $P($G(^BYIMPARA($$DUZ^BYIMIMM(),0)),U,9) S X=X_"~"_$$VT(INDA)

 Q X

 ;-----

VFCD(VSIT) ;EP;TO RETURN THE VFC DATE

 N X,Y,Z

 S X=""

 S:VSIT X=$P($P($G(^AUPNVSIT(VSIT,0)),U),".")

 S:'X X=$P($G(^DPT(+DFN,0)),U,3)

 S:'X X=DT

 S X=X+17000000

 Q X

 ;-----

IVFC(INDA) ;EP;TO RETURN IMMUNIZATION SPECIFIC VFC CODE

 ;PATCH 8 CR 08628 DEFAULT TO NOT VFC ELIGIBLE IF >18

 N DFN,DOB,X,Y,Z,VFC,VDAT

 S DFN=+$P($G(^AUPNVIMM(+INDA,0)),U,2)

 S DOB=$P($G(^DPT(DFN,0)),U,3)

 S VDAT=+$P($G(^AUPNVIMM(+INDA,0)),U,3)

 S VDAT=$P($G(^AUPNVSIT(VDAT,0)),".")

 S X=$P($G(^AUPNVIMM(+INDA,0)),U,14)

 I 'X,VDAT,VDAT<(DOB-190000) S X=1

 ;PATCH 8 CR 08628 END

 I 'X S X=$$VFC($P($G(^AUPNVIMM(+INDA,0)),U,3)),X=$E(X,3)

 I X,$P(^DD(9000010.11,.14,0),U,2)["S" S X=$$IVFCD(X)

 I X,$P(^DD(9000010.11,.14,0),U,2)["P" S X=$$IVFCP(X)

 I $P($G(^BYIMPARA($$DUZ^BYIMIMM(),0)),U,9) S X=$S(X]"":(X_"~"),1:"")_$$IVT(INDA)

 Q X

 ;-----

IVFCD(IDAT) ;EP;TO RETURN THE VFC FROM SET OF CODES

 N X,Y,Z

 S Y=IDAT_":"

 S X=$P(^DD(9000010.11,.14,0),U,3)

 S X=$P($P(X,Y,2),";")

 S X="V0"_IDAT_U_X_U_"HL70064"

 Q X

 ;-----

IVFCP(IDAT) ;EP;TO RETURN THE VFC FROM POINTER

 N CODE,DESC

 S:'IDAT IDAT=1

 S CODE=$$VAL^XBDIQ1(9002084.83,IDAT,.01)

 S DESC=$$VAL^XBDIQ1(9002084.83,IDAT,.02)

 S X=$TR(CODE_U_DESC_U_"HL70064","-")

 Q X

 ;-----

VT(INDA) ;EP;TO RETURN LAST VISIT TYPE

 N X,Y,Z

 S X=+$O(^AUPNVSIT("AC",INDA,9999999999),-1)

 Q:'X ""

 S Y=$P($G(^AUPNVSIT(X,0)),".")+17000000

 Q:Y=17000000 ""

 S X=$P($G(^AUPNVSIT(X,0)),U,3)

 S X=$S(X="I":1,X="C":2,X="T":4,X="O":5,X=6:6,X="V":7,X="P":8,X="U":9,1:"")

 Q:X="" ""

 S Y="IHS0"_X_U_Y

 Q Y

 ;-----

IVT(INDA) ;EP;TO RETURN IMM VISIT TYPE

 N X,Y,Z

 S X=+$P($G(^AUPNVIMM(+INDA,0)),U,3)

 Q:'X ""

 S Y=$P($G(^AUPNVSIT(X,0)),".")+17000000

 Q:Y=17000000 ""

 S X=$P($G(^AUPNVSIT(X,0)),U,3)

 S X=$S(X="I":1,X="C":2,X="T":4,X="O":5,X=6:6,X="V":7,X="P":8,X="U":9,1:"")

 Q:X="" ""

 S Y="IHS0"_X_U_Y

 Q Y

 ;-----

HRN(INDA) ;EP;TO RETURN THE HRN CODE

 N X,XX,Y,Z,HRN,LOC,ASUFAC,BYIMDUZ

 S BYIMDUZ(2)=+DUZ(2)

 S XX=$$DUZ^BYIMIMM()

 S HRN=$P($G(^AUPNPAT(INDA,41,XX,0)),U,2)

 D:HRN=""

 .S XX=$O(^AUPNPAT(INDA,41,0))

 .I 'XX S XX=BYIMDUZ(2) Q

 .S HRN=$P($G(^AUPNPAT(INDA,41,XX,0)),U,2)

 S:$L(HRN)<6 HRN=$E("000000",1,6-$L(HRN))_HRN

 S LOC=$P($G(^DIC(4,XX,0)),U)

 S ASUFAC=$P($G(^AUTTLOC(XX,0)),U,10) S ASUFAC=$E("000000",1,6-$L(ASUFAC))_ASUFAC

 ;PATCH 7 ENSURE LOC 20 CHARACTERS OR LESS

 ;S XX=ASUFAC_HRN_CS_CS_CS_LOC_CS_"MR"

 S XX=ASUFAC_HRN_CS_CS_CS_$E(LOC,1,20)_CS_"MR"

 S X="DUZ(2)"

 S @X=BYIMDUZ(2)

 Q XX

 ;-----

RACE(INDA) ;EP;TO RETURN RACE

 N X,Y,Z

 I '$G(INDA) Q "2131-1^OTHER RACE^HL70005"

 S X=$O(^DPT(INDA,.02,0))

 S:'X X=$P($G(^DPT(INDA,0)),U,6)

 S:X X=$P($G(^DIC(10,X,0)),U,3)_U_$P($G(^DIC(10,X,0)),U)

 S:X["9999-4" X=U_$P(X,U,2)

 I $P(X,U)="" D

 .S Y=$P(X,U,2)

 .S:Y["AMERICAN INDIAN" X="1002-5"_X

 .S:Y["WHITE" X="2106-3"_X

 .S:Y["BLACK" X="2054-5"_X

 .S:$P(X,U)="" X="2131-1^OTHER RACE"

 S:X=""!(X=U) X=$P($G(^AUPNPAT(INDA,11)),U,11)

 S:X=1 X="1002-5^AMERICAN INDIAN OR ALASKA NATIVE"

 S:$P(X,U,2)="" X="2131-1^OTHER RACE"

 ;PATCH 7 USE 'OTHER' IF NO RACE ON FILE

 ;S:X["0000-0" X="2131-1^OTHER RACE"

 S:X["0000-0"!(X["9999-4") X="2131-1^OTHER RACE"

 Q (X_"^HL70005")

 ;-----

ETH(DFN)  ;EP;TO RETURN ETHNICITY

 N X,Y,Z

 S Z=""

 I '$O(^DPT(+$G(DFN),.06,0)) S Z="2186-5^NOT HISPANIC OR LATINO^CDCREC" Q Z

 S X=0

 F  S X=$O(^DPT(DFN,.06,X)) Q:'X  D

 .S Y=$P($G(^DIC(10.2,X,0)),U,3)_U_$P($G(^DIC(10.2,X,0)),U)

 .Q:Y=U

 .S Y=Y_"^CDCREC"

 .S Z=$S(Z]"":(Z_"~"),1:"")_Y

 S:Z=""!(Z["0000")!(Z["9999") Z="2186-5^NOT HISPANIC OR LATINO^CDCREC" Q Z

 Q Z

 ;-----

TEST ;EP;CREATE & SEND TEST MESSAGES

 D TEST^BYIMIMM5

 Q

IZV04 ;EP;IMMUNIZATION DATA EXCHANGE

 S BHLDEST="D DEST^INHUSEN"

 S INDEST("VXUV04")="HL IHS IZV04 IN"

 X BHLDEST

 Q

 ;-----

RSP ;EP;IMMUNIZATION DATA EXCHANGE

 S BHLDEST="D DEST^INHUSEN"

 S INDEST("RSPK11")="HL IHS IZV04 RSP IN"

 X BHLDEST

 Q

 ;-----

LOC ;EP;TO CHECK LOC. OF ENCOUNTER VERSUS OUTSIDE LOCATION

 ;PATCH 2

 N BYIMUDA,BYIMVDA,BYIMLDA,BYIMLODA

 S BYIMUDA=$O(^VA(200,"B","USER,IMMUNIZATION INTERFACE",0))

 Q:'BYIMUDA

 S BYIMVDA=0

 F  S BYIMVDA=$O(^AUPNVIMM("AD",BYIMVDA)) Q:'BYIMVDA  D

 .S X=$G(^AUPNVSIT(BYIMVDA,0))

 .Q:$P(X,U,23)'=BYIMUDA&($P(X,U,27)'=BYIMUDA)

 .S BYIMLDA=$P($G(^AUPNVSIT(BYIMVDA,0)),U,6)

 .Q:$P($G(^DIC(4,+BYIMLDA,0)),U)'="OTHER"

 .S BYIMLODA=$P($G(^AUPNVSIT(BYIMVDA,21)),U)

 .Q:BYIMLODA=""

 .S X=BYIMLODA

 .X ^%ZOSF("UPPERCASE")

 .S BYIMLODA=Y

 .Q:BYIMLODA["OTHER"

 .S BYIMLODA=$O(^DIC(4,"B",BYIMLODA,0))

 .Q:'BYIMLODA

 .S DR=".06////"_BYIMLODA

 .S DIE="^AUPNVSIT("

 .S DA=BYIMVDA

 .D ^DIE

 .I $E($G(IOST),1,2)="C-" W "."

 Q

 ;-----

PROT(INDA) ;EP;TO DETERMINE PROTECTION FLAG

 Q:'INDA ""

 N X

 S X=$P($G(^BIP(+$G(INDA),0)),U,24)

 I $G(BYIMVER)<2.5 S X=$S(X=1:"Y",X=0:"N",1:"")

 ;PATCH 7 CORRECT VERSION CHECK LOGIC

 ;I $G(BYIMVER)>2.5 S X=$S(X=1:"N",X=0:"Y",1:"")

 I $G(BYIMVER)>2.49 S X=$S(X=1:"N",X=0:"Y",1:"")

 Q X

 ;-----

PROTDT(INDA) ;EP;TO DETERMINE PROTECTION FLAG

 N X

 S X=$P($G(^BIP(+$G(INDA),0)),U,25)

 S:'X X=$P($G(^BIP(+$G(INDA),0)),U,21)

 S:X'?7N X=DT

 S X=X+17000000

 Q X

 ;-----

ACTDT(INDA) ;EP;TO DETERMINE INACTIVATION DATE

 N X

 S X=$P($G(^BIP(+$G(INDA),0)),U,8)

 S:X'?7N X=$P($G(^BIP(+$G(INDA),0)),U,21)

 S:X'?7N X=DT

 S X=X+17000000

 Q X

 ;-----

PUB(INDA) ;EP;TO DETERMINE PUBLICITY FOR PATIENT

 Q:'INDA ""

 N X

 S X=$P($G(^BIP(+$G(INDA),0)),U,99),X=$S(X=1:"N",X=0:"Y",1:"02")

 I X="01" S X=X_CS_"NO REMINDER/RECALL"_CS_"HL70215"

 I X="02" S X=X_CS_"REMINDER/RECALL - ANY METHOD"_CS_"HL70215"

 I X="03" S X=X_CS_"REMINDER/RECALL - NO CALLS"_CS_"HL70215"

 I X="04" S X=X_CS_"REMINDER ONLY - ANY METHOD"_CS_"HL70215"

 I X="05" S X=X_CS_"REMINDER ONLY - NO CALLS"_CS_"HL70215"

 I X="06" S X=X_CS_"RECALL ONLY - ANY METHOD"_CS_"HL70215"

 I X="07" S X=X_CS_"RECALL ONLY - NO CALLS"_CS_"HL70215"

 I X="08" S X=X_CS_"REMINDER/RECALL - TO PROVIDER"_CS_"HL70215"

 I X="09" S X=X_CS_"REMINDER - TO PROVIDER"_CS_"HL70215"

 I X="10" S X=X_CS_"ONLY REMINDER TO PROVIDER, NO RECALL"_CS_"HL70215"

 I X="11" S X=X_CS_"RECALL TO PROVIDER"_CS_"HL70215"

 I X="12" S X=X_CS_"ONLY RECALL TO PROVIDER, NO REMINDER"_CS_"HL70215"

 Q X

 ;-----

PUBDT(INDA) ;EP;TO DETERMINE PUBLICITY DATE

 N X

 S X=$P($G(^BIP(+$G(INDA),0)),U,21)

 S:X'?7N X=DT

 S X=X+17000000

 Q X

 ;-----

IVFS(INDA) ;EP;TO RETURN IMMUNIZATION SPECIFIC VFS CODE

 N X,Y,Z,ZD,VFC

 S X=+$P($G(^AUPNVIMM(+INDA,0)),U,5)

 S Y=$P($G(^AUTTIML(X,0)),U,13)

 ;S Z=$S(Y="v":"VXC1",Y="o":"VXC2",Y="i":"VXC3",1:"UNK")

 S Z=$S(Y="v":"VXC1",Y="o":"VXC2",Y="i":"VXC3",1:"VXC1")

 ;S ZD=$S(Y="v":"Federal funds",Y="o":"State funds",Y="i":"Tribal funds",1:"Unspecified")

 S ZD=$S(Y="v":"Federal funds",Y="o":"State funds",Y="i":"Tribal funds",1:"Federal funds")

 S X=Z_CS_ZD_CS_"CDCPHINVS"

 Q X

 ;-----

HDR ;DISPLAY HEADER

 S JJ=JJ+6

 W @IOF

 W !!,"File Status Report",?40,"Report Date: "

 W $E(DT,4,5),"/",$E(DT,6,7),"/",$E(DT,1,3)+1700

 W !!,?20,"IMP/EXP",?40,"Pat-",?48,"Imuni-",?56,"NO Pat",?64,"New",?72,"Imms"

 W !,"File",?20,"Date",?32,"Type",?40,"ients",?48,"zations",?56,"Match",?64,"Imms",?72,"Added"

 W !,"------------------",?20,"----------",?32,"------",?40,"------",?48,"------",?56,"------",?64,"------",?72,"------"

 Q

 ;-----

DIRECT ;EP;DIRECT FIND OF PATIENT

 K Y,MM

 N X,Z,DFN,NAMEX

 S NAME=$P(NAME,",")_","_$P($P(NAME,",",2)," ")

 S NAME=$TR(NAME,".","")

 S (X,NAMEX)=$E(NAME,1,$L(NAME)-1)

 F  S X=$O(^DPT("B",X)) Q:X=""!(X'[NAMEX)  D

 .S Y=0

 .F  S Y=$O(^DPT("B",X,Y)) Q:'Y  D

 ..S Z=$G(^DPT(Y,0))

 ..I $P(Z,U,3)=DOB,$P(Z,U,2)=SEX S DFN=Y Q

 ..I $P(Z,U,3)=DOB,$P(Z,U,2)'=SEX S MM="SEX"

 ..I $P(Z,U,3)'=DOB,$P(Z,U,2)=SEX S MM="DOB"

 I $G(DFN) S Y=DFN Q

 S Y=0

 I HRN F  S Y=$O(^AUPNPAT("D",HRN,Y)) Q:'Y  D

 .S Z=$G(^DPT(Y,0))

 .I $P(Z,U,3)=DOB,$P(Z,U,2)=SEX S DFN=Y

 .I $P(Z,U,3)=DOB,$P(Z,U,2)'=SEX S MM="SEX"

 .I $P(Z,U,3)'=DOB,$P(Z,U,2)=SEX S MM="DOB"

 S:$G(DFN) Y=DFN

 S:$G(MM)="" MM="NAME"

 Q

 ;-----

SEL ;EP;TO SELECT SPECIFIC PATIENTS TO RE-EXPORT

 K ^BYIMTMP($J,"BYIM EXP")

 N Y

 S Y=$P($G(^BYIMPARA($$DUZ^BYIMIMM(),0)),U,6)

 S YEARS=$S('Y:19,Y=1:65,1:99)

 S CHILD=$S('Y:"Children",1:"Patients")

 D SPAT

 Q:'$D(^BYIMTMP($J,"BYIM EXP"))

 N BYIMALL

 S BYIMALL=2

 K DIR

 S DIR(0)="YO"

 S DIR("A")="Proceed with export of selected patients"

 S DIR("B")="NO"

 W !!

 D ^DIR

 K DIR

 Q:'Y

 S MSGCNT=BYIMJ

 S BYIMTEST=BYIMJ

 S XX=$P($H,",",2)

 N DDATE

 D FN^BYIMIMM

 S (DDATE,DDDATE)=$O(^BYIMPARA($$DUZ^BYIMIMM(),"LAST EXPORT",9999999999),-1)

 D DEX^BYIMIMM

 Q

 ;-----

SPAT ;SELECT PATIENTS

 N BYIMQUIT

 S BYIMQUIT=""

 S BYIMJ=0

 F  D SPAT1 Q:BYIMQUIT

 K BYIMQUIT

 Q

 ;-----

SPAT1 ;SELECT EACH PATIENT

 W @IOF

 W !!?10,"Export selected patients"

 W !!?10,"An export file will be created for selected patients:"

 W !!

 N BYIMX

 S X=0

 F  S X=$O(^BYIMTMP($J,"BYIM EXP",X)) Q:'X  D

 .S Y=$P($G(^DPT(X,0)),U)

 .Q:Y=""

 .S BYIMX(Y)=""

 S J=0

 S X=""

 F  S X=$O(BYIMX(X)) Q:X=""  S J=J+1 W !?10,J,?15,X

 W !!

 K DIC

 S DIC="^DPT("

 S DIC(0)="AMEQZ"

 S DIC("A")="Select patient to export: "

 S DIC("S")="I $O(^AUPNVIMM(""AC"",+Y,0))"

 D ^DIC

 K DIC,DR,DA,DIE

 I Y<1 S BYIMQUIT=1 Q

 N XX,X,Z,DOB,DFN,VIS,J

 S DFN=+Y

 Q:$D(^BYIMTMP($J,"BYIM EXP",DFN))

 S XX=$O(^AUPNVIMM("AC",DFN,9999999999),-1)

 Q:'XX

 S X=$G(^AUPNVIMM(XX,0))

 S VIS=$P(X,U,3)

 Q:'VIS

 S ^BYIMTMP($J,"BYIM EXP",DFN,VIS)=""

 S BYIMJ=BYIMJ+1

 Q

 ;-----

BYIMIMM3  ;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       ;-----

SELECT    ;EP;

 +1        FOR 

               DO S1

               IF $DATA(BYIMQUIT)

                   QUIT 

 +2        KILL BYIMQUIT

 +3        QUIT 

 +4       ;-----

S1         NEW XREF,BYIMBEG,BYIMEND

 +1        WRITE @IOF

 +2        WRITE !!?20,"Select the FILE report option"

 +3        WRITE !

 +4        KILL DIR

 +5        SET DIR(0)="SO^1:File Name;2:By Date range"

 +6        DO ^DIR

 +7        KILL DIR

 +8        IF 'Y

               SET BYIMQUIT=""

               QUIT 

 +9        IF Y=1

               DO FN

               SET Y=1

               IF $DATA(BYIMQUIT)

                   KILL BYIMQUIT

                   QUIT 

 +10       IF Y=2

               DO DR

 +11       IF $DATA(BYIMQUIT)

               KILL BYIMQUIT

               QUIT 

ZIS       ;SELECT DEVICE FOR DISPLAY

 +1        SET BYIMRTN="DISP^BYIMIMM3"

 +2        DO ZIS^BYIMXIS

 +3        QUIT 

 +4       ;-----

FN        ;SELECT FILE NAME TO DISPLAY

 +1        NEW X,Y,Z

 +2        KILL DIR

 +3        SET DIR(0)="FO^1:50"

 +4        SET DIR("A")="Select FILE NAME to display"

 +5        WRITE !

 +6        DO ^DIR

 +7        KILL DIR

 +8        IF X=""

               SET BYIMQUIT=""

               QUIT 

 +9        IF '$ORDER(^BYIMPARA("FILE",X,$$DUZ^BYIMIMM(),0))

               Begin DoDot:1

 +10               WRITE !!,"No file with this name - ",X," - on file."

 +11               HANG 4

 +12               SET BYIMQUIT=""

               End DoDot:1

               QUIT 

 +13       SET BYIMBEG=X

 +14       SET XREF="FILE"

 +15       QUIT 

 +16      ;-----

DR        ;SELECT DATE RANGE FOR DISPLAY

 +1        KILL DIR

 +2        SET DIR(0)="DO"

 +3        SET DIR("A")="Beginning Date FILE STATISTICS Report"

 +4        SET Y=DT

 +5        XECUTE ^DD("DD")

 +6        SET DIR("B")=Y

 +7        WRITE !

 +8        DO ^DIR

 +9        KILL DIR

 +10       IF 'Y

               Begin DoDot:1

 +11               SET BYIMQUIT=""

 +12               WRITE !!,"To display FILE STATS by date range"

 +13               WRITE !,"the Beginning Date must be selected."

               End DoDot:1

               QUIT 

 +14       SET BYIMBEG=Y

 +15       KILL DIR

 +16       SET DIR(0)="DO"

 +17       SET DIR("A")="Ending Date FILE STATISTICS Report"

 +18       SET Y=DT

 +19       XECUTE ^DD("DD")

 +20       SET DIR("B")=Y

 +21       WRITE !

 +22       DO ^DIR

 +23       KILL DIR

 +24       IF 'Y

               SET BYIMQUIT=""

               QUIT 

 +25       SET BYIMEND=Y

 +26       SET XREF="DATE"

 +27       QUIT 

 +28      ;-----

DISP      ;EP;TO DISPLAY FILE STATS REPORT

 +1        KILL BYIMQUIT

 +2        NEW X,Y,Z,JJ,XX,YY,ZZ,XXX,BYIMPREF

 +3        SET JJ=0

 +4        DO HDR

 +5        SET BYIMPREF=""

 +6        SET XX=BYIMBEG

 +7        IF 'XX

               SET XX=$EXTRACT(XX,1,$LENGTH(XX)-1)

 +8        IF XX

               SET XX=XX-1

 +9        FOR 

               SET XX=$ORDER(^BYIMPARA(XREF,XX))

               IF XX=""!($SELECT(BYIMBEG

                   QUIT 

               Begin DoDot:1

 +10               SET YY=0

 +11               FOR 

                       SET YY=$ORDER(^BYIMPARA(XREF,XX,$$DUZ^BYIMIMM(),YY))

                       IF 'YY!(BYIMPREF]"")

                           QUIT 

                       Begin DoDot:2

 +12                       SET X=$GET(^BYIMPARA($$DUZ^BYIMIMM(),2,YY,0))

 +13                       SET Y=$PIECE(X,U)

                           SET (BYIMPREF,BYIMPREF(1))="File Name Prefix: "_$SELECT($LENGTH(Y,"_")<3:"izdata",1:$PIECE(Y,"_",1,2)_"_")