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

BYIMMU21.m

Go to the documentation of this file. 
BYIMMU21 ;IHS/CIM/THL - IMMUNIZATION DATA EXCHANGE;

 ;;2.0;BYIM IMMUNIZATION DATA EXCHANGE;**3,4,5,6,7,8**;JUL 11, 2017;Build 310

 ;

 ;----

 Q

MU21 ;EP;SETUP MU2 PATIENTS AND DATA

 W !!,"Please stand by while I setup the HL7 message for:"

 K ^BYIMTMP("MU2")

 D SET

 D PRV

 D LOT

 D IMM

 Q

 ;-----

PRV ;CREATE PROVIDER NAMES

 K ^BYIMTMP("MU2","PRV")

 S JJ=0

 F IEN=10:10 D  Q:JJ=3

 .Q:'$D(^VA(200,IEN,0))

 .S JJ=JJ+1

 .S PRV=$S(JJ=1:"PRV1",JJ=2:"PRV2",1:"PRV3")

 .S YY=^BYIMTMP("MU2","DATA",PRV)

 .K DA,DR,DIE

 .S DR=$P(YY,";",3)

 .S DR=$TR(DR,"|",";")

 .S POS=$P(YY,";",4)

 .S NAM=$P($P(DR,".01////",2),";")

 .S DA=$O(^VA(200,"B",NAM,0))

 .S:'DA DA=IEN

 .S DIE="^VA(200,"

 .D ^DIE

 .S ^BYIMTMP("MU2","PRV",POS)=DA

 .M ^BYIMTMP("RESTORE","PRV",DA)=^VA(200,DA)

 .K DA,DR,DIE

 Q

 ;-----

LOT ;CREATE LOT NUMBERS 

 K ^BYIMTMP("MU2","LOT")

 N JJ,DA,XX,YY,DIE,DR

 F LX="L111","L112","L113","L211","L212","L213","L711","L7113","L712","L7123","L713","L7133" S YY=^BYIMTMP("MU2","DATA",LX) D

 .K DA,DR,DIE

 .S DR=$P(YY,";",3)

 .S DR=$TR(DR,"|",";")

 .S LOT=$P($P(DR,".01////",2),";")

 .S POS=$P(YY,";",4)

 .S DA=$O(^AUTTIML("B",LOT,0))

 .D:'DA

 ..S X=LOT

 ..S DIC="^AUTTIML("

 ..S DIC(0)="L"

 ..D FILE^DICN

 ..S DA=+Y

 .S DIE="^AUTTIML("

 .D ^DIE

 .S ^BYIMTMP("MU2","LOT",POS)=DA

 .M ^BYIMTMP("RESTORE","LOT",DA)=^AUTTIML(DA)

 .K DA,DR,DIE

 K ^BYIMTMP("MU2","LOT DATA")

 Q

 ;-----

IMM ;SET VIS PUB DATES

 N JJ,DA,XX,YY,DIE,DR

 F J=1:1:11 S X="IMM"_J,YY=^BYIMTMP("MU2","DATA",X) D

 .K DA,DR,DIE

 .S CVX=$P(YY,";",3)

 .S DA=$P(YY,";",4)

 .S DR=$P(YY,";",5)

 .S DR=$TR(DR,"|",";")

 .S DIE="^AUTTIMM("

 .D ^DIE

 .M ^BYIMTMP("RESTORE","IMM",DA)=^AUTTIMM(DA)

 .K DA,DR,DIE

 Q

 ;-----

