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

BYIMMU2.m

Go to the documentation of this file.
  1. BYIMMU2 ;IHS/CIM/THL - IMMUNIZATION DATA EXCHANGE;
  1. ;;2.0;BYIM IMMUNIZATION DATA EXCHANGE;**3,4,5,6,7,8**;JUL 11, 2017;Build 310
  1. ;
  1. ;----
  1. Q
  1. ALL ;EP;
  1. D MU2
  1. H 5
  1. D SEND
  1. Q
  1. MU2 ;EP;SETUP MU2 PATIENTS AND DATA
  1. D WARN
  1. I $G(BYIMQUIT) K BYIMQUIT Q
  1. ;I $D(^BYIMTMP("RESTORE")) D RESTORE
  1. K ^BYIMTMP("MU2")
  1. D MU21^BYIMMU21
  1. D PAT
  1. W !!,"NIST test environment prepared."
  1. D PAUSE^BYIMIMM6
  1. Q
  1. ;-----
  1. PAT ;SET PATIENT DEMOGRAPHICS
  1. K ^BYIMTMP("MU2","PAT")
  1. S TT=10
  1. S JJ=0
  1. F IEN=$R(999):10 D Q:JJ=7&(TT=13)!(IEN>$P(^DPT(0),U,3))
  1. .Q:'$D(^DPT(IEN,0))
  1. .Q:'$D(^AUPNPAT(IEN,0))
  1. .Q:'$D(^AUPNPAT(IEN,41,DUZ(2),0))
  1. .Q:'$O(^AUPNVIMM("AC",IEN,0))
  1. .Q:$O(^AUPNVIMM("AC",IEN,0))=$O(^AUPNVIMM("AC",IEN,9999999999),-1)
  1. .K ^BYIMTMP("MU2","V7")
  1. .S K=0
  1. .S (J,X)=0
  1. .F S X=$O(^AUPNVIMM("AC",IEN,X)) Q:'X!K D
  1. ..S VSIT=+$P($G(^AUPNVIMM(X,0)),U,3)
  1. ..S:'$D(^BYIMTMP("MU2","V7",VSIT)) J=J+1
  1. ..S ^BYIMTMP("MU2","V7",VSIT)=""
  1. ..I J>3 S K=1
  1. .Q:'K
  1. .S TT=TT+1
  1. .S:TT=11 JJ=JJ+1
  1. .S PID="P"_JJ_TT
  1. .D P1(PID)
  1. .I TT=13,JJ'=7 S TT=10
  1. Q
  1. ;-----
  1. P1(PID) ;PROCESS EACH PATIENT
  1. ;S PID="P"_JJ_TT
  1. S YY=^BYIMTMP("MU2","DATA",PID)
  1. S ZZ=""
  1. S:$E(PID,1,3)="P11" L2=PID_2,ZZ=^BYIMTMP("MU2","DATA",L2)
  1. K DA,DR,DIE
  1. S DR=$P(YY,";",3)
  1. S DR=$TR(DR,"|",";")
  1. S NET=$P($P(YY,"1802////",2),";")
  1. S NAM=$P($P(DR,".01////",2),";")
  1. S DR=$P(DR,";",2,99)
  1. I 0,$D(^DPT("B",NAM,IEN)) D Q
  1. .I TT=11 S JJ=JJ-1
  1. .S TT=TT-1
  1. D NCLEAN(NAM,IEN)
  1. M ^BYIMTMP("RESTORE","DPT",IEN)=^DPT(IEN)
  1. M ^BYIMTMP("RESTORE","AUPNPAT",IEN)=^AUPNPAT(IEN)
  1. W !,$J(IEN,6),?8,NAM,"..." H 1
  1. S DA=IEN
  1. S DIE="^DPT("
  1. D ^DIE
  1. D:ZZ]""
  1. .S DA=IEN
  1. .S DIE="^DPT("
  1. .S DR=$P(ZZ,";",3)
  1. .S DR=$TR(DR,"|",";")
  1. .D ^DIE
  1. S ^BYIMTMP("MU2","PAT",PID)=DA
  1. S $P(^BIP(DA,0),U)=DA
  1. S $P(^BIP(DA,0),U,8)=""
  1. S $P(^BIP(DA,0),U,16)=""
  1. S $P(^BIP(DA,0),U,21)=$P(^DPT(DA,0),U,3)
  1. S $P(^BIP(DA,0),U,24)=1
  1. S $P(^BIP(DA,0),U,25)=DT
  1. K ^DPT(DA,.35)
  1. S:NET]"" $P(^AUPNPAT(DA,18),U,2)=NET
  1. D VISIT(DA,PID)
  1. Q
  1. ;-----
  1. VISIT(DFN,PID) ;SETUP VISIT DATA
  1. N X,Y,Z
  1. S NUM=$E(PID,2)
  1. I NUM=7 D V7(DFN,PID) Q
  1. S ID=$E(PID,2,5)
  1. S LOS="T"_$E(PID,2,5)
  1. S VID="V"_ID
  1. S IID="I"_ID
  1. S BIP="BIP"_ID
  1. S REF="REF"_ID
  1. S BIPC="BIPC"_ID
  1. K:NUM'=5 ^AUPNPREF("AC",DFN)
  1. K:NUM'=6 ^BIPC("B",DFN)
  1. S X=0
  1. F S X=$O(^AUPNVIMM("AC",DFN,X)) Q:'X S ^BYIMEXP("D",X)="",VIMM=X
  1. I NUM<5 K ^BYIMEXP("D",VIMM)
  1. S VSIT=$P(^AUPNVIMM(VIMM,0),U,3)
  1. K DA,DR,DIE
  1. S DA=VSIT
  1. S DR=$P(^BYIMTMP("MU2","DATA",VID),";",3)
  1. S DR=$TR(DR,"|",";")
  1. D:DR]""
  1. .M ^BYIMTMP("RESTORE","DPT",DFN,"VSIT",DA)=^AUPNVSIT(DA)
  1. .S DIE="^AUPNVSIT("
  1. .D ^DIE
  1. .K DA,DR,DIE
  1. K DA,DR,DIE
  1. S DA=VIMM
  1. S DR=$P(^BYIMTMP("MU2","DATA",IID),";",3)
  1. S DR=$TR(DR,"|",";")
  1. D:DR["P1202"
  1. .S P1202=^BYIMTMP("MU2","PRV",1202)
  1. .S P1204=^BYIMTMP("MU2","PRV",1204)
  1. .S P1214=^BYIMTMP("MU2","PRV",1214)
  1. .S DR=$P(DR,"P1202")_P1202_$P(DR,"P1202",2)
  1. .S DR=$P(DR,"P1204")_P1204_$P(DR,"P1204",2)
  1. .S DR=$P(DR,"P1214")_P1214_$P(DR,"P1214",2)
  1. S:LOS]"" LOT=$G(^BYIMTMP("MU2","LOT",LOS))
  1. I LOT,DR[LOS S DR=$P(DR,LOS)_LOT_$P(DR,LOS,2)
  1. S DIE="^AUPNVIMM("
  1. M ^BYIMTMP("RESTORE","DPT",DFN,"VIMM",DA)=^AUPNVIMM(DA)
  1. D:DR]"" ^DIE
  1. K DA,DR,DIE
  1. D:NUM=4 BIP
  1. ;-----
  1. D:NUM=5 REF
  1. ;-----
  1. D:NUM=6 BIPC
  1. ;-----
  1. Q
  1. ;-----
  1. BIP ;
  1. K DA,DR,DIE
  1. S DA=DFN
  1. S DR=$P(^BYIMTMP("MU2","DATA",BIP),";",3)
  1. S DR=$TR(DR,"|",";")
  1. S DIE="^BIP("
  1. D ^DIE
  1. K DA,DR,DIE
  1. Q
  1. ;-----
  1. REF ;
  1. K DA,DR,DIE
  1. S DA=$O(^AUPNPREF("AC",DFN,0))
  1. D:'DA
  1. .S X=3
  1. .S DIC="^AUPNPREF("
  1. .S DIC(0)="L"
  1. .S DIC("DR")=".02////"_DFN
  1. .D FILE^DICN
  1. .S DA=+Y
  1. K ^BYIMEXP("REF",DA)
  1. S DR=$P(^BYIMTMP("MU2","DATA",REF),";",3)
  1. S DR=$TR(DR,"|",";")
  1. S DR=$P(DR,"DFN")_DFN_$P(DR,"DFN",2)
  1. S DIE="^AUPNPREF("
  1. D ^DIE
  1. K DA,DR,DIE
  1. Q
  1. ;-----
  1. BIPC ;
  1. K DA,DR,DIE
  1. S DA=$O(^BIPC("B",DFN,0))
  1. D:'DA
  1. .S X=DFN
  1. .S DIC="^BIPC("
  1. .S DIC(0)="L"
  1. .S DIR("DR")=".02////132"
  1. .D FILE^DICN
  1. .K DIC
  1. .S DA=+Y
  1. K ^BYIMEXP("HXV",DA)
  1. S DR=$P(^BYIMTMP("MU2","DATA",BIPC),";",3)
  1. S DR=$TR(DR,"|",";")
  1. S DR=$P(DR,"DFN")_DFN_$P(DR,"DFN",2)
  1. S DIE="^BIPC("
  1. D ^DIE
  1. K DA,DR,DIE
  1. Q
  1. ;-----
  1. SEND ;EP;SEND RT VXU MU2 MESSAGES
  1. ;D WARN
  1. N BYIMMU2
  1. S BYIMMU2=1
  1. I $G(BYIMQUIT) K BYIMQUIT Q
  1. W !!,"Please stand by while I create and send the NIST messages...",!
  1. S SCN=""
  1. F S SCN=$O(^BYIMTMP("MU2","PAT",SCN)) Q:SCN="" S DFN=^(SCN) D
  1. .S RT="VXU"
  1. .;PATCH 8 CR 08626 - SEND ONLY ADMINISTERED IMMS
  1. .S BYIMALL=1
  1. .;PATCH 8 CR 08626 END
  1. .D VXU^BYIMRT(DFN)
  1. H 30
  1. ;D RESTORE
  1. Q
  1. ;-----
  1. V7(DFN,PID) ;SETUP VISIT DATA
  1. K ^BYIMTMP("MU2","V7")
  1. N X,Y,Z
  1. S NUM=7
  1. S ID=$E(PID,2,5)
  1. S LOS="T"_$E(PID,2,5)
  1. S VID="V"_ID
  1. S IID="I"_ID
  1. K ^AUPNPREF("AC",DFN)
  1. K ^BIPC("B",DFN)
  1. S CNT=1
  1. S X=0
  1. F S X=$O(^AUPNVIMM("AC",DFN,X)) Q:'X D
  1. .S ^BYIMEXP("D",X)=""
  1. .S V=$P($G(^AUPNVIMM(X,0)),U,3)
  1. .I CNT<4,'$D(^BYIMTMP("MU2","V7",V)) D
  1. ..S TMP(CNT)=V_U_X
  1. ..S CNT=CNT+1
  1. ..K ^BYIMEXP("D",X)
  1. ..S ^BYIMTMP("MU2","V7",V)=""
  1. D P7(DFN,PID,.TMP)
  1. Q
  1. ;-----
  1. P7(DFN,PID,TMP) ;PROCESS SCENARIO 7 VISITS
  1. N CNT
  1. S CNT=0
  1. F CNT=1,2,3 S X=TMP(CNT) D
  1. .S VSIT=+X
  1. .Q:'VSIT
  1. .S VIMM=$P(X,U,2)
  1. .K ^BYIMEXP("D",VIMM)
  1. .S ^BYIMTMP("MU2","V7",VSIT)=""
  1. .D:CNT>1
  1. ..S VID=$E(VID,1,4)_CNT
  1. ..S IID=$E(IID,1,4)_CNT
  1. .S (LOS,LOT)=""
  1. .S:CNT=1 LOS="T"_$E(PID,2,4)
  1. .S:CNT=3 LOS="T"_$E(PID,2,4)_3
  1. .K DA,DR,DIE
  1. .S DA=VSIT
  1. .S DR=$P(^BYIMTMP("MU2","DATA",VID),";",3)
  1. .S DR=$TR(DR,"|",";")
  1. .M ^BYIMTMP("RESTORE","DPT",DFN,"VSIT",DA)=^AUPNVSIT(DA)
  1. .S DIE="^AUPNVSIT("
  1. .D ^DIE
  1. .K DA,DR,DIE
  1. .S DA=VIMM
  1. .S DR=$P(^BYIMTMP("MU2","DATA",IID),";",3)
  1. .S DR=$TR(DR,"|",";")
  1. .S:LOS]"" LOT=$G(^BYIMTMP("MU2","LOT",LOS))
  1. .I LOT,DR[LOS S DR=$P(DR,LOS)_LOT_$P(DR,LOS,2)
  1. .D:DR["P1202"
  1. ..S P1202=^BYIMTMP("MU2","PRV",1202)
  1. ..S P1204=^BYIMTMP("MU2","PRV",1204)
  1. ..S P1214=^BYIMTMP("MU2","PRV",1214)
  1. ..S DR=$P(DR,"P1202")_P1202_$P(DR,"P1202",2)
  1. ..S DR=$P(DR,"P1204")_P1204_$P(DR,"P1204",2)
  1. ..S DR=$P(DR,"P1214")_P1214_$P(DR,"P1214",2)
  1. .S DIE="^AUPNVIMM("
  1. .M ^BYIMTMP("RESTORE","DPT",DFN,"VIMM",DA)=^AUPNVIMM(DA)
  1. .D ^DIE
  1. .K DA,DR,DIE
  1. K ^BYIMTMP("MU2","V7",VSIT)
  1. Q
  1. ;-----
  1. NCLEAN(NAM,IEN) ;CLEAN 'B' XREF
  1. S ^DPT("B",NAM,IEN)=""
  1. N X,Y,Z
  1. S X=0
  1. F S X=$O(^DPT("B",NAM,X)) Q:'X I X'=IEN K ^DPT("B",NAM,X)
  1. Q
  1. ;-----
  1. RESTORE ;RESTORE ORIGINAL DPT AND AUPNPAT CONTENT
  1. Q W !!,"Please stand by while I restore the pre-NIST environment...",!
  1. S DFN=0
  1. F S DFN=$O(^BYIMTMP("RESTORE","AUPNPAT",DFN)) Q:'DFN D R1(DFN)
  1. RPRV S PRV=0
  1. F S PRV=$O(^BYIMTMP("RESTORE","PRV",PRV)) Q:'PRV D
  1. .M ^VA(200,PRV)=^BYIMTMP("RESTORE","PRV",PRV)
  1. .K DA,DIK
  1. .S DA=PRV
  1. .S DIK="^VA(200,"
  1. .D IX1^DIK
  1. .K DA,DIK
  1. RIML S IML=0
  1. F S IML=$O(^BYIMTMP("RESTORE","IML",IML)) Q:'IML D
  1. .M ^AUTTIML(IML)=^BYIMTMP("RESTORE","IML",IML)
  1. .K DA,DIK
  1. .S DA=IML
  1. .S DIK="^AUTTIML("
  1. .D IX1^DIK
  1. .K DA,DIK
  1. RIMM S IMM=0
  1. F S IMM=$O(^BYIMTMP("RESTORE","IMM",IMM)) Q:'IMM D
  1. .M ^AUTTIMM(IMM)=^BYIMTMP("RESTORE","IMM",IMM)
  1. .K DA,DIK
  1. .S DA=IMM
  1. .S DIK="^AUTTIMM("
  1. .D IX1^DIK
  1. .K DA,DIK
  1. S X=0
  1. F S X=$O(^BYIMTMP("RESTORE","AUPNPAT",X)) Q:'X I $D(^AUPNPAT(X,0)) K ^BYIMTMP("RESTORE","AUPNPAT",X)
  1. I $O(^BYIMTMP("RESTORE","AUPNPAT",0)) W !!,"AUPNPAT... Pending"
  1. E K ^BYIMTMP("RESTORE")
  1. W !!,"Database RESTORE process complete."
  1. D PAUSE^BYIMIMM6
  1. Q
  1. ;-----
  1. R1(DFN) ;DO RESTORE
  1. M ^AUPNPAT(DFN)=^BYIMTMP("RESTORE","AUPNPAT",DFN)
  1. K DA,DIK
  1. S DA=DFN
  1. S DIK="^AUPNPAT("
  1. D IX1^DIK
  1. K DA,DIK
  1. M ^DPT(DFN)=^BYIMTMP("RESTORE","DPT",DFN)
  1. S DA=DFN
  1. S DIK="^DPT("
  1. D IX1^DIK
  1. K DA,DIK
  1. VSIT S VSIT=0
  1. F S VSIT=$O(^BYIMTMP("RESTORE","DPT",DFN,"VSIT",VSIT)) Q:'VSIT D
  1. .M ^AUPNVSIT(VSIT)=^BYIMTMP("MU2","DPT",DFN,"VSIT",VSIT)
  1. .K DA,DIK
  1. .S DA=VSIT
  1. .S DIK="^AUPNVSIT("
  1. .D IX1^DIK
  1. .K DA,DIK
  1. VIMM S VIMM=0
  1. F S VIMM=$O(^BYIMTMP("RESTORE","DPT",DFN,"VIMM",VIMM)) Q:'VIMM D
  1. .M ^AUPNVIMM(VIMM)=^BYIMTMP("RESTORE","DPT",DFN,"VIMM",VIMM)
  1. .K DA,DIK
  1. .S DA=VIMM
  1. .S DIK="^AUPNVIMM("
  1. .D IX1^DIK
  1. .K DA,DIK
  1. Q
  1. ;-----
  1. WARN ;CHECK FOR TEST DATABASE
  1. W @IOF
  1. W !?10,"Warning - Warning - Warning"
  1. W !!?10,"The BYIM automated NIST Process - PREP, SEND and RESTORE"
  1. W !?10,"can only be run on a test database, never on a production database"
  1. K DIR
  1. S DIR(0)="YO"
  1. S DIR("A")="Do you certify that this is a TEST database"
  1. S DIR("B")="NO"
  1. W !
  1. D ^DIR
  1. K DIR
  1. I Y'=1 D Q
  1. .S BYIMQUIT=1
  1. .W !!,"Please run the BYIM automated NIST Process on a test database"
  1. .H 4
  1. Q
  1. ;-----
  1. MPAT ;EP;SETUP MASTER DB PATIENTS
  1. D MU21^BYIMMU21
  1. S PID=""
  1. F S PID=$O(^BYIMTMP("PAT",PID)) Q:PID="" S IEN=^(PID),JJ=$E(PID,2),TT=$E(PID,2,3) D P1(PID)
  1. Q
  1. MSEND D SEND
  1. Q
  1. ;-----