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. 
  1. BYIMMU21 ;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. MU21 ;EP;SETUP MU2 PATIENTS AND DATA
  1.  W !!,"Please stand by while I setup the HL7 message for:"
  1.  K ^BYIMTMP("MU2")
  1.  D SET
  1.  D PRV
  1.  D LOT
  1.  D IMM
  1.  Q
  1.  ;-----
  1. PRV ;CREATE PROVIDER NAMES
  1.  K ^BYIMTMP("MU2","PRV")
  1.  S JJ=0
  1.  F IEN=10:10 D  Q:JJ=3
  1.  .Q:'$D(^VA(200,IEN,0))
  1.  .S JJ=JJ+1
  1.  .S PRV=$S(JJ=1:"PRV1",JJ=2:"PRV2",1:"PRV3")
  1.  .S YY=^BYIMTMP("MU2","DATA",PRV)
  1.  .K DA,DR,DIE
  1.  .S DR=$P(YY,";",3)
  1.  .S DR=$TR(DR,"|",";")
  1.  .S POS=$P(YY,";",4)
  1.  .S NAM=$P($P(DR,".01////",2),";")
  1.  .S DA=$O(^VA(200,"B",NAM,0))
  1.  .S:'DA DA=IEN
  1.  .S DIE="^VA(200,"
  1.  .D ^DIE
  1.  .S ^BYIMTMP("MU2","PRV",POS)=DA
  1.  .M ^BYIMTMP("RESTORE","PRV",DA)=^VA(200,DA)
  1.  .K DA,DR,DIE
  1.  Q
  1.  ;-----
  1. LOT ;CREATE LOT NUMBERS 
  1.  K ^BYIMTMP("MU2","LOT")
  1.  N JJ,DA,XX,YY,DIE,DR
  1.  F LX="L111","L112","L113","L211","L212","L213","L711","L7113","L712","L7123","L713","L7133" S YY=^BYIMTMP("MU2","DATA",LX) D
  1.  .K DA,DR,DIE
  1.  .S DR=$P(YY,";",3)
  1.  .S DR=$TR(DR,"|",";")
  1.  .S LOT=$P($P(DR,".01////",2),";")
  1.  .S POS=$P(YY,";",4)
  1.  .S DA=$O(^AUTTIML("B",LOT,0))
  1.  .D:'DA
  1.  ..S X=LOT
  1.  ..S DIC="^AUTTIML("
  1.  ..S DIC(0)="L"
  1.  ..D FILE^DICN
  1.  ..S DA=+Y
  1.  .S DIE="^AUTTIML("
  1.  .D ^DIE
  1.  .S ^BYIMTMP("MU2","LOT",POS)=DA
  1.  .M ^BYIMTMP("RESTORE","LOT",DA)=^AUTTIML(DA)
  1.  .K DA,DR,DIE
  1.  K ^BYIMTMP("MU2","LOT DATA")
  1.  Q
  1.  ;-----
  1. IMM ;SET VIS PUB DATES
  1.  N JJ,DA,XX,YY,DIE,DR
  1.  F J=1:1:11 S X="IMM"_J,YY=^BYIMTMP("MU2","DATA",X) D
  1.  .K DA,DR,DIE
  1.  .S CVX=$P(YY,";",3)
  1.  .S DA=$P(YY,";",4)
  1.  .S DR=$P(YY,";",5)
  1.  .S DR=$TR(DR,"|",";")
  1.  .S DIE="^AUTTIMM("
  1.  .D ^DIE
  1.  .M ^BYIMTMP("RESTORE","IMM",DA)=^AUTTIMM(DA)
  1.  .K DA,DR,DIE
  1.  Q
  1.  ;-----
  1. SET ;SET DATA ARRAYS
  1.  K ^BYIMTMP("MU2","V7")
  1.  K ^BYIMTMP("MU2","DATA")
  1.  F X="IMM1","IMM2","IMM3","IMM4","IMM5","IMM6","IMM7","IMM8","IMM9","IMM10","IMM11" S Y=$T(@X),^BYIMTMP("MU2","DATA",X)=Y
  1.  F J=1:1:11 S X="IMM"_J,Y=$T(@X),^BYIMTMP("MU2","DATA",X)=Y
  1.  F X="L111","L112","L113","L211","L212","L213","L711","L7113","L712","L7123","L713","L7133" S Y=$T(@X),^BYIMTMP("MU2","DATA",X)=Y
  1.  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
  1.  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
  1.  F X="V711","V7112","V7113","V712","V7122","V7123","V713","V7132","V7133" S Y=$T(@X),^BYIMTMP("MU2","DATA",X)=Y
  1.  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
  1.  F X="I711","I7112","I7113","I712","I7122","I7123","I713","I7132","I7133" S Y=$T(@X),^BYIMTMP("MU2","DATA",X)=Y
  1.  F X="BIP411","BIP412","BIP413" S Y=$T(@X),^BYIMTMP("MU2","DATA",X)=Y
  1.  F X="REF511","REF512","REF513" S Y=$T(@X),^BYIMTMP("MU2","DATA",X)=Y
  1.  F X="BIPC611","BIPC612","BIPC613" S Y=$T(@X),^BYIMTMP("MU2","DATA",X)=Y
  1.  F X="PRV1","PRV2","PRV3" S Y=$T(@X),^BYIMTMP("MU2","DATA",X)=Y
  1.  Q
  1.  ;-----
  1. V111 ;;.01////3120814.12|.07////A
  1. I111 ;;.01////242|.05////T111|.09////LDI|.11////.5|.12////3120814|.14////5|1202////P1202|1204////P1204|1214////P1214"
  1.  ;
  1.  ;-----
  1. V112 ;;.01////3120815.12|.07////A
  1. I112 ;;.01////242|.05////T112|.09////RDI|.11////.25|.12////3120814|.14////3|1202////P1202|1204////P1204|1214////P1214"
  1.  ;
  1.  ;-----
  1. V113 ;;.01////3120816.12|.07////A
  1. I113 ;;.01////242|.05////T113|.09////LDI|.11////.25|.12////3120816|.14////1|1202////P1202|1204////P1204|1214////P1214"
  1.  ;
  1.  ;-----
  1. V211 ;;.01////3120814.12|.07////A
  1. I211 ;;.01////168|.05////T211|.09////RDI|.11////1|.12////3120814|.14////1|1202////P1202|1204////P1204|1214////P1214"
  1.  ;
  1.  ;-----
  1. V212 ;;.01////3120814.12|.07////A
  1. I212 ;;.01////168|.05////T212|.09////RDI|.11////1|.12////3120814|.14////1|1202////P1202|1204////P1204|1214////P1214"
  1.  ;
  1.  ;-----
  1. V213 ;;.01////3120816.12|.07////A
  1. I213 ;;.01////221|.05////T213|.09////RDI|.11////.5|.12////3120816|.14////1|1202////P1202|1204////P1204|1214////P1214"
  1.  ;
  1.  ;-----
  1. V311 ;;.01////3110215.12|.07////E
  1. I311 ;;.01////224
  1.  ;
  1.  ;-----
  1. V312 ;;.01////3110214.12|.07////E
  1. I312 ;;.01////221
  1.  ;
  1.  ;-----
  1. V313 ;;.01////3110215.12|.07////E
  1. I313 ;;.01////196
  1.  ;
  1.  ;-----
  1. V411 ;;.01////3110214.12|.07////E
  1. I411 ;;.01////221
  1. BIP411 ;;.21////3120701|.24////N
  1.  ;
  1.  ;-----
  1. V412 ;;.01////3110214.12|.07////E
  1. I412 ;;.01////221
  1. BIP412 ;;.21////3120701|.24////N
  1.  ;
  1.  ;-----
  1. V413 ;;.01////3110214.12|.07////E
  1. I413 ;;.01////224
  1. BIP413 ;;.21////3120701|.24////N
  1.  ;
  1.  ;-----
  1. V511 ;;
  1. I511 ;;.01////117
  1. REF511 ;;.01////3|.02////DFN|.03////3120815|.04////MMR|.05////9999999.14|.06////117
  1.  ;
  1.  ;-----
  1. V512 ;;
  1. I512 ;;.01////117
  1. REF512 ;;.01////3|.02////DFN|.03////3120815|.04////MMR|.05////9999999.14|.06////117
  1.  ;
  1.  ;-----
  1. V513 ;;
  1. I513 ;;.01////117
  1. REF513 ;;.01////3|.02////DFN|.03////3120815|.04////MMR|.05////9999999.14|.06////117
  1.  ;
  1.  ;-----
  1. V611 ;;
  1. I611 ;;
  1. BIPC611 ;;.01////DFN|.02////132|.03////12|.04////3110215
  1.  ;
  1.  ;-----
  1. V612 ;;
  1. I612 ;;
  1. BIPC612 ;;.01////DFN|.02////132|.03////12|.04////3110216
  1.  ;
  1.  ;-----
  1. V613 ;;
  1. I613 ;;
  1. BIPC613 ;;.01////DFN|.02////132|.03////12|.04////3110215
  1.  ;
  1.  ;-----
  1. V711 ;;.01////3120816.12|.07////A
  1. I711 ;;.01////243|.05////T711|.09////RDI|.11////.25|.12////3120814|.14////5|1202////P1202|1204////P1204|1214////P1214"
  1. V7112 ;;.01////3110216.12|.07////E
  1. I7112 ;;.01////107;
  1. V7113 ;;.01////3120816.12|.07////A
  1. I7113 ;;.01////226|.05////T7113|.09////RDI|.11////.5|.12////3120816|.14////5|1202////P1202|1204////P1204|1214////P1214"
  1.  ;
  1.  ;-----
  1. V712 ;;.01////3120814.12|.07////A
  1. I712 ;;.01////242|.05////T712|.09////RDI|.11////.25|.12////3120814|.14////3|1202////P1202|1204////P1204|1214////P1214"
  1. V7122 ;;.01////3110214.12|.07////E
  1. I7122 ;;.01////133;
  1. V7123 ;;.01////3120814.12|.07////A
  1. I7123 ;;.01////226|.05////T7123|.09////RDI|.11////.5|.12////3120814|.14////3|1202////P1202|1204////P1204|1214////P1214"
  1.  ;
  1.  ;-----
  1. V713 ;;.01////3120814.12|.07////A
  1. I713 ;;.01////242|.05////T713|.09////RDI|.11////.5|.12////3120814|.14////3|1202////P1202|1204////P1204|1214////P1214"
  1. V7132 ;;.01////3110214.12|.07////E
  1. I7132 ;;.01////235;
  1. V7133 ;;.01////3120814.12|.07////A
  1. I7133 ;;.01////216|.05////T7133|.09////LDI|.11////.5|.12////3120814|.14////3|1202////P1202|1204////P1204|1214////P1214"
  1.  ;
  1.  ;-----
  1.  ;PROVIDERS
  1. PRV1 ;;.01////BURDEN,DONNA A|41.99////I-23432;1214
  1. PRV2 ;;.01////RADON,NICHOLAS|41.99////57422;1202
  1. PRV3 ;;.01////LEMON,MIKE A|41.99////7832-1;1204
  1.  ;
  1.  ;-----
  1.  ;LOT NUMBERS
  1. L111 ;;.01////Z0860BB|.02///CSL|.03////A|.04////242|.09////3121104;T111
  1. L112 ;;.01////Y9789ZR|.02///PMC|.03////A|.04////243|.09////3121215;T112
  1. L113 ;;.01////J6702KP|.02///PMC|.03////A|.04////242|.09////3121216;T113
  1. L211 ;;.01////I90FV|.02///MSD|.03////A|.04////168|.09////3121214;T211
  1. L212 ;;.01////I90FV|.02///MSD|.03////A|.04////168|.09////3121214;T212
  1. L213 ;;.01////Z79YG|.02///SKB|.03////A|.04////221|.09////3121216;T213
  1. L711 ;;.01////K5094SC|.02///PMC|.03////A|.04////243|.09////3121216;T711
  1. L7113 ;;.01////568AHK11|.02///PMC|.03////A|.04////226|.09////3121216;T7113
  1. L712 ;;.01////D6992FF|.02///PMC|.03////A|.04////242|.09////3121214;T712
  1. L7123 ;;.01////568AHK11|.02///PMC|.03////A|.04////226|.09////3121216;T7123
  1. L713 ;;.01////W1356FE|.02///SKB|.03////A|.04////242|.09////3121214;T713
  1. L7133 ;;.01////78HH34I|.02///SKB|.03////A|.04////216|.09////3121214;T7133
  1.  ;
  1.  ;-----
  1.  ;IMMUNIZATIONS
  1. IMM1 ;;10;107;.13////3110811
  1. IMM2 ;;17;124;.13////2981216
  1. IMM3 ;;44;165;.13////3120202
  1. IMM4 ;;52;168;.13////3111025
  1. IMM5 ;;89;139;.13////3111108
  1. IMM6 ;;107;212;.13////3070517
  1. IMM7 ;;115;221;.13////3120124
  1. IMM8 ;;140;242;.13////3120702
  1. IMM9 ;;141;243;.13////3120702
  1. IMM10 ;;85;131;.13////3111025
  1. IMM11 ;;120;226;.13////3120202
  1.  ;
  1.  ;-----
  1. 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
  1.  ;-----
  1. P1112 ;;.211////LAM,MORGAN|.212////MOTHER|.213////32 PRESCOTT STREET AVE|.216////WARWICK|.217////22|.218////02452|.219////657-5558563
  1.  ;-----
  1. P112 ;;.01////MARSH,TIERNEY BEACHER|.02////M|.03////3100814|.06////5|.111////10 HUNTINGTON RD|.114////BROCKTON|.115////22|.116////16080|.131////379-5559369
  1.  ;-----
  1. P1122 ;;.211////LUCAS,MORGAN|.212////MOTHER|.213////32 PRESCOTT STREET AVE|.216////WARWICK|.217////22|.218////02452|.219////657-5558563
  1.  ;-----
  1. P113 ;;.01////DESCHUTES,BROOKLYN DOLLY|.02////F|.03////3100826|.06////12|.111////902 PACIFIC ST|.114////ORLEANS|.115////22|.116////20540|.131////790-5553151
  1.  ;-----
  1. P1132 ;;.211////DEWEY,DONA|.212////MOTHER|.213////32 PRESCOTT STREET AVE|.216////WARWICK|.217////22|.218////02452|.219////657-5558563
  1.  ;-----
  1. P211 ;;.01////VALLY,NITIKA|.02////F|.03////2410813|.212////MOTHER;;1802////nvally@fastmail.com
  1.  ;
  1. P212 ;;.01////CIMARRON,OTTOLINE|.02////F|.03////2410717|.212////MOTHER;;1802////ottoline@hotmail.com
  1.  ;
  1. P213 ;;.01////QUINLA,EISIG|.02////M|.03////2410714|.212////MOTHER;;1802////Eisig@hotmail.com
  1.  ;
  1. P311 ;;.01////MONTGOMERY,LEWIS|.02////M|.03////3010821|.212////MOTHER
  1.  ;
  1. P312 ;;.01////DENTON,BLAKELEY|.02////M|.03////3010824|.212////MOTHER
  1.  ;
  1. P313 ;;.01////LUBBOCK,WYUNA|.02////F|.03////3010831|.212////MOTHER
  1.  ;
  1. P411 ;;.01////NEWTON,LEA|.02////F|.03////3010905|.212////MOTHER
  1.  ;
  1. P412 ;;.01////LARSEN,HILZARIE|.02////F|.03////3010823|.212////MOTHER
  1.  ;
  1. P413 ;;.01////PIERCE,RIANNA|.02////F|.03////3010813|.212////MOTHER
  1.  ;
  1. P511 ;;.01////FLEMING,CHAD|.02////M|.03////3100830|.212////MOTHER
  1.  ;
  1. P512 ;;.01////SANTA BARBARA,NARETHA|.02////F|.03////3100831|.212////MOTHER
  1.  ;
  1. P513 ;;.01////JONES,BRAZ|.02////M|.03////3100907|.212////MOTHER
  1.  ;
  1. P611 ;;.01////WOLFE,ARON|.02////M|.03////3010907|.212////MOTHER
  1.  ;
  1. P612 ;;.01////RIVERSIDE,JEZEBEL|.02////F|.03////3110901|.212////MOTHER
  1.  ;
  1. P613 ;;.01////BUCHSHORN,NKITA|.02////F|.03////3010829|.212////MOTHER
  1.  ;
  1. P711 ;;.01////MERCER,JIRRA EMMANUELLE|.02////F|.03////3100907|.212////MOTHER
  1.  ;
  1. P712 ;;.01////UMATILLA,SALIMA KAILYN|.02////F|.03////3100824|.212////MOTHER
  1.  ;
  1. P713 ;;.01////CURRY,QIANG TRYSTAN|.02////M|.03////3110819|.212////MOTHER
  1.  ;-----
  1.  Q
  1.  ;-----