SET ;SET DATA ARRAYS

 K ^BYIMTMP("MU2","V7")

 K ^BYIMTMP("MU2","DATA")

 F X="IMM1","IMM2","IMM3","IMM4","IMM5","IMM6","IMM7","IMM8","IMM9","IMM10","IMM11" S Y=$T(@X),^BYIMTMP("MU2","DATA",X)=Y

 F J=1:1:11 S X="IMM"_J,Y=$T(@X),^BYIMTMP("MU2","DATA",X)=Y

 F X="L111","L112","L113","L211","L212","L213","L711","L7113","L712","L7123","L713","L7133" S Y=$T(@X),^BYIMTMP("MU2","DATA",X)=Y

 F X="P111","P1112","P112","P1122","P113","P1132","P211","P211P","P212","P212P","P213","P213P","P311","P312","P313","P411","P412","P413","P511","P512","P513","P611","P612","P613","P711","P712","P713" S Y=$T(@X),^BYIMTMP("MU2","DATA",X)=Y

 F X="V111","V1112","V112","V1122","V113","V1132","V211","V212","V213","V311","V312","V313","V411","V412","V413","V511","V512","V513","V611","V612","V613" S Y=$T(@X),^BYIMTMP("MU2","DATA",X)=Y

 F X="V711","V7112","V7113","V712","V7122","V7123","V713","V7132","V7133" S Y=$T(@X),^BYIMTMP("MU2","DATA",X)=Y

 F X="I111","I1112","I112","I1122","I113","I1132","I211","I212","I213","I311","I312","I313","I411","I412","I413","I511","I512","I513","I611","I612","I613" S Y=$T(@X),^BYIMTMP("MU2","DATA",X)=Y

 F X="I711","I7112","I7113","I712","I7122","I7123","I713","I7132","I7133" S Y=$T(@X),^BYIMTMP("MU2","DATA",X)=Y

 F X="BIP411","BIP412","BIP413" S Y=$T(@X),^BYIMTMP("MU2","DATA",X)=Y

 F X="REF511","REF512","REF513" S Y=$T(@X),^BYIMTMP("MU2","DATA",X)=Y

 F X="BIPC611","BIPC612","BIPC613" S Y=$T(@X),^BYIMTMP("MU2","DATA",X)=Y

 F X="PRV1","PRV2","PRV3" S Y=$T(@X),^BYIMTMP("MU2","DATA",X)=Y

 Q

 ;-----

V111 ;;.01////3120814.12|.07////A

I111 ;;.01////242|.05////T111|.09////LDI|.11////.5|.12////3120814|.14////5|1202////P1202|1204////P1204|1214////P1214"

 ;

 ;-----

V112 ;;.01////3120815.12|.07////A

I112 ;;.01////242|.05////T112|.09////RDI|.11////.25|.12////3120814|.14////3|1202////P1202|1204////P1204|1214////P1214"

 ;

 ;-----

V113 ;;.01////3120816.12|.07////A

I113 ;;.01////242|.05////T113|.09////LDI|.11////.25|.12////3120816|.14////1|1202////P1202|1204////P1204|1214////P1214"

 ;

 ;-----

V211 ;;.01////3120814.12|.07////A

I211 ;;.01////168|.05////T211|.09////RDI|.11////1|.12////3120814|.14////1|1202////P1202|1204////P1204|1214////P1214"

 ;

 ;-----

V212 ;;.01////3120814.12|.07////A

I212 ;;.01////168|.05////T212|.09////RDI|.11////1|.12////3120814|.14////1|1202////P1202|1204////P1204|1214////P1214"

 ;

 ;-----

V213 ;;.01////3120816.12|.07////A

I213 ;;.01////221|.05////T213|.09////RDI|.11////.5|.12////3120816|.14////1|1202////P1202|1204////P1204|1214////P1214"

 ;

 ;-----

V311 ;;.01////3110215.12|.07////E

I311 ;;.01////224

 ;

 ;-----

V312 ;;.01////3110214.12|.07////E

I312 ;;.01////221

 ;

 ;-----

V313 ;;.01////3110215.12|.07////E

I313 ;;.01////196

 ;

 ;-----

V411 ;;.01////3110214.12|.07////E

I411 ;;.01////221

BIP411 ;;.21////3120701|.24////N

 ;

 ;-----

V412 ;;.01////3110214.12|.07////E

I412 ;;.01////221

BIP412 ;;.21////3120701|.24////N

 ;

 ;-----

V413 ;;.01////3110214.12|.07////E

I413 ;;.01////224

BIP413 ;;.21////3120701|.24////N

 ;

 ;-----

V511 ;;

I511 ;;.01////117

REF511 ;;.01////3|.02////DFN|.03////3120815|.04////MMR|.05////9999999.14|.06////117

 ;

 ;-----

V512 ;;

I512 ;;.01////117

