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

BYIMIMM.m

Go to the documentation of this file. 
  1. BYIMIMM ;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. ENV ;EP;
  1.  F X="XPO1","XPZ1","XPZ2","XPI1" S XPDDIQ(X)=0
  1.  N BYIMDA
  1.  S BYIMDA=+^AUTTSITE(1,0)
  1.  I '$D(^BYIMPARA(+BYIMDA,0)) D
  1.  .K DIE,DIC,DINUM,DR,DA,DD,DO,DIK,DLAYGO
  1.  .S DIC="^BYIMPARA("
  1.  .S DIC(0)="L"
  1.  .S (X,DINUM)=+^AUTTSITE(1,0)
  1.  .D FILE^DICN
  1.  .K DIE,DIC,DINUM,DR,DA,DD,DO,DIK,DLAYGO
  1.  .S BYIMDA=+Y
  1.  I $D(^BYIMPARA(BYIMDA)),'$D(^BYIMPARA(BYIMDA,0)) D
  1.  .S ^BYIMPARA(BYIMDA,0)=BYIMDA
  1.  .S ^BYIMPARA("B",BYIMDA,BYIMDA)=""
  1.  Q
  1.  ;-----
  1. DE ;EP;IMMUNIZATION EXPORT
  1.  N BYIMJOB,BYIMY,BYIMRMSG,BYIMY,BYIMX,DA,DIC,DIE,DIK,DR,DIR,D19,DD19,DATE,DDATE,DDDATE,DATE19,DEST,ENC,EVDT,FACILITY,BYIMFILE,INA,MSG,NUM,OPATH,IPATH,ZTDESC,ZTDTC,ZTIO,ZTQUEUED,ZTRTN,ZTSAVE,VALMBCK,XPDDIQ,BYIMCNT
  1.  N AGE,AGE19,MSGCNT,DFNCNT,IMMCNT,BYIMQUIT
  1.  N BYIMDATE,DEND
  1.  D PATH
  1.  I OPATH="" D NOPATH Q
  1.  K BYIMQUIT
  1.  I '$D(ZTQUEUED) D  Q:$D(BYIMQUIT)
  1.  .N WRITING,DE
  1.  .S DE=""
  1.  .D READY:$O(^BYIMPARA($$DUZ(),"LAST EXPORT",0))
  1.  .I $D(WRITING) D  Q:$D(BYIMQUIT)
  1.  ..D RESTART
  1. DATE ;EP;SELECT EXPORT DATE
  1.  K BYIMQUIT
  1.  N DATE,X,Y,Z,BYIMDUZ
  1.  S Y=2,BYIMDUZ(Y)=DUZ(2),BYIMALL=1,BYIMADM=1
  1.  I '$D(^BYIMPARA($$DUZ(),0)),+$G(^AUTTSITE(1,0)) D
  1.  .S X=+^AUTTSITE(1,0)
  1.  .I $D(^BYIMPARA(X,0)) S Y=2,DUZ(Y)=X
  1.  I '$D(^BYIMPARA($$DUZ(),0)) D
  1.  .S X=0
  1.  .F  S X=$O(^BYIMPARA(X)) Q:'X  I $D(^BYIMPARA(X,0)) S Y=2,DUZ(Y)=X Q
  1.  Q:'$D(^BYIMPARA($$DUZ(),0))
  1.  D DATE19
  1.  S (DATE,D19)=0
  1.  S X=9999999999
  1.  F  S X=$O(^BYIMPARA($$DUZ(),"LAST EXPORT",X),-1) Q:'X!DATE  D
  1.  .S:$P(^BYIMPARA($$DUZ(),"LAST EXPORT",X),U)&$P(^(X),U,2) (DATE,D19)=X
  1.  I DATE D D1 Q:$D(BYIMQUIT)
  1.  I 'DATE D
  1.  .S (DATE,D19)=$S(YEARS=19:DATE19,1:DATE99)
  1.  .Q:$D(ZTQUEUED)
  1.  .W !!,"The date of the last Immunization export is not on file."
  1.  .W !,"The export will include all Children 0-18 years of age."
  1.  I '$D(ZTQUEUED) D  Q:$D(BYIMQUIT)
  1.  .D ALL^BYIMRT
  1.  .W !!,"Evaluation of immunizations for export to the State Immunization"
  1.  .W !,"registry may take several minutes."
  1.  .S DIR(0)="YO"
  1.  .S DIR("A")="Do you want to proceed"
  1.  .S DIR("B")="NO"
  1.  .W !
  1.  .D ^DIR
  1.  .K DIR
  1.  .I Y'=1 S BYIMQUIT=""
  1.  K ^BYIMTMP($J,"BYIM EXP")
  1.  N X,Y,Z,ZZ,MSGCNT,DFN,BYIMQUIT,XX
  1.  S XX=$P($H,",",2)
  1.  ;PATCH 8
  1.  D PATH
  1.  I OPATH="" D NOPATH Q
  1.  S:'$G(BYIMFAIL) BYIMFAIL=""
  1.  ;END PATCH 8
  1.  D FN
  1.  S ^BYIMTMP("BYIMFILE")=BYIMFILE
  1.  I $D(^BYIMPARA($$DUZ(),"LAST EXPORT")) D LE Q
  1.  I '$D(^BYIMPARA($$DUZ(),"LAST EXPORT")) D NLE Q
  1.  Q
  1.  ;-----
  1. DEX ;EP;TO CREATE ACTUAL HL7 MESSAGES
  1.  ;M ^TMP("BYIMTMP")=^BYIMTMP
  1.  D HEADER
  1.  S:'$G(BYIMALL) BYIMALL=1
  1.  S:'$G(BYIMADM) BYIMADM=1
  1.  S:'$G(DDDATE) DDDATE=""
  1.  K ^BYIMTMP("LOG")
  1.  S (MSGCNT,DFN,DFNCNT,IMMCNT)=0
  1.  F  S DFN=$O(^BYIMTMP($J,"BYIM EXP",DFN)) Q:'DFN  D
  1.  .;PATCH 8 CR 08549 CHANGES TO CREATE MULTIPLE STATE FILES
  1.  .;INCLUDE ALL PATIENT - SCREEN AT FILE CREATION
  1.  .;I $P(^BYIMPARA($$DUZ(),0),U,10),'$P($G(^BIP(DFN,0)),U,24) Q
  1.  .;PATCH 8 CR 08549 END
  1.  .S DA=$O(^BYIMTMP($J,"BYIM EXP",DFN,0))
  1.  .Q:'DA
  1.  .W:'$D(ZTQUEUED) "/"
  1.  .S MSG=$$V04(DA,BYIMALL,BYIMADM,DDDATE)
  1.  .Q:MSG'["Message Created Successfully"
  1.  .S MSGCNT=MSGCNT+1
  1.  .S DFNCNT=DFNCNT+1
  1.  .S IMMCNT=IMMCNT+$$IMMCNT(DFN)
  1.  .S ^BYIMTMP("LOG",DFN)=""
  1.  S ^BYIMTMP("NUM")=MSGCNT_U_DFNCNT_U_IMMCNT
  1.  S BYIMJOB=$J
  1.  K ^BYIMTMP($J,"BYIM EXP")
  1.  S XX=$P($H,",",2)-XX
  1. ZIS S ZTRTN="HFSA^BYIMIMM"
  1.  S ZTDESC="IMMUNIZATION INTERFACE"
  1.  F X="BYIM*","DFN*","MSG*","IMM*" S ZTSAVE(X)=""
  1.  S ZTIO=""
  1.  S ZTDTC=$H
  1.  D ^%ZTLOAD
  1.  I $G(X)[U D  Q
  1.  .W !!,"The export has been terminated."
  1.  .D PAUSE
  1.  .S BYIMQUIT=""
  1.  .D RES1
  1. OUT I '$D(ZTQUEUED) D
  1.  .W !!?10,IMMCNT," immunizations for ",MSGCNT," ",CHILD," 0-",YEARS
  1.  .W !?10,"were evaluated in "
  1.  .N M,S
  1.  .S M=XX\60
  1.  .S S=XX#60
  1.  .I M]"" W M," minutes"
  1.  .I S]"" W ", ",S," seconds"
  1.  .W "."
  1.  .D PATH
  1.  .I OPATH="" D NOPATH Q
  1.  .W !!?10,"The file '",BYIMFILE,"' will now be created in the"
  1.  .W !?10,"'",OPATH,"' directory.  This may take several minutes."
  1.  .W !!?10,"It can be retrieved from this directory for transfer"
  1.  .W !?10,"to the State registry."
  1.  .D PAUSE
  1.  Q
  1.  ;-----
  1. HFSA ;EP;TO PROCESS EXPORT
  1.  H 60
  1.  S:'$G(BYIMTEST)&'$D(^BYIMPARA($$DUZ(),"LAST EXPORT",DT)) ^BYIMPARA($$DUZ(),"LAST EXPORT",DT)=$H
  1.  N READY
  1.  S READY=""
  1.  D READY
  1.  I $D(BYIMQUIT) K BYIMQUIT G HFSA
  1.  S DEST=$O(^INRHD("B","HL IHS IZV04 FRAMEWORK",0))
  1.  N PRI
  1.  S PRI=+$O(^INLHDEST(DEST,""))
  1.  D HFSA^BYIMIMM6(DEST,PRI)
  1.  S NUM=$G(^BYIMTMP("NUM"))
  1.  S DFNCNT=$P(NUM,U,2)
  1.  S IMMCNT=$P(NUM,U,3)
  1.  S NUM=+NUM
  1.  N J,X,Y
  1.  S J=0
  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 J=J+1
  1.  G:J<NUM HFSA
  1.  D FOOTER
  1.  D:$G(BYIMTEST) CLEAN^BYIMIMM5
  1.  H 30
  1.  S ^TMP($J,"BYIM","CLEAN","BEFORE")=$D(^INLHDEST(DEST))
  1.  D CLEAN
  1.  S ^TMP($J,"BYIM","CLEAN","AFTER")=$D(^INLHDEST(DEST))
  1. HFSARES ;EP;RESTART EXPORT WHEN FILE NOT CREATED 
  1.  S DEST=$O(^INRHD("B","HL IHS IZV04 FRAMEWORK",0))
  1.  N PRI
  1.  S PRI=+$O(^INLHDEST(DEST,""))
  1.  S NUM=$G(^BYIMTMP("NUM"))
  1.  K ^BYIMTMP("NUM"),^("BYIMFILE")
  1.  S DFNCNT=$P(NUM,U,2)
  1.  S IMMCNT=$P(NUM,U,3)
  1.  S NUM=+NUM
  1.  D PATH
  1.  I OPATH="" D NOPATH Q
  1.  S:'$G(BYIMFAIL) BYIMFAIL=""
  1.  D FN
  1.  D HFSA^BYIMIMM4(DEST,OPATH,BYIMFILE)
  1.  I $G(BYIMFAIL)=1 H 10 G HFSARES
  1.  I $G(BYIMFAIL)>1 S:'$G(BYIMTEST) $P(^BYIMPARA($$DUZ(),"LAST EXPORT",DT),U,2)="ExportFail" Q
  1.  S:'$G(BYIMTEST) $P(^BYIMPARA($$DUZ(),"LAST EXPORT",DT),U,2)=$H
  1.  D LOG^BYIMIMM4(BYIMFILE,"E",DFNCNT,IMMCNT,,,,OPATH)
  1.  K ^BYIMTMP("NUM")
  1.  K ^BYIMTMP("BYIMFILE")
  1.  ;PATCH 8 CR 08549 PROCESS FILES FOR MULTIPLE STATES
  1.  ;D ADDEX
  1.  ;PATCH 8 CR 08549 END
  1.  Q
  1.  ;-----
  1. READY ;EP;
  1.  N X,Y,Z
  1.  S X=""
  1.  F  S X=$O(^INLHSCH(0,X)) Q:X=""!$D(BYIMQUIT)  D
  1.  .S Y=0
  1.  .F  S Y=$O(^INLHSCH(0,X,Y)) Q:'Y!$D(BYIMQUIT)  D
  1.  ..S:$G(^INTHU(Y,3,1,0))["V04" BYIMQUIT=""
  1.  I '$D(BYIMQUIT) D  Q
  1.  .S DEST=$O(^INRHD("B","HL IHS IZV04 FRAMEWORK",0))
  1.  .I '$D(READY),$D(^INLHDEST(+DEST)) D  Q
  1.  ..W:'$D(ZTQUEUED) !!,"Immunization data file creation still in process."
  1.  ..S WRITING=""
  1.  ..H 4
  1.  .Q:$D(ZTQUEUED)!$D(DE)
  1.  .N NUM
  1.  .S NUM=+$G(^BYIMTMP("NUM"))
  1.  .H 2
  1.  .W !!,"The Immunization data export file is ready for transmission"
  1.  .W !,"to the state immunization registry."
  1.  .H 4
  1.  .N J,X,Y,NUM,PRI
  1.  .S PRI=0
  1.  .S J=0
  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 J=J+1
  1.  .S $P(^BYIMTMP("NUM"),U)=J
  1.  Q:$D(ZTQUEUED)
  1.  W !!,"Immunization data export still in process."
  1.  S J=0
  1.  S X=""
  1.  F  S X=$O(^INLHSCH(0,X)) Q:X=""  D
  1.  .S Y=0
  1.  .F  S Y=$O(^INLHSCH(0,X,Y)) Q:'Y  D
  1.  ..S:$G(^INTHU(Y,3,1,0))["V04" J=J+1
  1.  W " (",J,")"
  1.  H 2
  1.  Q
  1.  ;-----
  1. V04(BYIMVST,BYIMALL,BYIMADM,DDDATE)        ;this is the unsolicited Imm record
  1.  I 'BYIMVST Q $$MSG("VST")
  1.  D PATH
  1.  S BYIMPAT=$P($G(^AUPNVSIT(BYIMVST,0)),U,5)
  1.  S INDA=BYIMPAT
  1.  S INDA(9000010,1)=BYIMVST
  1.  S INDA(2,1)=BYIMPAT
  1.  S INDA("BYIMALL")=$G(BYIMALL)
  1.  S INDA("BYIMADM")=$G(BYIMADM)
  1.  S INDA("DDDATE")=$G(DDDATE)
  1.  S BYIMPAR="HL IHS IZV04 OUT PARENT"
  1.  D ^INHF(BYIMPAR,.INDA)
  1.  D EOJ
  1.  Q $$MSG(INHF)
  1.  ;-----
  1.  S DEST=$O(^INRHD("B","HL IHS IZV04 FRAMEWORK",0))
  1.  K ^INLHDEST(+DEST)
  1.  D NOW^%DTC
  1.  S INA("EVDT")=%
  1.  S EVDT="INA(""EVDT"")"
  1.  S INA("ENC")="^~\&"
  1.  S ENC="INA(""ENC"")"
  1.  S INA("FACILITY")=$P($G(^DIC(4,$$DUZ(),0)),U)
  1.  S FACILITY="INA(""FACILITY"")"
  1.  L +^INTHU(0):DTIME
  1.  S INDA=$P(^INTHU(0),U,3)
  1.  D ^INHF("HL IHS IZV04 OUT HEADER PARENT",.INDA,.INA)
  1.  L -^INTHU(0)
  1.  D EOJ
  1.  Q
  1.  ;-----
  1.  S INDA=$P(^INTHU(0),U,3)+1
  1.  D ^INHF("HL IHS IZV04 OUT FOOTER PARENT",.INDA,.INA)
  1.  D EOJ
  1.  Q
  1.  ;-----
  1. EOJ ;EP;kills variables
  1.  K INDA,BYIMPAT,BYIMVST,BYIMVAIN,BYIMADT
  1.  Q
  1.  ;-----
  1. MSG(BYIMMVAR)        ;-- return message defining status
  1.  I BYIMMVAR="PAT" S BYIMRMSG="Patient Not Passed In, Message Not Created"
  1.  I BYIMMVAR="VST" S BYIMRMSG="Visit Not Passed In, Message Not Created"
  1.  I BYIMMVAR="VLAB" S BYIMRMSG="VLAB Not Passed In, Message Not Created"
  1.  I BYIMMVAR="MFL" S BYIMRMSG="Mstr File Not Passed In, Message Not Created"
  1.  I BYIMMVAR=0 S BYIMRMSG="Message Not Created, problem with GIS call"
  1.  I BYIMMVAR S BYIMRMSG=BYIMMVAR_U_"Message Created Successfully"
  1.  Q $G(BYIMRMSG)
  1.  ;-----
  1. IMZIS S ZTRTN="HFSARES^BYIMIMM"
  1.  S ZTDESC="IMMUNIZATION INTERFACE"
  1.  S ZTIO=""
  1.  S ZTSAVE("BYIMJOB")=""
  1.  S ZTDTC=$H
  1.  D ^%ZTLOAD
  1.  Q
  1.  ;-----
  1. STRIP(Z) ;REMOVE CONTROLL CHARACTERS
  1.  N I
  1.  F I=1:1:$L(Z) I (32>$A($E(Z,I))) S Z=$E(Z,1,I-1)_" "_$E(Z,I+1,999)
  1.  Q Z
  1.  ;-----
  1. BACK S VALMBCK="R"
  1.  Q
  1.  ;-----
  1. MPORT ;EP;run the import package utility
  1.  I $O(^INXPORT(""))="" D  Q
  1.  . W !,"Global ^INXPORT missing, please restore and the global."
  1.  S BYIMIT=$O(^INXPORT(""))
  1.  S BYIMIST=$O(^INXPORT(BYIMIT,""))
  1.  S BYIMIPK=$O(^INXPORT(BYIMIT,BYIMIST,""))
  1.  W !,"Importing GIS "_$G(BYIMIT)_" Supplement "_$G(BYIMIPK)
  1.  W ", developing site "_$G(BYIMIST)
  1.  D ^BYIMPORT
  1.  W !,"Finished Importing GIS Supplement "
  1.  K BYIMIT,BYIMIST,BYIMIPK
  1.  Q
  1.  ;-----
  1. RESTART ;EP;
  1.  S DIR(0)="YO"
  1.  W !!,"Do you want to restart the export?"
  1.  S DIR("B")="NO"
  1.  D ^DIR
  1.  K DIR
  1.  I Y'=1 S BYIMQUIT="" Q
  1.  D HFSARES
  1.  Q:'$G(BYIMFAIL)
  1.  D RES1
  1.  D PATH
  1.  I OPATH="" D NOPATH Q
  1.  D FN
  1.  S Y=$$DEL^%ZISH(OPATH,BYIMFILE)
  1.  Q
  1.  ;-----
  1. RES1 ;CLEAR CURRENT EXPORT QUEUE
  1.  S DEST=$O(^INRHD("B","HL IHS IZV04 FRAMEWORK",0))
  1.  K ^INLHDEST(DEST)
  1.  N X,Y,Z,BYIMQUIT
  1.  S X=""
  1.  F  S X=$O(^INLHSCH(0,X)) Q:X=""!$D(BYIMQUIT)  D
  1.  .S Y=0
  1.  .F  S Y=$O(^INLHSCH(0,X,Y)) Q:'Y!$D(BYIMQUIT)  D
  1.  ..I $G(^INTHU(Y,3,1,0))["V04" K ^INLHSCH(0,X,Y)
  1.  Q
  1.  ;-----
  1. DATE19 ;SET AGE FOR EXPORT
  1.  N Y
  1.  S Y=$P($G(^BYIMPARA($$DUZ(),0)),U,6)
  1.  S YEARS=$S('Y:19,Y=1:65,1:99)
  1.  S CHILD=$S('Y:"Children",1:"Patients")
  1.  S (AGE,AGE19)=19*10000
  1.  S DATE19=DT-(19*10000)
  1.  S AGE65=65*10000
  1.  S DATE65=DT-(65*10000)
  1.  S AGE99=99*10000
  1.  S DATE99=DT-(99*10000)
  1.  S D19=$S(YEARS=19:DATE19,YEARS=65:DATE65,1:DATE99)
  1.  Q
  1.  ;-----
  1. ADDEX ;EP;PROCESS ADDITIONAL EXPORT SITES
  1.  ;PATCH 8 CR 08627 CORRECT 'COPY' FOR MULTI-SITES
  1.  ;PATCH 8 CR 08627 END
  1.  Q
  1.  ;-----
  1. LE ;PROCESS SEQUENTIAL EXPORT
  1.  S:'$G(DDDATE) DDDATE=""
  1.  S:'$G(DEND) DEND=9999999
  1.  S D19=D19-.01
  1.  F  S D19=$O(^AUPNVSIT("APCIS",D19)) Q:'D19!(D19>DEND)  D
  1.  .S DA=0
  1.  .F  S DA=$O(^AUPNVSIT("APCIS",D19,DA)) Q:'DA  D
  1.  ..S X=$G(^AUPNVSIT(DA,0))
  1.  ..S DFN=$P(X,U,5)
  1.  ..Q:'DFN
  1.  ..Q:$D(^BYIMTMP($J,"BYIM EXP",DFN))
  1.  ..Q:$G(^DPT(DFN,.35))!'$O(^AUPNPAT(DFN,41,0))!'$G(^AUPNPAT(DFN,0))
  1.  ..S X=$G(^DPT(DFN,0))
  1.  ..Q:X=""
  1.  ..Q:X["PATIENT,ERROR"!(X["ERROR,PATIENT")!(X["DEMO,PAT")
  1.  ..;FILTER OUT KIDS WITHOUT PERMANENT NAME
  1.  ..Q:X["BABY "!(X["BABY ")
  1.  ..;PATCH 8 CR 08549 CHANGES TO CREATE MULTIPLE STATE FILES
  1.  ..;Q:$P($G(^BIP(DFN,0)),U,24)=0
  1.  ..S:'$G(BYIMALL) BYIMALL=1
  1.  ..S:'$G(BYIMADM) BYIMADM=1
  1.  ..S:'$G(DDATE) DDATE=""
  1.  ..;PATCH 8 CR 08549 END
  1.  ..I YEARS=19 Q:$P(X,U,3)<DATE19
  1.  ..I YEARS=65 Q:$P(X,U,3)<DATE19&($P(X,U,3)>DATE65)
  1.  ..I BYIMALL,BYIMALL'=2!(BYIMADM&BYIMADM'=2) Q:'$$NEW^BYIMIMM6(DFN,BYIMALL,BYIMADM,DDDATE)
  1.  ..S ^BYIMTMP($J,"BYIM EXP",DFN,DA)=""
  1.  ..W:'$D(ZTQUEUED) "."
  1.  I '$O(^BYIMTMP($J,"BYIM EXP",0)) D  Q
  1.  .S BYIMFILE="NoImmsToExp_"_$P($G(^AUTTLOC($$DUZ(),0)),U,10)_"_"_(DT+17000000)_"_"_$P($H,",",2)_".dat"
  1.  .S:'$G(BYIMTEST) $P(^BYIMPARA($$DUZ(),"LAST EXPORT",DT),U)=$H,$P(^(DT),U,2)=$H
  1.  .S DFNCNT=0
  1.  .S IMMCNT=0
  1.  .D PATH^BYIMIMM6
  1.  .D LOG^BYIMIMM4(BYIMFILE,"E",DFNCNT,IMMCNT,,,,OPATH)
  1.  .S:'$G(BYIMTEST) $P(^BYIMPARA($$DUZ(),"LAST EXPORT",DT),U,2)="NoImmsToExp"
  1.  .Q:$D(ZTQUEUED)
  1.  .W !!,"No Immunizations found that need to be exported."
  1.  .D PAUSE
  1.  D DEX
  1.  S Y=2,DUZ(Y)=BYIMDUZ(2)
  1.  Q
  1.  ;-----
  1. NLE ;PROCESS FIRST EXPORT
  1.  N BYIMALL
  1.  S BYIMALL=2
  1.  S BYIMADM=2
  1.  F  S D19=$O(^DPT("ADOB",D19)) Q:'D19  D
  1.  .S DFN=0
  1.  .F  S DFN=$O(^DPT("ADOB",D19,DFN)) Q:'DFN  D
  1.  ..Q:$G(^DPT(DFN,.35))!'$G(^AUPNPAT(DFN,0))
  1.  ..S X=$G(^DPT(DFN,0))
  1.  ..Q:X["PATIENT,ERROR"!(X["ERROR,PATIENT")!(X["DEMO,PAT")!($E(X,1,2)="ZZ")!$P(X,U,19)
  1.  ..S X=$O(^AUPNVSIT("AC",DFN,9999999999),-1)
  1.  ..Q:'X
  1.  ..Q:'$G(^AUPNVSIT(X,0))
  1.  ..Q:+^AUPNVSIT(X,0)<DATE
  1.  ..Q:$O(^BYIMTMP($J,"BYIM EXP",DFN,0))
  1.  ..S ^BYIMTMP($J,"BYIM EXP",DFN,X)=""
  1.  ..W:'$D(ZTQUEUED) "."
  1.  D DEX
  1.  S Y=2,DUZ(Y)=BYIMDUZ(2)
  1.  Q
  1.  ;-----
  1. D1 ;PROCESS WHEN DATE IDENTIFIED
  1.  S (Y,DDDATE)=DATE
  1.  X ^DD("DD")
  1.  S DDATE=Y
  1.  S Y=DT-AGE
  1.  X ^DD("DD")
  1.  S DD19=Y
  1.  Q:$D(ZTQUEUED)
  1.  W @IOF
  1.  W !!,"The last Immunization export ran on: ",DDATE
  1.  I YEARS=19 D
  1.  .W !,"Children 18 and under were born after: ",DD19
  1.  W !!,"This export will include: ",!
  1.  I YEARS=19 D
  1.  .W !?5,"Children 18 and under"
  1.  I YEARS=65 D
  1.  .W !?5,"Children 18 and under and"
  1.  .W !?5,"Adults.. 65 and over"
  1.  I YEARS=99 D
  1.  .W !?5,"All patients"
  1.  W !!,"who have had a visit since the last export."
  1.  W !,"You can enter another date for the export."
  1.  S DIR(0)="DO"
  1.  S DIR("A")="Export Immunizations given since "_DDATE
  1.  S DIR("B")=DDATE
  1.  W !
  1.  D ^DIR
  1.  K DIR
  1.  I 'Y S BYIMQUIT="" Q
  1.  S (BYIMDATE,DATE,D19)=Y
  1.  S Y=DT
  1.  X ^DD("DD")
  1.  S DEND=Y
  1.  S DIR(0)="DO"
  1.  S DIR("A")="Exclude Immunizations given after "_DEND
  1.  S DIR("B")=DEND
  1.  W !
  1.  I D19=DT S Y=DT
  1.  I D19<DT D ^DIR
  1.  K DIR
  1.  I 'Y S BYIMQUIT="" Q
  1.  S DEND=Y
  1.  Q
  1.  ;-----
  1. PATH ;EP;SET PATH
  1.  D PATH^BYIMIMM6
  1.  Q
  1.  ;-----
  1. NOPATH ;EP;NO PATH MESSAGE
  1.  D NOPATH^BYIMIMM6
  1.  Q
  1.  ;-----
  1. PAUSE ;EP;FOR PAUSE READ
  1.  D PAUSE^BYIMIMM6
  1.  Q
  1.  ;-----
  1. CLEAN ;CLEAN OUT MESSAGES WITH NO RXA SEGMENT, BLANK RXR AND OBX SEGMENTS
  1.  N DEST,QUIT,X,Y,Z,XX,ZZ
  1.  S DEST=$O(^INRHD("B","HL IHS IZV04 FRAMEWORK",0))
  1.  Q:'DEST
  1.  S X=""
  1.  F  S X=$O(^INLHDEST(DEST,X)) Q:'X  D
  1.  .S Y=""
  1.  .F  S Y=$O(^INLHDEST(DEST,X,Y)) Q:Y=""  D
  1.  ..S Z=0
  1.  ..F  S Z=$O(^INLHDEST(DEST,X,Y,Z)) Q:'Z  D
  1.  ...S QUIT=0
  1.  ...S ZZ=0
  1.  ...F  S ZZ=$O(^INTHU(Z,3,ZZ)) Q:'ZZ  S XX=^(ZZ,0) D
  1.  ....I XX["RXA" S QUIT=1 Q
  1.  ....I XX["RXR||" K ^INTHU(Z,3,ZZ,0) Q
  1.  ....I XX["OBX|"&(XX["V00") K ^INTHU(Z,3,ZZ,0)
  1.  ...Q:QUIT
  1.  ...K ^INLHDEST(DEST,X,Y,Z)
  1.  Q
  1.  ;-----
  1. IMMCNT(DFN) ;COUNT PT IMMS TO BE EXPORTED
  1.  N X,Y,Z
  1.  S Y=0
  1.  S X=0
  1.  F  S X=$O(^AUPNVIMM("AC",DFN,X)) Q:'X  D
  1.  .I $G(BYIMALL)=2 S Y=Y+1,^BYIMTMP("LOG",DFN,X)="" Q
  1.  .I '$D(^BYIMEXP("D",X)) S Y=Y+1,^BYIMTMP("LOG",DFN,X)=""
  1.  Q Y
  1.  ;-----
  1. FN ;EP;SET FILE NAME
  1.  S:'$G(ASUFAC) ASUFAC=$P($G(^AUTTLOC($$DUZ(),0)),U,10)
  1.  S:$G(BYIMFILE)="" BYIMFILE="izdata_"_$G(ASUFAC)_"_"_(DT+17000000)_"_"_$P($H,",",2)_$S($G(BYIMTEST):"_test",1:"")_"."_BYIMEXT
  1.  Q
  1.  ;-----
  1. DUZ() ;PRIMARY PARAM SITE
  1.  N X,Y,Z
  1.  S Y=0
  1.  S X=0
  1.  F  S X=$O(^BYIMPARA(X)) Q:'X  I X=+^AUTTSITE(1,0) S Y=X
  1.  I 'Y S X=0 F  S X=$O(^BYIMPARA(X)) Q:'X  I $D(^BYIMPARA(X,0)) S Y=X
  1.  Q Y
  1.  ;-----