REF512 ;;.01////3|.02////DFN|.03////3120815|.04////MMR|.05////9999999.14|.06////117

 ;

 ;-----

V513 ;;

I513 ;;.01////117

REF513 ;;.01////3|.02////DFN|.03////3120815|.04////MMR|.05////9999999.14|.06////117

 ;

 ;-----

V611 ;;

I611 ;;

BIPC611 ;;.01////DFN|.02////132|.03////12|.04////3110215

 ;

 ;-----

V612 ;;

I612 ;;

BIPC612 ;;.01////DFN|.02////132|.03////12|.04////3110216

 ;

 ;-----

V613 ;;

I613 ;;

BIPC613 ;;.01////DFN|.02////132|.03////12|.04////3110215

 ;

 ;-----

V711 ;;.01////3120816.12|.07////A

I711 ;;.01////243|.05////T711|.09////RDI|.11////.25|.12////3120814|.14////5|1202////P1202|1204////P1204|1214////P1214"

V7112 ;;.01////3110216.12|.07////E

I7112 ;;.01////107;

V7113 ;;.01////3120816.12|.07////A

I7113 ;;.01////226|.05////T7113|.09////RDI|.11////.5|.12////3120816|.14////5|1202////P1202|1204////P1204|1214////P1214"

 ;

 ;-----

V712 ;;.01////3120814.12|.07////A

I712 ;;.01////242|.05////T712|.09////RDI|.11////.25|.12////3120814|.14////3|1202////P1202|1204////P1204|1214////P1214"

V7122 ;;.01////3110214.12|.07////E

I7122 ;;.01////133;

V7123 ;;.01////3120814.12|.07////A

I7123 ;;.01////226|.05////T7123|.09////RDI|.11////.5|.12////3120814|.14////3|1202////P1202|1204////P1204|1214////P1214"

 ;

 ;-----

V713 ;;.01////3120814.12|.07////A

I713 ;;.01////242|.05////T713|.09////RDI|.11////.5|.12////3120814|.14////3|1202////P1202|1204////P1204|1214////P1214"

V7132 ;;.01////3110214.12|.07////E

I7132 ;;.01////235;

V7133 ;;.01////3120814.12|.07////A

I7133 ;;.01////216|.05////T7133|.09////LDI|.11////.5|.12////3120814|.14////3|1202////P1202|1204////P1204|1214////P1214"

 ;

 ;-----

 ;PROVIDERS

PRV1 ;;.01////BURDEN,DONNA A|41.99////I-23432;1214

PRV2 ;;.01////RADON,NICHOLAS|41.99////57422;1202

PRV3 ;;.01////LEMON,MIKE A|41.99////7832-1;1204

 ;

 ;-----

 ;LOT NUMBERS

L111 ;;.01////Z0860BB|.02///CSL|.03////A|.04////242|.09////3121104;T111

L112 ;;.01////Y9789ZR|.02///PMC|.03////A|.04////243|.09////3121215;T112

L113 ;;.01////J6702KP|.02///PMC|.03////A|.04////242|.09////3121216;T113

L211 ;;.01////I90FV|.02///MSD|.03////A|.04////168|.09////3121214;T211

L212 ;;.01////I90FV|.02///MSD|.03////A|.04////168|.09////3121214;T212

L213 ;;.01////Z79YG|.02///SKB|.03////A|.04////221|.09////3121216;T213

L711 ;;.01////K5094SC|.02///PMC|.03////A|.04////243|.09////3121216;T711

L7113 ;;.01////568AHK11|.02///PMC|.03////A|.04////226|.09////3121216;T7113

L712 ;;.01////D6992FF|.02///PMC|.03////A|.04////242|.09////3121214;T712

L7123 ;;.01////568AHK11|.02///PMC|.03////A|.04////226|.09////3121216;T7123

L713 ;;.01////W1356FE|.02///SKB|.03////A|.04////242|.09////3121214;T713

L7133 ;;.01////78HH34I|.02///SKB|.03////A|.04////216|.09////3121214;T7133

 ;

 ;-----

 ;IMMUNIZATIONS

IMM1 ;;10;107;.13////3110811

IMM2 ;;17;124;.13////2981216

IMM3 ;;44;165;.13////3120202

IMM4 ;;52;168;.13////3111025

IMM5 ;;89;139;.13////3111108

IMM6 ;;107;212;.13////3070517

IMM7 ;;115;221;.13////3120124

IMM8 ;;140;242;.13////3120702

IMM9 ;;141;243;.13////3120702

IMM10 ;;85;131;.13////3111025

IMM11 ;;120;226;.13////3120202

 ;

 ;-----

P111 ;;.01////SNOW,MADELYNN AINSLEY|.02////F|.03////3010706|.06////12|.111////32 PRESCOTT STREET AVE|.114////WARWICK|.115////22|.116////02452|.131////657-5558563

 ;-----

P1112 ;;.211////LAM,MORGAN|.212////MOTHER|.213////32 PRESCOTT STREET AVE|.216////WARWICK|.217////22|.218////02452|.219////657-5558563

 ;-----

P112 ;;.01////MARSH,TIERNEY BEACHER|.02////M|.03////3100814|.06////5|.111////10 HUNTINGTON RD|.114////BROCKTON|.115////22|.116////16080|.131////379-5559369

 ;-----

P1122 ;;.211////LUCAS,MORGAN|.212////MOTHER|.213////32 PRESCOTT STREET AVE|.216////WARWICK|.217////22|.218////02452|.219////657-5558563

 ;-----

P113 ;;.01////DESCHUTES,BROOKLYN DOLLY|.02////F|.03////3100826|.06////12|.111////902 PACIFIC ST|.114////ORLEANS|.115////22|.116////20540|.131////790-5553151

 ;-----

P1132 ;;.211////DEWEY,DONA|.212////MOTHER|.213////32 PRESCOTT STREET AVE|.216////WARWICK|.217////22|.218////02452|.219////657-5558563

 ;-----

P211 ;;.01////VALLY,NITIKA|.02////F|.03////2410813|.212////MOTHER;;1802////nvally@fastmail.com

 ;

P212 ;;.01////CIMARRON,OTTOLINE|.02////F|.03////2410717|.212////MOTHER;;1802////ottoline@hotmail.com

 ;

P213 ;;.01////QUINLA,EISIG|.02////M|.03////2410714|.212////MOTHER;;1802////Eisig@hotmail.com

 ;

P311 ;;.01////MONTGOMERY,LEWIS|.02////M|.03////3010821|.212////MOTHER

 ;

P312 ;;.01////DENTON,BLAKELEY|.02////M|.03////3010824|.212////MOTHER

 ;

P313 ;;.01////LUBBOCK,WYUNA|.02////F|.03////3010831|.212////MOTHER

 ;

P411 ;;.01////NEWTON,LEA|.02////F|.03////3010905|.212////MOTHER

 ;

P412 ;;.01////LARSEN,HILZARIE|.02////F|.03////3010823|.212////MOTHER

 ;

P413 ;;.01////PIERCE,RIANNA|.02////F|.03////3010813|.212////MOTHER

 ;

P511 ;;.01////FLEMING,CHAD|.02////M|.03////3100830|.212////MOTHER

 ;

P512 ;;.01////SANTA BARBARA,NARETHA|.02////F|.03////3100831|.212////MOTHER

 ;

P513 ;;.01////JONES,BRAZ|.02////M|.03////3100907|.212////MOTHER

 ;

P611 ;;.01////WOLFE,ARON|.02////M|.03////3010907|.212////MOTHER

 ;

P612 ;;.01////RIVERSIDE,JEZEBEL|.02////F|.03////3110901|.212////MOTHER

 ;

P613 ;;.01////BUCHSHORN,NKITA|.02////F|.03////3010829|.212////MOTHER

 ;

P711 ;;.01////MERCER,JIRRA EMMANUELLE|.02////F|.03////3100907|.212////MOTHER

 ;

P712 ;;.01////UMATILLA,SALIMA KAILYN|.02////F|.03////3100824|.212////MOTHER

 ;

P713 ;;.01////CURRY,QIANG TRYSTAN|.02////M|.03////3110819|.212////MOTHER

 ;-----

 Q

 ;-----