KIDS Distribution saved on Sep 02, 2025@11:38:51 BI Immunization Tracking Version 8.5 Patch 31 **KIDS**:BI*8.5*31^ **INSTALL NAME** BI*8.5*31 "BLD",7272,0) BI*8.5*31^IMMUNIZATION^0^3250902^y "BLD",7272,4,0) ^9.64PA^^0 "BLD",7272,6.3) 137 "BLD",7272,"ABPKG") n "BLD",7272,"INI") "BLD",7272,"INID") n^n^n "BLD",7272,"INIT") V85P31^BIPOST "BLD",7272,"KRN",0) ^9.67PA^^ "BLD",7272,"KRN",.4,0) .4 "BLD",7272,"KRN",.4,"NM",0) ^9.68A^^ "BLD",7272,"KRN",.401,0) .401 "BLD",7272,"KRN",.402,0) .402 "BLD",7272,"KRN",.403,0) .403 "BLD",7272,"KRN",.5,0) .5 "BLD",7272,"KRN",.84,0) .84 "BLD",7272,"KRN",3.6,0) 3.6 "BLD",7272,"KRN",3.8,0) 3.8 "BLD",7272,"KRN",9.2,0) 9.2 "BLD",7272,"KRN",9.8,0) 9.8 "BLD",7272,"KRN",9.8,"NM",0) ^9.68A^38^38 "BLD",7272,"KRN",9.8,"NM",1,0) BIOUTPT5^^0^B132518262 "BLD",7272,"KRN",9.8,"NM",2,0) BIREPD1^^0^B27182525 "BLD",7272,"KRN",9.8,"NM",3,0) BIREPD2^^0^B114912591 "BLD",7272,"KRN",9.8,"NM",4,0) BIREPD3^^0^B85439571 "BLD",7272,"KRN",9.8,"NM",5,0) BIREPL1^^0^B54336137 "BLD",7272,"KRN",9.8,"NM",6,0) BIREPL2^^0^B183750515 "BLD",7272,"KRN",9.8,"NM",7,0) BIREPF1^^0^B26160157 "BLD",7272,"KRN",9.8,"NM",8,0) BIREPF2^^0^B40474505 "BLD",7272,"KRN",9.8,"NM",9,0) BIREPF3^^0^B40713205 "BLD",7272,"KRN",9.8,"NM",10,0) BIREPQ1^^0^B25087044 "BLD",7272,"KRN",9.8,"NM",11,0) BIREPQ2^^0^B25449213 "BLD",7272,"KRN",9.8,"NM",12,0) BIREPQ3^^0^B39950450 "BLD",7272,"KRN",9.8,"NM",13,0) BIREPT1^^0^B23734284 "BLD",7272,"KRN",9.8,"NM",14,0) BIREPT2^^0^B48769780 "BLD",7272,"KRN",9.8,"NM",15,0) BIREPT3^^0^B44572047 "BLD",7272,"KRN",9.8,"NM",16,0) BIREPL5^^0^B225461531 "BLD",7272,"KRN",9.8,"NM",17,0) BIUTL3^^0^B106069830 "BLD",7272,"KRN",9.8,"NM",18,0) BIUTL2^^0^B68598191 "BLD",7272,"KRN",9.8,"NM",19,0) BIDX^^0^B112115456 "BLD",7272,"KRN",9.8,"NM",20,0) BIPATUP1^^0^B37108741 "BLD",7272,"KRN",9.8,"NM",21,0) BIPATUP4^^0^B107877633 "BLD",7272,"KRN",9.8,"NM",22,0) BIREPCSV^^0^B23090963 "BLD",7272,"KRN",9.8,"NM",23,0) BIREPL^^0^B17722802 "BLD",7272,"KRN",9.8,"NM",24,0) BIREPL4^^0^B108865352 "BLD",7272,"KRN",9.8,"NM",25,0) BIRPC^^0^B49695963 "BLD",7272,"KRN",9.8,"NM",26,0) BISITE1^^0^B46451942 "BLD",7272,"KRN",9.8,"NM",27,0) BISITE4^^0^B206800435 "BLD",7272,"KRN",9.8,"NM",28,0) BIPOST^^0^B40999662 "BLD",7272,"KRN",9.8,"NM",29,0) BIPATVW3^^0^B115766424 "BLD",7272,"KRN",9.8,"NM",30,0) BIAPCHS^^0^B49869768 "BLD",7272,"KRN",9.8,"NM",31,0) BIDUVLS2^^0^B41108859 "BLD",7272,"KRN",9.8,"NM",32,0) BILETPR1^^0^B118200211 "BLD",7272,"KRN",9.8,"NM",33,0) BIPATVW1^^0^B85770192 "BLD",7272,"KRN",9.8,"NM",34,0) BIDX1^^0^B99867806 "BLD",7272,"KRN",9.8,"NM",35,0) BIDX2^^0^B28650412 "BLD",7272,"KRN",9.8,"NM",36,0) BIPATUP2^^0^B117079189 "BLD",7272,"KRN",9.8,"NM",37,0) BIPATUP3^^0^B46816605 "BLD",7272,"KRN",9.8,"NM",38,0) BIVWXICE^^0^B77066783 "BLD",7272,"KRN",9.8,"NM","B","BIAPCHS",30) "BLD",7272,"KRN",9.8,"NM","B","BIDUVLS2",31) "BLD",7272,"KRN",9.8,"NM","B","BIDX",19) "BLD",7272,"KRN",9.8,"NM","B","BIDX1",34) "BLD",7272,"KRN",9.8,"NM","B","BIDX2",35) "BLD",7272,"KRN",9.8,"NM","B","BILETPR1",32) "BLD",7272,"KRN",9.8,"NM","B","BIOUTPT5",1) "BLD",7272,"KRN",9.8,"NM","B","BIPATUP1",20) "BLD",7272,"KRN",9.8,"NM","B","BIPATUP2",36) "BLD",7272,"KRN",9.8,"NM","B","BIPATUP3",37) "BLD",7272,"KRN",9.8,"NM","B","BIPATUP4",21) "BLD",7272,"KRN",9.8,"NM","B","BIPATVW1",33) "BLD",7272,"KRN",9.8,"NM","B","BIPATVW3",29) "BLD",7272,"KRN",9.8,"NM","B","BIPOST",28) "BLD",7272,"KRN",9.8,"NM","B","BIREPCSV",22) "BLD",7272,"KRN",9.8,"NM","B","BIREPD1",2) "BLD",7272,"KRN",9.8,"NM","B","BIREPD2",3) "BLD",7272,"KRN",9.8,"NM","B","BIREPD3",4) "BLD",7272,"KRN",9.8,"NM","B","BIREPF1",7) "BLD",7272,"KRN",9.8,"NM","B","BIREPF2",8) "BLD",7272,"KRN",9.8,"NM","B","BIREPF3",9) "BLD",7272,"KRN",9.8,"NM","B","BIREPL",23) "BLD",7272,"KRN",9.8,"NM","B","BIREPL1",5) "BLD",7272,"KRN",9.8,"NM","B","BIREPL2",6) "BLD",7272,"KRN",9.8,"NM","B","BIREPL4",24) "BLD",7272,"KRN",9.8,"NM","B","BIREPL5",16) "BLD",7272,"KRN",9.8,"NM","B","BIREPQ1",10) "BLD",7272,"KRN",9.8,"NM","B","BIREPQ2",11) "BLD",7272,"KRN",9.8,"NM","B","BIREPQ3",12) "BLD",7272,"KRN",9.8,"NM","B","BIREPT1",13) "BLD",7272,"KRN",9.8,"NM","B","BIREPT2",14) "BLD",7272,"KRN",9.8,"NM","B","BIREPT3",15) "BLD",7272,"KRN",9.8,"NM","B","BIRPC",25) "BLD",7272,"KRN",9.8,"NM","B","BISITE1",26) "BLD",7272,"KRN",9.8,"NM","B","BISITE4",27) "BLD",7272,"KRN",9.8,"NM","B","BIUTL2",18) "BLD",7272,"KRN",9.8,"NM","B","BIUTL3",17) "BLD",7272,"KRN",9.8,"NM","B","BIVWXICE",38) "BLD",7272,"KRN",19,0) 19 "BLD",7272,"KRN",19,"NM",0) ^9.68A^^0 "BLD",7272,"KRN",19.1,0) 19.1 "BLD",7272,"KRN",19.1,"NM",0) ^9.68A^^0 "BLD",7272,"KRN",101,0) 101 "BLD",7272,"KRN",101,"NM",0) ^9.68A^25^25 "BLD",7272,"KRN",101,"NM",1,0) BI REPORT ADOLESCENT CSV^^0 "BLD",7272,"KRN",101,"NM",2,0) BI REPORT ADOLESCENT HELP^^0 "BLD",7272,"KRN",101,"NM",3,0) BI REPORT ADOLESCENT PRINT^^0 "BLD",7272,"KRN",101,"NM",4,0) BI REPORT ADOLESCENT VIEW^^0 "BLD",7272,"KRN",101,"NM",5,0) BI MENU REPORT ADOLESCENT^^0 "BLD",7272,"KRN",101,"NM",6,0) BI REPORT FLU CSV^^0 "BLD",7272,"KRN",101,"NM",7,0) BI REPORT FLU HELP^^0 "BLD",7272,"KRN",101,"NM",8,0) BI REPORT FLU PRINT^^0 "BLD",7272,"KRN",101,"NM",9,0) BI REPORT FLU VIEW^^0 "BLD",7272,"KRN",101,"NM",10,0) BI MENU REPORT FLU^^0 "BLD",7272,"KRN",101,"NM",11,0) BI REPORT ADULT HELP^^0 "BLD",7272,"KRN",101,"NM",12,0) BI REPORT ADULT PRINT^^0 "BLD",7272,"KRN",101,"NM",13,0) BI REPORT ADULT VIEW^^0 "BLD",7272,"KRN",101,"NM",14,0) BI MENU REPORT ADULT^^0 "BLD",7272,"KRN",101,"NM",15,0) BI REPORT QTR CSV^^0 "BLD",7272,"KRN",101,"NM",16,0) BI REPORT QTR HELP^^0 "BLD",7272,"KRN",101,"NM",17,0) BI REPORT QTR PRINT^^0 "BLD",7272,"KRN",101,"NM",18,0) BI REPORT QTR VIEW^^0 "BLD",7272,"KRN",101,"NM",19,0) BI MENU REPORT QTR^^0 "BLD",7272,"KRN",101,"NM",20,0) BI REPORT TWO-TR CSV^^0 "BLD",7272,"KRN",101,"NM",21,0) BI REPORT TWO-YR HELP^^0 "BLD",7272,"KRN",101,"NM",22,0) BI REPORT TWO-YR PRINT^^0 "BLD",7272,"KRN",101,"NM",23,0) BI REPORT TWO-YR VIEW^^0 "BLD",7272,"KRN",101,"NM",24,0) BI MENU REPORT TWO-YR^^0 "BLD",7272,"KRN",101,"NM",25,0) BI REPORT ADULT CSV^^0 "BLD",7272,"KRN",101,"NM","B","BI MENU REPORT ADOLESCENT",5) "BLD",7272,"KRN",101,"NM","B","BI MENU REPORT ADULT",14) "BLD",7272,"KRN",101,"NM","B","BI MENU REPORT FLU",10) "BLD",7272,"KRN",101,"NM","B","BI MENU REPORT QTR",19) "BLD",7272,"KRN",101,"NM","B","BI MENU REPORT TWO-YR",24) "BLD",7272,"KRN",101,"NM","B","BI REPORT ADOLESCENT CSV",1) "BLD",7272,"KRN",101,"NM","B","BI REPORT ADOLESCENT HELP",2) "BLD",7272,"KRN",101,"NM","B","BI REPORT ADOLESCENT PRINT",3) "BLD",7272,"KRN",101,"NM","B","BI REPORT ADOLESCENT VIEW",4) "BLD",7272,"KRN",101,"NM","B","BI REPORT ADULT CSV",25) "BLD",7272,"KRN",101,"NM","B","BI REPORT ADULT HELP",11) "BLD",7272,"KRN",101,"NM","B","BI REPORT ADULT PRINT",12) "BLD",7272,"KRN",101,"NM","B","BI REPORT ADULT VIEW",13) "BLD",7272,"KRN",101,"NM","B","BI REPORT FLU CSV",6) "BLD",7272,"KRN",101,"NM","B","BI REPORT FLU HELP",7) "BLD",7272,"KRN",101,"NM","B","BI REPORT FLU PRINT",8) "BLD",7272,"KRN",101,"NM","B","BI REPORT FLU VIEW",9) "BLD",7272,"KRN",101,"NM","B","BI REPORT QTR CSV",15) "BLD",7272,"KRN",101,"NM","B","BI REPORT QTR HELP",16) "BLD",7272,"KRN",101,"NM","B","BI REPORT QTR PRINT",17) "BLD",7272,"KRN",101,"NM","B","BI REPORT QTR VIEW",18) "BLD",7272,"KRN",101,"NM","B","BI REPORT TWO-TR CSV",20) "BLD",7272,"KRN",101,"NM","B","BI REPORT TWO-YR HELP",21) "BLD",7272,"KRN",101,"NM","B","BI REPORT TWO-YR PRINT",22) "BLD",7272,"KRN",101,"NM","B","BI REPORT TWO-YR VIEW",23) "BLD",7272,"KRN",409.61,0) 409.61 "BLD",7272,"KRN",771,0) 771 "BLD",7272,"KRN",779.2,0) 779.2 "BLD",7272,"KRN",870,0) 870 "BLD",7272,"KRN",8989.51,0) 8989.51 "BLD",7272,"KRN",8989.52,0) 8989.52 "BLD",7272,"KRN",8994,0) 8994 "BLD",7272,"KRN",9002226,0) 9002226 "BLD",7272,"KRN",9002226,"NM",0) ^9.68A^^0 "BLD",7272,"PRE") BIENVCHK "BLD",7272,"QDEF") ^^^^NO^^^^NO^^NO "BLD",7272,"QUES",0) ^9.62^^ "BLD",7272,"REQB",0) ^9.611^^ "INIT") V85P31^BIPOST "KRN",101,4834,-1) 0^19 "KRN",101,4834,0) BI MENU REPORT QTR^Quarterly Report^^M^^^^^^^^IMMUNIZATION "KRN",101,4834,4) 25^3 "KRN",101,4834,10,0) ^101.01PA^7^7 "KRN",101,4834,10,2,0) 4836^V^1^ "KRN",101,4834,10,2,"^") BI REPORT QTR VIEW "KRN",101,4834,10,3,0) 4835^P^3^ "KRN",101,4834,10,3,"^") BI REPORT QTR PRINT "KRN",101,4834,10,4,0) 4912^H^5^ "KRN",101,4834,10,4,"^") BI REPORT QTR HELP "KRN",101,4834,10,7,0) 7613^C^5^ "KRN",101,4834,10,7,"^") BI REPORT QTR CSV "KRN",101,4834,26) D SHOW^VALM "KRN",101,4834,28) Select Action: "KRN",101,4834,29) Quit "KRN",101,4834,99) 67331,35719 "KRN",101,4835,-1) 0^17 "KRN",101,4835,0) BI REPORT QTR PRINT^Print Qtr Report^^A^^^^^^^^IMMUNIZATION "KRN",101,4835,20) D START^BIREPQ1("PRINT") "KRN",101,4835,99) 62404,75375 "KRN",101,4836,-1) 0^18 "KRN",101,4836,0) BI REPORT QTR VIEW^View Qtr Report^^A^^^^^^^^IMMUNIZATION "KRN",101,4836,20) D START^BIREPQ1("VIEW") "KRN",101,4836,99) 62404,75375 "KRN",101,4836,101.04) ^Select Action: "KRN",101,4839,-1) 0^22 "KRN",101,4839,0) BI REPORT TWO-YR PRINT^Print Rates Report^^A^^^^^^^^IMMUNIZATION "KRN",101,4839,20) D START^BIREPT1("PRINT") "KRN",101,4839,99) 62404,75375 "KRN",101,4840,-1) 0^23 "KRN",101,4840,0) BI REPORT TWO-YR VIEW^View Rates Report^^A^^^^^^^^IMMUNIZATION "KRN",101,4840,20) D START^BIREPT1("VIEW") "KRN",101,4840,99) 62404,75375 "KRN",101,4840,101.04) ^Select Action: "KRN",101,4841,-1) 0^24 "KRN",101,4841,0) BI MENU REPORT TWO-YR^Two-Yr-Old Report^^M^^^^^^^^IMMUNIZATION "KRN",101,4841,4) 25^3 "KRN",101,4841,10,0) ^101.01PA^8^8 "KRN",101,4841,10,4,0) 4839^P^3^ "KRN",101,4841,10,4,"^") BI REPORT TWO-YR PRINT "KRN",101,4841,10,5,0) 4840^V^1^ "KRN",101,4841,10,5,"^") BI REPORT TWO-YR VIEW "KRN",101,4841,10,7,0) 4913^H^6^ "KRN",101,4841,10,7,"^") BI REPORT TWO-YR HELP "KRN",101,4841,10,8,0) 7595^C^5^ "KRN",101,4841,10,8,"^") BI REPORT TWO-TR CSV "KRN",101,4841,26) D SHOW^VALM "KRN",101,4841,28) Select Action: "KRN",101,4841,29) Quit "KRN",101,4841,99) 67312,50079 "KRN",101,4905,-1) 0^14 "KRN",101,4905,0) BI MENU REPORT ADULT^Adult Report^^M^^^^^^^^IMMUNIZATION "KRN",101,4905,4) 25^3 "KRN",101,4905,10,0) ^101.01PA^14^14 "KRN",101,4905,10,9,0) 4908^V^1^ "KRN",101,4905,10,9,"^") BI REPORT ADULT VIEW "KRN",101,4905,10,10,0) 4907^P^3^ "KRN",101,4905,10,10,"^") BI REPORT ADULT PRINT "KRN",101,4905,10,11,0) 4916^H^5^ "KRN",101,4905,10,11,"^") BI REPORT ADULT HELP "KRN",101,4905,10,14,0) 7615^C^8^ "KRN",101,4905,10,14,"^") BI REPORT ADULT CSV "KRN",101,4905,26) D SHOW^VALM "KRN",101,4905,28) Select Action: "KRN",101,4905,29) Quit "KRN",101,4905,99) 67340,51793 "KRN",101,4907,-1) 0^12 "KRN",101,4907,0) BI REPORT ADULT PRINT^Print Adult Report^^A^^^^^^^^IMMUNIZATION "KRN",101,4907,20) D START^BIREPL1("PRINT") "KRN",101,4907,99) 62404,75376 "KRN",101,4908,-1) 0^13 "KRN",101,4908,0) BI REPORT ADULT VIEW^View Adult Report^^A^^^^^^^^IMMUNIZATION "KRN",101,4908,20) D START^BIREPL1("VIEW") "KRN",101,4908,99) 62404,75376 "KRN",101,4912,-1) 0^16 "KRN",101,4912,0) BI REPORT QTR HELP^Help^^A^^^^^^^^IMMUNIZATION "KRN",101,4912,20) D HELP1^BIREPQ "KRN",101,4912,99) 62404,75376 "KRN",101,4913,-1) 0^21 "KRN",101,4913,0) BI REPORT TWO-YR HELP^Help^^A^^^^^^^^IMMUNIZATION "KRN",101,4913,20) D HELP1^BIREPT "KRN",101,4913,99) 62404,75376 "KRN",101,4916,-1) 0^11 "KRN",101,4916,0) BI REPORT ADULT HELP^Help^^A^^^^^^^^IMMUNIZATION "KRN",101,4916,20) D HELP1^BIREPL "KRN",101,4916,99) 62404,75376 "KRN",101,4948,-1) 0^5 "KRN",101,4948,0) BI MENU REPORT ADOLESCENT^Adolescent Report^^M^^^^^^^^IMMUNIZATION "KRN",101,4948,4) 25^3 "KRN",101,4948,10,0) ^101.01PA^6^6 "KRN",101,4948,10,2,0) 4952^H^5^ "KRN",101,4948,10,2,"^") BI REPORT ADOLESCENT HELP "KRN",101,4948,10,3,0) 4950^P^3^ "KRN",101,4948,10,3,"^") BI REPORT ADOLESCENT PRINT "KRN",101,4948,10,4,0) 4951^V^1^ "KRN",101,4948,10,4,"^") BI REPORT ADOLESCENT VIEW "KRN",101,4948,10,6,0) 7614^C^8^ "KRN",101,4948,10,6,"^") BI REPORT ADOLESCENT CSV "KRN",101,4948,26) D SHOW^VALM "KRN",101,4948,28) Select Action: "KRN",101,4948,29) Quit "KRN",101,4948,99) 67339,44613 "KRN",101,4950,-1) 0^3 "KRN",101,4950,0) BI REPORT ADOLESCENT PRINT^Print Rates Report^^A^^^^^^^^IMMUNIZATION "KRN",101,4950,15) "KRN",101,4950,20) D START^BIREPD1("PRINT") "KRN",101,4950,99) 62404,75376 "KRN",101,4951,-1) 0^4 "KRN",101,4951,0) BI REPORT ADOLESCENT VIEW^View Rates Report^^A^^^^^^^^IMMUNIZATION "KRN",101,4951,20) D START^BIREPD1("VIEW") "KRN",101,4951,99) 62404,75376 "KRN",101,4952,-1) 0^2 "KRN",101,4952,0) BI REPORT ADOLESCENT HELP^Help^^A^^^^^^^^IMMUNIZATION "KRN",101,4952,20) D HELP1^BIREPD "KRN",101,4952,99) 62404,75376 "KRN",101,4954,-1) 0^10 "KRN",101,4954,0) BI MENU REPORT FLU^Influenza REport^^M^^^^^^^^IMMUNIZATION "KRN",101,4954,4) 25^3 "KRN",101,4954,10,0) ^101.01PA^6^6 "KRN",101,4954,10,2,0) 4959^V^1^ "KRN",101,4954,10,2,"^") BI REPORT FLU VIEW "KRN",101,4954,10,3,0) 4957^P^3^ "KRN",101,4954,10,3,"^") BI REPORT FLU PRINT "KRN",101,4954,10,5,0) 4958^H^5^ "KRN",101,4954,10,5,"^") BI REPORT FLU HELP "KRN",101,4954,10,6,0) 7596^C^3^ "KRN",101,4954,10,6,"^") BI REPORT FLU CSV "KRN",101,4954,26) D SHOW^VALM "KRN",101,4954,28) Select Action: "KRN",101,4954,29) Quit "KRN",101,4954,99) 67319,45041 "KRN",101,4957,-1) 0^8 "KRN",101,4957,0) BI REPORT FLU PRINT^Print Flu Report^^A^^^^^^^^IMMUNIZATION "KRN",101,4957,20) D START^BIREPF1("PRINT") "KRN",101,4957,99) 62404,75376 "KRN",101,4958,-1) 0^7 "KRN",101,4958,0) BI REPORT FLU HELP^Help^^A^^^^^^^^IMMUNIZATION "KRN",101,4958,20) D HELP1^BIREPF "KRN",101,4958,99) 62404,75376 "KRN",101,4959,-1) 0^9 "KRN",101,4959,0) BI REPORT FLU VIEW^View Flu Report^^A^^^^^^^^IMMUNIZATION "KRN",101,4959,20) D START^BIREPF1("VIEW") "KRN",101,4959,99) 62404,75376 "KRN",101,7595,-1) 0^20 "KRN",101,7595,0) BI REPORT TWO-TR CSV^.csv Rates Report^^A^^^^^^^^IMMUNIZATION "KRN",101,7595,4) ^^^C "KRN",101,7595,20) D START^BIREPT1("CSV") "KRN",101,7595,99) 67312,49764 "KRN",101,7596,-1) 0^6 "KRN",101,7596,0) BI REPORT FLU CSV^.csv Rates Report^^A^^^^^^^^IMMUNIZATION "KRN",101,7596,4) ^^^C "KRN",101,7596,20) D START^BIREPF1("CSV") "KRN",101,7596,99) 67319,44900 "KRN",101,7613,-1) 0^15 "KRN",101,7613,0) BI REPORT QTR CSV^.csv Rates Report^^A^^^^^^^^IMMUNIZATION "KRN",101,7613,4) ^^^C "KRN",101,7613,20) D START^BIREPQ1("CSV") "KRN",101,7613,99) 67331,35576 "KRN",101,7614,-1) 0^1 "KRN",101,7614,0) BI REPORT ADOLESCENT CSV^.csv output file^^A^^^^^^^^IMMUNIZATION "KRN",101,7614,4) ^^^C "KRN",101,7614,20) D START^BIREPD1("CSV") "KRN",101,7614,99) 67339,44480 "KRN",101,7615,-1) 0^25 "KRN",101,7615,0) BI REPORT ADULT CSV^.csv formated report^^A^^^^^^^^IMMUNIZATION "KRN",101,7615,4) ^^^C "KRN",101,7615,20) D START^BIREPL1("CSV") "KRN",101,7615,99) 67340,51699 "MBREQ") 0 "ORD",15,101) 101;15;;;PRO^XPDTA;PROF1^XPDIA;PROE1^XPDIA;PROF2^XPDIA;;PRODEL^XPDIA "ORD",15,101,0) PROTOCOL "PKG",258,-1) 1^1 "PKG",258,0) IMMUNIZATION^BI^NEW IMMUNIZATION TRACKING SYSTEM "PKG",258,20,0) ^9.402P^^ "PKG",258,22,0) ^9.49I^1^1 "PKG",258,22,1,0) 8.5^3111024^3111109^1250 "PKG",258,22,1,"PAH",1,0) 31^3250902 "PRE") BIENVCHK "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") NO "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 39 "RTN","BIAPCHS") 0^30^B49869768 "RTN","BIAPCHS",1,0) BIAPCHS ;IHS/CMI/MWR - PRODUCE IMMUNIZATION PATIENT RECORD FOR HEALTH SUMMARY.; MAY 10, 2010 ; 27 Aug 2025 11:24 PM "RTN","BIAPCHS",2,0) ;;8.5;IMMUNIZATION;**3,31**;OCT 24,2011;Build 137 "RTN","BIAPCHS",3,0) ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS * "RTN","BIAPCHS",4,0) ;; BUILD TEMP ARRAY TO PASS BACK TO APCHS2. "RTN","BIAPCHS",5,0) ;; PATCH 3: Use Date of Event if it exists for Imm Hx. HISTORY+33,+81 "RTN","BIAPCHS",6,0) ; "RTN","BIAPCHS",7,0) ;---> Call from IMMBI8^APCHS2: D IMMBI^BIAPCHS(APCHSPAT,.APCHSARR) "RTN","BIAPCHS",8,0) ; "RTN","BIAPCHS",9,0) ;---------- "RTN","BIAPCHS",10,0) IMMBI(BIDFN,BIARRAY) ;EP "RTN","BIAPCHS",11,0) ;---> Get patient's Immunization Data and write lines for display in "RTN","BIAPCHS",12,0) ;---> Health Summary. Pass formatted lines back in BIARRAY. "RTN","BIAPCHS",13,0) ;---> Called by APCHS2. "RTN","BIAPCHS",14,0) ;---> Parameters: "RTN","BIAPCHS",15,0) ; 1 - BIDFN (req) Patient's IEN in VA PATIENT File #2. "RTN","BIAPCHS",16,0) ; 2 - BIARRAY (ret) Local array of formatted lines for Health Summary. "RTN","BIAPCHS",17,0) ; "RTN","BIAPCHS",18,0) N BI31 S BI31=$C(31)_$C(31) "RTN","BIAPCHS",19,0) K ^TMP("BIHS",$J) "RTN","BIAPCHS",20,0) D GATHER($G(BIDFN)) "RTN","BIAPCHS",21,0) D PASSARR(.BIARRAY) "RTN","BIAPCHS",22,0) K ^TMP("BIHS",$J) "RTN","BIAPCHS",23,0) Q "RTN","BIAPCHS",24,0) ; "RTN","BIAPCHS",25,0) ; "RTN","BIAPCHS",26,0) ;---------- "RTN","BIAPCHS",27,0) GATHER(BIDFN) ;EP "RTN","BIAPCHS",28,0) ;---> Get patient's Immunization Data and write lines for display in "RTN","BIAPCHS",29,0) ;---> Health Summary. Store lines in ^TMP("BIHS",$J...). "RTN","BIAPCHS",30,0) ;---> Called by APCHS2. "RTN","BIAPCHS",31,0) ;---> Parameters: "RTN","BIAPCHS",32,0) ; 1 - BIDFN (req) Patient's IEN in VA PATIENT File #2. "RTN","BIAPCHS",33,0) ; "RTN","BIAPCHS",34,0) N BILINE S BILINE=0 "RTN","BIAPCHS",35,0) ; "RTN","BIAPCHS",36,0) ;---> Error check. "RTN","BIAPCHS",37,0) N BIERR,BIPDSS S BIERR="" "RTN","BIAPCHS",38,0) D I BIERR]"" D WRITE(.BILINE,BIERR) Q "RTN","BIAPCHS",39,0) .I '$G(BIDFN) D ERRCD^BIUTL2(201,.BIERR) Q "RTN","BIAPCHS",40,0) .I '$D(^DPT(BIDFN,0)) D ERRCD^BIUTL2(203,.BIERR) Q "RTN","BIAPCHS",41,0) .S:'$G(BIFDT) BIFDT=DT "RTN","BIAPCHS",42,0) ; "RTN","BIAPCHS",43,0) ;---> Retrieve and store sections of letter in WP ^TMP global. "RTN","BIAPCHS",44,0) D FORECAST(BIDFN,.BILINE,.BIPDSS) "RTN","BIAPCHS",45,0) D CONTRAS(BIDFN,.BILINE) "RTN","BIAPCHS",46,0) D HISTORY(BIDFN,.BILINE,BIPDSS) "RTN","BIAPCHS",47,0) Q "RTN","BIAPCHS",48,0) ; "RTN","BIAPCHS",49,0) ; "RTN","BIAPCHS",50,0) ;---------- "RTN","BIAPCHS",51,0) PASSARR(BIARRAY) ;EP "RTN","BIAPCHS",52,0) ;---> Get patient's Immunization Health Summary formatted display lines from "RTN","BIAPCHS",53,0) ;---> ^TMP("BIHS",$J) and populate BIARRAY to pass back to APCHS2. "RTN","BIAPCHS",54,0) ;---> Parameters: "RTN","BIAPCHS",55,0) ; 1 - BIARRAY (req) Local array receiving copy of HS formatted lines "RTN","BIAPCHS",56,0) ; from ^TMP("BIHS",$J...) "RTN","BIAPCHS",57,0) N N S N=0 "RTN","BIAPCHS",58,0) F S N=$O(^TMP("BIHS",$J,N)) Q:'N S BIARRAY(N,0)=^(N,0) "RTN","BIAPCHS",59,0) ; "RTN","BIAPCHS",60,0) Q "RTN","BIAPCHS",61,0) ; "RTN","BIAPCHS",62,0) ; "RTN","BIAPCHS",63,0) ;---------- "RTN","BIAPCHS",64,0) FORECAST(BIDFN,BILINE,BIPDSS) ;EP "RTN","BIAPCHS",65,0) ;---> Calculate and store Forecast in WP ^TMP global. "RTN","BIAPCHS",66,0) ;---> Parameters: "RTN","BIAPCHS",67,0) ; 1 - BIDFN (req) Patient's IEN in VA PATIENT File #2. "RTN","BIAPCHS",68,0) ; 2 - BILINE (ret) Last line written into ^TMP array. "RTN","BIAPCHS",69,0) ; 3 - BIPDSS (ret) Returned string of Visit IEN's that are "RTN","BIAPCHS",70,0) ; Problem Doses, according to ImmServe. "RTN","BIAPCHS",71,0) ; "RTN","BIAPCHS",72,0) ; "RTN","BIAPCHS",73,0) N BIFORCST,BIERR S BIFORCST="",BIPDSS="" "RTN","BIAPCHS",74,0) ; "RTN","BIAPCHS",75,0) ;---> Get forecast string (BIFORCST) and problem dose string (BIPDSS). "RTN","BIAPCHS",76,0) ;---> Pass BIPDSS to HISTORY to mark problem doses with asterisks. "RTN","BIAPCHS",77,0) ;---> Pass BIFORCST to FORECAST for display. "RTN","BIAPCHS",78,0) ;V8.5 P31 - FID- Include '*HR*' high risk flag "RTN","BIAPCHS",79,0) D IMMFORC^BIRPC(.BIFORCST,BIDFN,,,,.BIPDSS,1) "RTN","BIAPCHS",80,0) D WRITE(.BILINE," IMMUNIZATION FORECAST:",1) "RTN","BIAPCHS",81,0) ; "RTN","BIAPCHS",82,0) ;---> Check for error in 2nd piece of return value. "RTN","BIAPCHS",83,0) S BIERR=$P(BIFORCST,BI31,2) "RTN","BIAPCHS",84,0) ;---> If there's an error, display it and quit. "RTN","BIAPCHS",85,0) I BIERR]"" D WRITE(.BILINE," *"_BIERR) Q "RTN","BIAPCHS",86,0) ; "RTN","BIAPCHS",87,0) ;---> No error, so take 1st piece of return value and process it. "RTN","BIAPCHS",88,0) S BIFORCST=$P(BIFORCST,BI31,1) "RTN","BIAPCHS",89,0) N I,X "RTN","BIAPCHS",90,0) F I=1:1 S X=$P(BIFORCST,U,I) Q:X="" D "RTN","BIAPCHS",91,0) .N Y S Y=" "_$$PAD($P(X,"|"),20) "RTN","BIAPCHS",92,0) .S Y=Y_$$PAD($P(X,"|",2),36)_$P(X,"|",3) "RTN","BIAPCHS",93,0) .D WRITE(.BILINE,Y) "RTN","BIAPCHS",94,0) D WRITE(.BILINE) "RTN","BIAPCHS",95,0) Q "RTN","BIAPCHS",96,0) ; "RTN","BIAPCHS",97,0) ; "RTN","BIAPCHS",98,0) ;---------- "RTN","BIAPCHS",99,0) CONTRAS(BIDFN,BILINE) ;EP "RTN","BIAPCHS",100,0) ;---> Store Contraindications in ^TMP global. "RTN","BIAPCHS",101,0) ;---> Parameters: "RTN","BIAPCHS",102,0) ; 1 - BIDFN (req) Patient's IEN in VA PATIENT File #2. "RTN","BIAPCHS",103,0) ; 2 - BILINE (ret) Last line written into ^TMP array. "RTN","BIAPCHS",104,0) ; "RTN","BIAPCHS",105,0) N BIRETVAL S BIRETVAL="" "RTN","BIAPCHS",106,0) ;---> RPC to retrieve Contraindications. "RTN","BIAPCHS",107,0) D CONTRAS^BIRPC5(.BIRETVAL,BIDFN) "RTN","BIAPCHS",108,0) ; "RTN","BIAPCHS",109,0) ;---> If BIERR has a value, display it and quit. "RTN","BIAPCHS",110,0) S BIERR=$P(BIRETVAL,BI31,2) "RTN","BIAPCHS",111,0) I BIERR]"" D WRITE(.BILINE," *"_BIERR) Q "RTN","BIAPCHS",112,0) ; "RTN","BIAPCHS",113,0) ;---> Set BIC=to a string of Contraindications for this patient. "RTN","BIAPCHS",114,0) N BIC S BIC=$P(BIRETVAL,BI31,1) "RTN","BIAPCHS",115,0) Q:BIC="" "RTN","BIAPCHS",116,0) ;---> Build Health Summary array from BIC string. "RTN","BIAPCHS",117,0) N I,X "RTN","BIAPCHS",118,0) F I=1:1 S X=$P(BIC,U,I) Q:X="" D "RTN","BIAPCHS",119,0) .;---> Build display line for this Contraindication. "RTN","BIAPCHS",120,0) .N V,Y S V="|",Y=" " "RTN","BIAPCHS",121,0) .S:I=1 Y=Y_"* Contraindications:" S Y=$$PAD(Y,28) "RTN","BIAPCHS",122,0) .; "RTN","BIAPCHS",123,0) .;---> Display "Vaccine: Date Reason" "RTN","BIAPCHS",124,0) .S Y=Y_$P(X,V,2)_":",Y=$$PAD(Y,40)_$P(X,V,4) "RTN","BIAPCHS",125,0) .S Y=$$PAD(Y,53)_$P(X,V,3) "RTN","BIAPCHS",126,0) .;---> Set formatted Contraindication line and index in ^TMP. "RTN","BIAPCHS",127,0) .D WRITE(.BILINE,Y) "RTN","BIAPCHS",128,0) D WRITE(.BILINE) "RTN","BIAPCHS",129,0) Q "RTN","BIAPCHS",130,0) ; "RTN","BIAPCHS",131,0) ; "RTN","BIAPCHS",132,0) HISTORY(BIDFN,BILINE,BIPDSS) ;EP "RTN","BIAPCHS",133,0) ;---> Retrieve Patient's Imm History and store in WP ^TMP global. "RTN","BIAPCHS",134,0) ;---> Parameters: "RTN","BIAPCHS",135,0) ; 1 - BIDFN (req) Patient's IEN in VA PATIENT File #2. "RTN","BIAPCHS",136,0) ; 2 - BILINE (ret) Last line written into ^TMP array. "RTN","BIAPCHS",137,0) ; 3 - BIPDSS (ret) Returned string of Visit IEN's that are "RTN","BIAPCHS",138,0) ; Problem Doses, according to ImmServe. "RTN","BIAPCHS",139,0) ; "RTN","BIAPCHS",140,0) ;---> Next line: Change Data Elements called. ;Cimarron/Mike Remillard 7/30/03 "RTN","BIAPCHS",141,0) ;---> Use Date Element IEN 4 instead of 8. DE 8 used to contain Dose#-Short Name; "RTN","BIAPCHS",142,0) ;---> now it contains vaccine components. "RTN","BIAPCHS",143,0) ;---> Also add DE 24 V File IEN, and DE 65 is Dose Override. "RTN","BIAPCHS",144,0) ;NEW BIDE,I F I=8,26,27,60,33,44,57 S BIDE(I)="" "RTN","BIAPCHS",145,0) ; "RTN","BIAPCHS",146,0) ; "RTN","BIAPCHS",147,0) ; "RTN","BIAPCHS",148,0) ;---> If BIDE local array (Data Elements to be returned) is not "RTN","BIAPCHS",149,0) ;---> passed, then set the following default Data Elements. "RTN","BIAPCHS",150,0) ;---> The following are IEN's in ^BIEXPDD(. "RTN","BIAPCHS",151,0) ;---> IEN PC DATA "RTN","BIAPCHS",152,0) ;---> --- -- ---- "RTN","BIAPCHS",153,0) ;---> 1 = Visit Type: "I"=Immunization, "S"=Skin Test. "RTN","BIAPCHS",154,0) ;---> 4 2 = Vaccine Name, Short. "RTN","BIAPCHS",155,0) ;---> 8 3 = Vaccine Components. ;v8.0 "RTN","BIAPCHS",156,0) ;---> 24 4 = IEN, V File Visit. "RTN","BIAPCHS",157,0) ;---> 26 5 = Location (or Outside Location) where Imm was given. "RTN","BIAPCHS",158,0) ;---> 27 6 = Vaccine Group (Series Type) for grouping of vaccines. "RTN","BIAPCHS",159,0) ;---> 33 7 = Vaccine Lot#, Text. "RTN","BIAPCHS",160,0) ;---> 44 8 = Reaction to Immunization, text. "RTN","BIAPCHS",161,0) ;---> 57 9 = Age at Visit. "RTN","BIAPCHS",162,0) ;---> 65 10 = Dose Override. "RTN","BIAPCHS",163,0) ;---> 66 11 = Date of Visit (MM/DD/YY). "RTN","BIAPCHS",164,0) ;---> 69 12 = Vaccine Component CVX Code. "RTN","BIAPCHS",165,0) ;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR "RTN","BIAPCHS",166,0) ;---> Add Date of Event to Hx string. "RTN","BIAPCHS",167,0) ;---> 86 13 = Date of Event (1201 field of V File) in YYYMMDD "RTN","BIAPCHS",168,0) ; "RTN","BIAPCHS",169,0) ; "RTN","BIAPCHS",170,0) ;N BIDE,I F I=4,8,24,26,27,33,44,57,65,66,69 S BIDE(I)="" "RTN","BIAPCHS",171,0) N BIDE,I F I=4,8,24,26,27,33,44,57,65,66,69,86 S BIDE(I)="" "RTN","BIAPCHS",172,0) ;********** "RTN","BIAPCHS",173,0) ; "RTN","BIAPCHS",174,0) ;call to get imm hx "RTN","BIAPCHS",175,0) N BIERR,BIFORCST,BIRETVAL S BIRETVAL="" "RTN","BIAPCHS",176,0) D IMMHX^BIRPC(.BIRETVAL,BIDFN,.BIDE,1,0) "RTN","BIAPCHS",177,0) D WRITE(.BILINE," IMMUNIZATION HISTORY:") "RTN","BIAPCHS",178,0) ; "RTN","BIAPCHS",179,0) ;---> If there is an Invalid Dose or Reaction, append extra line feed. "RTN","BIAPCHS",180,0) ;---> Use BILF as a line feed flag. ***NOT USED for now. CIM/MWR 8/4/03 "RTN","BIAPCHS",181,0) N BILF S BILF=0 "RTN","BIAPCHS",182,0) ; "RTN","BIAPCHS",183,0) S BIERR=$P(BIRETVAL,BI31,2) "RTN","BIAPCHS",184,0) I BIERR]"" D WRITE(.BILINE," *"_BIERR) Q "RTN","BIAPCHS",185,0) ; "RTN","BIAPCHS",186,0) S BIFORCST=$P(BIRETVAL,BI31,1) "RTN","BIAPCHS",187,0) N I,V,BIX,BIZ S BIZ="",V="|" "RTN","BIAPCHS",188,0) ; "RTN","BIAPCHS",189,0) F I=1:1 S BIX=$P(BIFORCST,U,I) Q:BIX="" D "RTN","BIAPCHS",190,0) .Q:$P(BIX,V)'="I" "RTN","BIAPCHS",191,0) .; "RTN","BIAPCHS",192,0) .;---> Check if new vaccine group; if so, insert line feed. "RTN","BIAPCHS",193,0) .I $P(BIX,V,6)'=BIZ D "RTN","BIAPCHS",194,0) ..S BIZ=$P(BIX,V,6) "RTN","BIAPCHS",195,0) ..;---> If extra line feed was just sent due to Invalid/Reaction, don't here. "RTN","BIAPCHS",196,0) ..D:'$G(BILF) WRITE(.BILINE) "RTN","BIAPCHS",197,0) .;---> Reset line feed flag to zero. "RTN","BIAPCHS",198,0) .S BILF=0 "RTN","BIAPCHS",199,0) .; "RTN","BIAPCHS",200,0) .;---> Set flag for ImmServe Problem Dose, flag for asterisk. "RTN","BIAPCHS",201,0) .N BIAST,BIIMMS S BIAST=0,BIIMMS=0 "RTN","BIAPCHS",202,0) .;---> Next line: Insert asterisk if Problem Dose ;Cimarron/Mike Remillard 7/30/03 "RTN","BIAPCHS",203,0) .D "RTN","BIAPCHS",204,0) ..;---> If there is a Dose Override, set asterisk flag (BIAST)=1. "RTN","BIAPCHS",205,0) ..I $P(BIX,V,10) S BIAST=1 Q "RTN","BIAPCHS",206,0) ..;---> If ImmServe considers this dose to be Invalid, insert asterisk. "RTN","BIAPCHS",207,0) ..;---> Use BIPDSS (ImmServe problem dose string) from Forecast above. "RTN","BIAPCHS",208,0) ..I $$PDSS^BIUTL8($P(BIX,V,4),$P(BIX,V,12),BIPDSS) S BIAST=1,BIIMMS=1 "RTN","BIAPCHS",209,0) .; "RTN","BIAPCHS",210,0) .N Y S Y="" "RTN","BIAPCHS",211,0) .S Y=" "_$S($G(BIAST):"*",1:" ")_$P(BIX,V,2) "RTN","BIAPCHS",212,0) .; "RTN","BIAPCHS",213,0) .;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR "RTN","BIAPCHS",214,0) .;---> Display Date of Event if different from Date of Visit. "RTN","BIAPCHS",215,0) .;---> Also display Age at time of Event if different. "RTN","BIAPCHS",216,0) .;S Y=$$PAD(Y,27)_$P(BIX,V,11) "RTN","BIAPCHS",217,0) .;S Y=$$PAD(Y,37)_$P(BIX,V,9) "RTN","BIAPCHS",218,0) .N BIDT S BIDT=$P(BIX,V,13) "RTN","BIAPCHS",219,0) .S Y=$$PAD(Y,27)_$$SLDT2^BIUTL5(BIDT,1) "RTN","BIAPCHS",220,0) .S Y=$$PAD(Y,37)_$$AGEF^BIUTL1(BIDFN,BIDT) "RTN","BIAPCHS",221,0) .;********** "RTN","BIAPCHS",222,0) .; "RTN","BIAPCHS",223,0) .S Y=$$PAD(Y,45)_$E($P(BIX,V,5),1,20) "RTN","BIAPCHS",224,0) .S Y=$$PAD(Y,66)_$P(BIX,V,7) "RTN","BIAPCHS",225,0) .D WRITE(.BILINE,Y) "RTN","BIAPCHS",226,0) .; "RTN","BIAPCHS",227,0) .;---> If there was a Dose Override, display it here. "RTN","BIAPCHS",228,0) .D:$P(BIX,V,10) "RTN","BIAPCHS",229,0) ..S Y=$$PAD(" ",27)_"-"_$$DOVER^BIUTL8($P(BIX,V,10))_"-" "RTN","BIAPCHS",230,0) ..D WRITE(.BILINE,Y) ;S BILF=1 "RTN","BIAPCHS",231,0) .; "RTN","BIAPCHS",232,0) .;---> If ImmServe considers this dose to be Invalid, display it here. "RTN","BIAPCHS",233,0) .;---> Use BIPDSS (ImmServe problem dose string) from Forecast above. "RTN","BIAPCHS",234,0) .D:$G(BIIMMS) "RTN","BIAPCHS",235,0) ..S Y=$$PAD(" ",27)_"-INVALID--SEE IMMSERVE-" "RTN","BIAPCHS",236,0) ..D WRITE(.BILINE,Y) ;S BILF=1 "RTN","BIAPCHS",237,0) .; "RTN","BIAPCHS",238,0) .;---> If there was a Reaction, display it here. "RTN","BIAPCHS",239,0) .D:$P(BIX,V,8)]"" "RTN","BIAPCHS",240,0) ..S Y=$$PAD(" ",27)_"Reaction: "_$P(BIX,V,8) "RTN","BIAPCHS",241,0) ..D WRITE(.BILINE,Y) ;S BILF=1 "RTN","BIAPCHS",242,0) ; "RTN","BIAPCHS",243,0) Q "RTN","BIAPCHS",244,0) ; "RTN","BIAPCHS",245,0) ; "RTN","BIAPCHS",246,0) ;---------- "RTN","BIAPCHS",247,0) PAD(D,L,C) ;EP "RTN","BIAPCHS",248,0) ;---> Pad the length of data to a total of L characters "RTN","BIAPCHS",249,0) ;---> by adding spaces to the end of the data. "RTN","BIAPCHS",250,0) ; Example: S X=$$PAD("MIKE",7) X="MIKE " (Added 3 spaces.) "RTN","BIAPCHS",251,0) ;---> Parameters: "RTN","BIAPCHS",252,0) ; 1 - D (req) Data to be padded. "RTN","BIAPCHS",253,0) ; 2 - L (req) Total length of resulting data. "RTN","BIAPCHS",254,0) ; 3 - C (opt) Character to pad with (default=space). "RTN","BIAPCHS",255,0) ; "RTN","BIAPCHS",256,0) Q:'$D(D) "" "RTN","BIAPCHS",257,0) S:'$G(L) L=$L(D) "RTN","BIAPCHS",258,0) S:$G(C)="" C=" " "RTN","BIAPCHS",259,0) Q $E(D_$$REPEAT^XLFSTR(C,L),1,L) "RTN","BIAPCHS",260,0) ; "RTN","BIAPCHS",261,0) ; "RTN","BIAPCHS",262,0) ;---------- "RTN","BIAPCHS",263,0) WRITE(BILINE,BIVAL,BIBLNK) ;EP "RTN","BIAPCHS",264,0) ;---> Write lines to ^TMP (see documentation in ^BIW). "RTN","BIAPCHS",265,0) ;---> Parameters: "RTN","BIAPCHS",266,0) ; 1 - BILINE (ret) Last line# written. "RTN","BIAPCHS",267,0) ; 2 - BIVAL (opt) Value/text of line (Null=blank line). "RTN","BIAPCHS",268,0) ; 3 - BIBLNK (opt) Number of blank lines to add after line sent. "RTN","BIAPCHS",269,0) ; "RTN","BIAPCHS",270,0) Q:'$D(BILINE) "RTN","BIAPCHS",271,0) D WL^BIW(.BILINE,"BIHS",$G(BIVAL),$G(BIBLNK)) "RTN","BIAPCHS",272,0) Q "RTN","BIDUVLS2") 0^31^B41108859 "RTN","BIDUVLS2",1,0) BIDUVLS2 ;IHS/CMI/MWR - VIEW DUE LIST VIEW.; MAY 10, 2010 ; 03 Aug 2025 8:50 PM "RTN","BIDUVLS2",2,0) ;;8.5;IMMUNIZATION;**26,31**;OCT 24,2011;Build 137 "RTN","BIDUVLS2",3,0) ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS * "RTN","BIDUVLS2",4,0) ;; LIST TEMPLATE CODE FOR VIEWING PATIENTS DUE, SET LINES FOR "RTN","BIDUVLS2",5,0) ;; INDIVIDUAL PATIENTS. "RTN","BIDUVLS2",6,0) ; "RTN","BIDUVLS2",7,0) ; "RTN","BIDUVLS2",8,0) ;---------- "RTN","BIDUVLS2",9,0) PATIENT(BILINE,BIDFN,BINFO,BIDASH,BIMMRF,BIMMLF) ;EP "RTN","BIDUVLS2",10,0) ;---> Set line in Listman display global. "RTN","BIDUVLS2",11,0) ;---> Parameters: "RTN","BIDUVLS2",12,0) ; 1 - BILINE (req) Line Number in display area. "RTN","BIDUVLS2",13,0) ; 2 - BIDFN (req) Patient DFN. "RTN","BIDUVLS2",14,0) ; 3 - BINFO (req) Array of Additional Info elements. "RTN","BIDUVLS2",15,0) ; 4 - BIDASH (opt) 1=Omit Dash line between records; 0=include it. "RTN","BIDUVLS2",16,0) ; 5 - BIMMRF (opt) Imms Received Filter array (subscript=CVX's included). "RTN","BIDUVLS2",17,0) ; 6 - BIMMLF (opt) Lot Number Filter array (subscript=lot number text). "RTN","BIDUVLS2",18,0) ; "RTN","BIDUVLS2",19,0) Q:$G(BILINE)="" "RTN","BIDUVLS2",20,0) N BIPLIN,BIPLIN1,X "RTN","BIDUVLS2",21,0) ; "RTN","BIDUVLS2",22,0) ;---> Patient demographic line. "RTN","BIDUVLS2",23,0) S X=" "_$E($$NAME^BIUTL1(BIDFN),1,19) "RTN","BIDUVLS2",24,0) S X=$$PAD^BIUTL5(X,22)_$$PAD^BIUTL5($$HRCN^BIUTL1(BIDFN,DUZ(2)),8) "RTN","BIDUVLS2",25,0) ;S X=X_" "_$$DOBF^BIUTL1(BIDFN,,,1)_" "_$$SEX^BIUTL1(BIDFN) vvv83 "RTN","BIDUVLS2",26,0) S X=X_" "_$$DOBF^BIUTL1(BIDFN,$G(BIFDT),,1) "RTN","BIDUVLS2",27,0) S X=$$PAD^BIUTL5(X,54)_$$SEX^BIUTL1(BIDFN) "RTN","BIDUVLS2",28,0) S X=$$PAD^BIUTL5(X,58)_$E($$CURCOM^BIUTL11(BIDFN,1),1,21) "RTN","BIDUVLS2",29,0) D:'$G(BIDASH) WRITE(.BILINE) "RTN","BIDUVLS2",30,0) D WRITE(.BILINE,X) K X "RTN","BIDUVLS2",31,0) ;---> Preserve line number of Patient demographic line, for record "RTN","BIDUVLS2",32,0) ;---> line count and for address and phone lines below. "RTN","BIDUVLS2",33,0) S BIPLIN=BILINE-1,BIPLIN1=BILINE+1 "RTN","BIDUVLS2",34,0) ; "RTN","BIDUVLS2",35,0) ;---> Next section: Write specifed Additional Information in BINFO. "RTN","BIDUVLS2",36,0) ; "RTN","BIDUVLS2",37,0) ;--> Check if BINFO("ALL") exists. If so, set BIALL=1 and display all Info. "RTN","BIDUVLS2",38,0) N BIALL S BIALL=0 "RTN","BIDUVLS2",39,0) S:$D(BINFO("ALL")) BIALL=1 "RTN","BIDUVLS2",40,0) ; "RTN","BIDUVLS2",41,0) ;---> First, build Data String, BINFODS, of Add Info elements (2nd piece of "RTN","BIDUVLS2",42,0) ;---> BI TABLE ADD INFO File #9002084.82). "RTN","BIDUVLS2",43,0) N BINFODS "RTN","BIDUVLS2",44,0) D "RTN","BIDUVLS2",45,0) .N N S N=0 "RTN","BIDUVLS2",46,0) .F S N=$O(BINFO(N)) Q:'N D "RTN","BIDUVLS2",47,0) ..S BINFODS=$G(BINFODS)_$P($G(^BIADDIN(N,0)),U,2)_"^" "RTN","BIDUVLS2",48,0) .S:'$G(BINFODS) BINFODS=0 "RTN","BIDUVLS2",49,0) ; "RTN","BIDUVLS2",50,0) ;---> Forecast. "RTN","BIDUVLS2",51,0) D:((BINFODS[15)!BIALL) WRITE(.BILINE),FORECAST(.BILINE,BIDFN,$G(BIFDT)) "RTN","BIDUVLS2",52,0) ; "RTN","BIDUVLS2",53,0) ;---> Address. "RTN","BIDUVLS2",54,0) D:((BINFODS[12)!BIALL) "RTN","BIDUVLS2",55,0) .N X S X="Address..: "_$E($$STREET^BIUTL1(BIDFN),1,38) "RTN","BIDUVLS2",56,0) .S BIPLIN1=BIPLIN1+1 "RTN","BIDUVLS2",57,0) .D APPEND(BIPLIN1,X,.BILINE) "RTN","BIDUVLS2",58,0) .S X=" "_$$CTYSTZ^BIUTL1(BIDFN),BIPLIN1=BIPLIN1+1 "RTN","BIDUVLS2",59,0) .D APPEND(BIPLIN1,X,.BILINE) "RTN","BIDUVLS2",60,0) ; "RTN","BIDUVLS2",61,0) ;---> Phone Number. "RTN","BIDUVLS2",62,0) D:((BINFODS[11)!BIALL) "RTN","BIDUVLS2",63,0) .N X S X="Phone....: "_$$HPHONE^BIUTL1(BIDFN),BIPLIN1=BIPLIN1+1 "RTN","BIDUVLS2",64,0) .D APPEND(BIPLIN1,X,.BILINE) "RTN","BIDUVLS2",65,0) ; "RTN","BIDUVLS2",66,0) ;---> Parent/Guardian. "RTN","BIDUVLS2",67,0) D:((BINFODS[17)!BIALL) "RTN","BIDUVLS2",68,0) .N X S X="Parent...: "_$$PARENT^BIUTL1(BIDFN),BIPLIN1=BIPLIN1+1 "RTN","BIDUVLS2",69,0) .D APPEND(BIPLIN1,X,.BILINE) "RTN","BIDUVLS2",70,0) ; "RTN","BIDUVLS2",71,0) ;---> Case Manager. "RTN","BIDUVLS2",72,0) D:((BINFODS[18)!BIALL) "RTN","BIDUVLS2",73,0) .N X S X="Case Mgr.: "_$$CMGR^BIUTL1(BIDFN,1,1),BIPLIN1=BIPLIN1+1 "RTN","BIDUVLS2",74,0) .D APPEND(BIPLIN1,X,.BILINE) "RTN","BIDUVLS2",75,0) ; "RTN","BIDUVLS2",76,0) ;---> Reason Inactivated. "RTN","BIDUVLS2",77,0) D:((BINFODS[19)!BIALL) "RTN","BIDUVLS2",78,0) .Q:('$$INACT^BIUTL1(BIDFN)) "RTN","BIDUVLS2",79,0) .N X S X="Inactive.: "_$$INACTRE^BIUTL1(BIDFN),BIPLIN1=BIPLIN1+1 "RTN","BIDUVLS2",80,0) .D APPEND(BIPLIN1,X,.BILINE) "RTN","BIDUVLS2",81,0) ; "RTN","BIDUVLS2",82,0) ;---> Immunization History. "RTN","BIDUVLS2",83,0) I (BINFODS[13)!(BINFODS[14)!(BINFODS[20)!(BINFODS[22)!(BINFODS[25)!BIALL D "RTN","BIDUVLS2",84,0) .;---> Write either History or History w/Lot#'s, VFC, with or without Skin Tests. "RTN","BIDUVLS2",85,0) .N X D "RTN","BIDUVLS2",86,0) ..I (BINFODS[14)&(BINFODS'[25) S X=2 Q "RTN","BIDUVLS2",87,0) ..I (BINFODS'[14)&(BINFODS[25) S X=5 Q "RTN","BIDUVLS2",88,0) ..I (BINFODS[14)&(BINFODS[25) S X=7 Q "RTN","BIDUVLS2",89,0) ..S X=1 "RTN","BIDUVLS2",90,0) .; "RTN","BIDUVLS2",91,0) .;---> Include location where shot was given. "RTN","BIDUVLS2",92,0) .N Y S Y=$S(BINFODS[22:1,1:0) "RTN","BIDUVLS2",93,0) .N Z S Z=1 "RTN","BIDUVLS2",94,0) .D:(BINFODS[20) "RTN","BIDUVLS2",95,0) ..I ((BINFODS'[13)&(BINFODS'[14)&(BINFODS'[25)) S Z=2 Q "RTN","BIDUVLS2",96,0) ..S Z=0 "RTN","BIDUVLS2",97,0) .D WRITE(.BILINE),WRITE(.BILINE," History:") "RTN","BIDUVLS2",98,0) .D HISTORY1^BILETPR1(.BILINE,BIDFN,X,,"BIDULV",,,Z,Y,.BIMMRF,.BIMMLF) "RTN","BIDUVLS2",99,0) ; "RTN","BIDUVLS2",100,0) ; "RTN","BIDUVLS2",101,0) ;---> Refusals. "RTN","BIDUVLS2",102,0) D:((BINFODS[23)!BIALL) "RTN","BIDUVLS2",103,0) .N A,X1,X2,X3 S (X1,X2,X3)="" "RTN","BIDUVLS2",104,0) .D REFUSAL^BIUTL13(BIDFN,.A,1) "RTN","BIDUVLS2",105,0) .Q:('$D(A)) "RTN","BIDUVLS2",106,0) .D WRITE(.BILINE) "RTN","BIDUVLS2",107,0) .S X1=" Refusals: " "RTN","BIDUVLS2",108,0) .N N,M S N=0,M=0 "RTN","BIDUVLS2",109,0) .F S N=$O(A(N)) Q:'N D "RTN","BIDUVLS2",110,0) ..N X S M=M+1 "RTN","BIDUVLS2",111,0) ..S X=$$VNAME^BIUTL2($$HL7TX^BIUTL2(N))_" ("_$$SLDT2^BIUTL5($P(A(N),U,2),1)_")" "RTN","BIDUVLS2",112,0) ..S:"235689"[M X=", "_X "RTN","BIDUVLS2",113,0) ..I M<4 S X1=X1_X Q "RTN","BIDUVLS2",114,0) ..I M<7 S:M=4 X2=" ",X1=X1_"," S X2=X2_X Q "RTN","BIDUVLS2",115,0) ..S:M=7 X3=" ",X2=X2_"," S X3=X3_X Q "RTN","BIDUVLS2",116,0) .I X1]"" D WRITE(.BILINE,X1) "RTN","BIDUVLS2",117,0) .I X2]"" D WRITE(.BILINE,X2) "RTN","BIDUVLS2",118,0) .I X3]"" D WRITE(.BILINE,X3) "RTN","BIDUVLS2",119,0) ; "RTN","BIDUVLS2",120,0) ;---> Contraindications. "RTN","BIDUVLS2",121,0) D:((BINFODS[24)!BIALL) "RTN","BIDUVLS2",122,0) .N A,X1,X2,X3 S (X1,X2,X3)="" "RTN","BIDUVLS2",123,0) .D CONTRA^BIUTL11(BIDFN,.A,,1) "RTN","BIDUVLS2",124,0) .Q:('$D(A)) "RTN","BIDUVLS2",125,0) .D WRITE(.BILINE) "RTN","BIDUVLS2",126,0) .S X1=" Contraindications: " "RTN","BIDUVLS2",127,0) .N N,M S N=0,M=0 "RTN","BIDUVLS2",128,0) .F S N=$O(A(N)) Q:'N D "RTN","BIDUVLS2",129,0) ..N X S M=M+1 "RTN","BIDUVLS2",130,0) ..S X=$$VNAME^BIUTL2($$HL7TX^BIUTL2(N)) ;_" ("_$$SLDT2^BIUTL5($P(A(N),U,2),1)_")" "RTN","BIDUVLS2",131,0) ..S:"235689"[M X=", "_X "RTN","BIDUVLS2",132,0) ..I M<4 S X1=X1_X Q "RTN","BIDUVLS2",133,0) ..I M<7 S:M=4 X2=" ",X1=X1_"," S X2=X2_X Q "RTN","BIDUVLS2",134,0) ..S:M=7 X3=" ",X2=X2_"," S X3=X3_X Q "RTN","BIDUVLS2",135,0) .I X1]"" D WRITE(.BILINE,X1) "RTN","BIDUVLS2",136,0) .I X2]"" D WRITE(.BILINE,X2) "RTN","BIDUVLS2",137,0) .I X3]"" D WRITE(.BILINE,X3) "RTN","BIDUVLS2",138,0) ;---> Next Appointment. "RTN","BIDUVLS2",139,0) D:((BINFODS[21)!BIALL) "RTN","BIDUVLS2",140,0) .;---> Write either Patient's Next Appointment if there is one. "RTN","BIDUVLS2",141,0) .N X S X=$$NEXTAPPT^BIUTL11(BIDFN) "RTN","BIDUVLS2",142,0) .D:X]"" "RTN","BIDUVLS2",143,0) ..S X=" Next Appointment: "_$E(X,1,57) "RTN","BIDUVLS2",144,0) ..D WRITE(.BILINE),WRITE(.BILINE,X) "RTN","BIDUVLS2",145,0) ; "RTN","BIDUVLS2",146,0) ;---> Directions to House. "RTN","BIDUVLS2",147,0) D:((BINFODS[16)!BIALL) "RTN","BIDUVLS2",148,0) .Q:'$O(^AUPNPAT(BIDFN,12,0)) "RTN","BIDUVLS2",149,0) .D WRITE(.BILINE) "RTN","BIDUVLS2",150,0) .N X S X=" Directions to the home of "_$$NAME^BIUTL1(BIDFN,1)_":" "RTN","BIDUVLS2",151,0) .D WRITE(.BILINE,X) "RTN","BIDUVLS2",152,0) .N N S N=0 "RTN","BIDUVLS2",153,0) .F S N=$O(^AUPNPAT(BIDFN,12,N)) Q:'N D "RTN","BIDUVLS2",154,0) ..S X=$G(^AUPNPAT(BIDFN,12,N,0)) "RTN","BIDUVLS2",155,0) ..D WRITE(.BILINE," "_X) "RTN","BIDUVLS2",156,0) ; "RTN","BIDUVLS2",157,0) D:'$G(BIDASH) WRITE(.BILINE," "_$$SP^BIUTL5(73,"-")) "RTN","BIDUVLS2",158,0) ;---> Mark the top line of this record with the total lines in it. "RTN","BIDUVLS2",159,0) D MARK^BIW(BIPLIN,BILINE-BIPLIN,"BIDULV") "RTN","BIDUVLS2",160,0) Q "RTN","BIDUVLS2",161,0) ; "RTN","BIDUVLS2",162,0) ; "RTN","BIDUVLS2",163,0) ;---------- "RTN","BIDUVLS2",164,0) FORECAST(BILINE,BIDFN,BIFDT) ;EP "RTN","BIDUVLS2",165,0) ;---> Retrieve and store Imm Forecast in WP ^TMP global. "RTN","BIDUVLS2",166,0) ;---> Parameters: "RTN","BIDUVLS2",167,0) ; 2 - BILINE (ret) Last line written into ^TMP array. "RTN","BIDUVLS2",168,0) ; 3 - BIDFN (req) Patient's IEN in VA PATIENT File #2. "RTN","BIDUVLS2",169,0) ; 4 - BIFDT (opt) Forecast Date. "RTN","BIDUVLS2",170,0) ; "RTN","BIDUVLS2",171,0) Q:'$D(BILINE) Q:'$G(BIDFN) "RTN","BIDUVLS2",172,0) ; "RTN","BIDUVLS2",173,0) ;---> If Patient is deceased, display date instead of forecast. "RTN","BIDUVLS2",174,0) N X S X=$$DECEASED^BIUTL1(BIDFN,1) "RTN","BIDUVLS2",175,0) I X D WRITE(.BILINE),WRITE(.BILINE," DECEASED: "_$$TXDT^BIUTL5(X)) Q "RTN","BIDUVLS2",176,0) ; "RTN","BIDUVLS2",177,0) ;---> If Forecast Date not provided, set it equal to today. "RTN","BIDUVLS2",178,0) S:'$G(BIFDT) BIFDT=DT "RTN","BIDUVLS2",179,0) ; "RTN","BIDUVLS2",180,0) ;---> RPC to gather Immunization History. "RTN","BIDUVLS2",181,0) ; BIRETVAL - Return value of valid data from RPC. "RTN","BIDUVLS2",182,0) ; BIRETERR - Return value (text string) of error from RPC. "RTN","BIDUVLS2",183,0) ; "RTN","BIDUVLS2",184,0) N BIRETVAL,BIRETERR S BIRETVAL="" "RTN","BIDUVLS2",185,0) ;---> Next line: 4th param=1 to not call Immserve because forecast "RTN","BIDUVLS2",186,0) ;---> just got updated in retrieving patients: +225^BIDUR. "RTN","BIDUVLS2",187,0) ;V8.5 P31 - FID- Include '*HR*' high risk flag "RTN","BIDUVLS2",188,0) D IMMFORC^BIRPC(.BIRETVAL,BIDFN,BIFDT,1,,,1) "RTN","BIDUVLS2",189,0) ; "RTN","BIDUVLS2",190,0) ;---> If BIRETERR has a value, store it and quit. "RTN","BIDUVLS2",191,0) S BIRETERR=$P(BIRETVAL,BI31,2) "RTN","BIDUVLS2",192,0) I BIRETERR]"" D Q "RTN","BIDUVLS2",193,0) .D WRITE(.BILINE),WRITE(.BILINE," "_BIRETERR),WRITE(.BILINE) "RTN","BIDUVLS2",194,0) ; "RTN","BIDUVLS2",195,0) ;---> Set BIFDTORC=to the Immunization Forecast for this patient. "RTN","BIDUVLS2",196,0) N BIFDTORC,I,V S V="|",BIFDTORC=$P(BIRETVAL,BI31,1) "RTN","BIDUVLS2",197,0) ; "RTN","BIDUVLS2",198,0) ;---> Loop through "^"-pieces of Imm Forecast, getting data. "RTN","BIDUVLS2",199,0) F I=1:1 S Y=$P(BIFDTORC,U,I) Q:Y="" D "RTN","BIDUVLS2",200,0) .N X,Z S X=$S(I=1:" Needs: ",1:" ") "RTN","BIDUVLS2",201,0) .;---> If the forecast for this vaccine contains an error, "RTN","BIDUVLS2",202,0) .;---> write Vaccine Group Name Error, such as, $P("DTP ERROR:",":"). "RTN","BIDUVLS2",203,0) .S Z=$P(Y,V),Z=X_$P(Z,":") "RTN","BIDUVLS2",204,0) .D WRITE(.BILINE,Z) "RTN","BIDUVLS2",205,0) Q "RTN","BIDUVLS2",206,0) ; "RTN","BIDUVLS2",207,0) ; "RTN","BIDUVLS2",208,0) ;---------- "RTN","BIDUVLS2",209,0) WRITE(BILINE,BIVAL) ;EP "RTN","BIDUVLS2",210,0) ;---> Write a line to the ^TMP global for WP or Listman. "RTN","BIDUVLS2",211,0) ;---> Parameters: "RTN","BIDUVLS2",212,0) ; 1 - BILINE (ret) Last line# in the WP ^TMP global. "RTN","BIDUVLS2",213,0) ; 2 - BIVAL (opt) Value/text of line (Null=blank line). "RTN","BIDUVLS2",214,0) ; "RTN","BIDUVLS2",215,0) Q:'$D(BILINE) "RTN","BIDUVLS2",216,0) S:$G(BIVAL)="" BIVAL=" " "RTN","BIDUVLS2",217,0) S BILINE=BILINE+1,^TMP("BIDULV",$J,BILINE,0)=BIVAL "RTN","BIDUVLS2",218,0) Q "RTN","BIDUVLS2",219,0) ; "RTN","BIDUVLS2",220,0) ; "RTN","BIDUVLS2",221,0) ;---------- "RTN","BIDUVLS2",222,0) APPEND(BIPLIN1,BIVAL,BILINE) ;EP "RTN","BIDUVLS2",223,0) ;---> Append BIVAL to existing line or create new line. "RTN","BIDUVLS2",224,0) ;---> Parameters: "RTN","BIDUVLS2",225,0) ; 1 - BIPLIN1 (ret) Line down from demog line to be added to. "RTN","BIDUVLS2",226,0) ; 2 - BIVAL (opt) Value/text of line (Null=blank line). "RTN","BIDUVLS2",227,0) ; 3 - BILINE (ret) Last line# in the WP ^TMP global. "RTN","BIDUVLS2",228,0) ; "RTN","BIDUVLS2",229,0) Q:'$D(BILINE) "RTN","BIDUVLS2",230,0) Q:$G(BIVAL)="" "RTN","BIDUVLS2",231,0) ; "RTN","BIDUVLS2",232,0) ;---> If line already exists, append to it. "RTN","BIDUVLS2",233,0) N X "RTN","BIDUVLS2",234,0) I $D(^TMP("BIDULV",$J,BIPLIN1,0)) S X=^(0) D Q "RTN","BIDUVLS2",235,0) .S X=$$PAD^BIUTL5(X,32)_BIVAL "RTN","BIDUVLS2",236,0) .S ^TMP("BIDULV",$J,BIPLIN1,0)=X "RTN","BIDUVLS2",237,0) ; "RTN","BIDUVLS2",238,0) ;---> If line doesn't exist, create it. "RTN","BIDUVLS2",239,0) D WRITE(.BILINE,$$SP^BIUTL5(32)_BIVAL) "RTN","BIDUVLS2",240,0) Q "RTN","BIDX") 0^19^B112115456 "RTN","BIDX",1,0) BIDX ;IHS/CMI/MWR - RISK FOR FLU & PNEUMO, CHECK FOR DIAGNOSES.; MAY 10, 2010 ; 30 Jun 2025 3:48 PM "RTN","BIDX",2,0) ;;8.5;IMMUNIZATION;**22,25,26,31**;OCT 24,2011;Build 137 "RTN","BIDX",3,0) ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS * "RTN","BIDX",4,0) ;; CHECK FOR DIAGNOSES IN A TAXONOMY RANGE, WITHIN A GIVE DATE RANGE. "RTN","BIDX",5,0) ;; FROM LORI BUTCHER, 9-18-05 "RTN","BIDX",6,0) ;; PATCH 5: New code to check for Smoking Health Factors. HFSMKR+23 "RTN","BIDX",7,0) ;; PATCH 9: Changes to include Hep B Risk. RISK+9, RISK+41 "RTN","BIDX",8,0) ;; PATCH 13: Changes to check for Flu High Risk. RISK+25, HASDX+38 "RTN","BIDX",9,0) ;; PATCH 15: Changes to check for Flu High Risk (removed in p14). RISKAB+19 "RTN","BIDX",10,0) ;; PATCH 22: Changes to check for Immunocompromised. RISKC+0, UPDTC "RTN","BIDX",11,0) ;; PATCH 31: Add BIRPROF(BIVGO) variable for patient risk profile "RTN","BIDX",12,0) ;; to use for adding *HR* flag to forecast display "RTN","BIDX",13,0) ; "RTN","BIDX",14,0) ; "RTN","BIDX",15,0) ;********** PATCH 14, v8.5, AUG 01,2017, IHS/CMI/MWR "RTN","BIDX",16,0) ;---------- "RTN","BIDX",17,0) RISKP(BIDFN,BIFDT,BIAGE,BISMKR,BIRISKF) ;EP Return Pneumo High Risk. "RTN","BIDX",18,0) ;---> Determine if this patient is in the Pneumo Risk Taxonomy. "RTN","BIDX",19,0) ;---> Parameters: "RTN","BIDX",20,0) ; 1 - BIDFN (req) Patient IEN. "RTN","BIDX",21,0) ; 2 - BIFDT (opt) Forecast Date (date used for forecast). "RTN","BIDX",22,0) ; 3 - BIAGE (req) Patient Age in years for this Forecast Date. "RTN","BIDX",23,0) ; 4 - BISMKR (opt) 1=Include Smoking Factors. "RTN","BIDX",24,0) ; 5 - BIRISKF (ret) 1=Patient has Risk of Pneumo; otherwise 0. "RTN","BIDX",25,0) ; 6 - BINPLDC (opt) 1=don't check problem list dates, just check active or inactive "RTN","BIDX",26,0) ; "RTN","BIDX",27,0) S BIRISKF=0 "RTN","BIDX",28,0) Q:'$G(BIDFN) "RTN","BIDX",29,0) ;---> Quit if this Pt Age <5 yrs or >65 yrs, regardless of risk. "RTN","BIDX",30,0) Q:((BIAGE<5)!(BIAGE>64)) "RTN","BIDX",31,0) S:'$G(BIFDT) BIFDT=$G(DT) "RTN","BIDX",32,0) N BIBEGDT,Y S BIBEGDT=$$FMADD^XLFDT(BIFDT,-(3*365)) "RTN","BIDX",33,0) ; "RTN","BIDX",34,0) ;---> Check Pneumo Risk (2 Pneumo Dx's over 3-year range). "RTN","BIDX",35,0) ;GDIT/HS/BEE 06/24/22;BI*8.5*22;FEATURE#75583;Added subset reference "RTN","BIDX",36,0) ;ihs/cmi/lab - changed 2 dx to 1 per email 1/5/23 "RTN","BIDX",37,0) S Y=+$$HASDX(BIDFN,"BI HIGH RISK PNEUMO",1,BIBEGDT,BIFDT,"PXRM IMHR PNEUMO",1) "RTN","BIDX",38,0) I Y S BIRISKF=1,BIRPROF(11)=1 Q "RTN","BIDX",39,0) ; "RTN","BIDX",40,0) ;add immunocompromised check patch 26 ihs/cmi/lab "RTN","BIDX",41,0) ; "RTN","BIDX",42,0) S Y=+$$IMMUNPNU(BIDFN,BIFDT) "RTN","BIDX",43,0) I Y S BIRISKF=1,BIRPROF(11)=1 Q "RTN","BIDX",44,0) ;---> Quit if site parameter says don't include Smoking. "RTN","BIDX",45,0) Q:'$G(BISMKR) "RTN","BIDX",46,0) ;GDIT/HS/BEE 06/24/22;BI*8.5*22;FEATURE#75583;Added subset reference "RTN","BIDX",47,0) ;ihs/cmi/lab - changed 2 dx to 1 per email 1/5/23 "RTN","BIDX",48,0) S Y=+$$HASDX(BIDFN,"BI HIGH RISK PNEUMO W/SMOKING",1,BIBEGDT,BIFDT,"PXRM IMHR PNEUMO WITH SMOKING",1) "RTN","BIDX",49,0) I Y S BIRISKF=1,BIRPROF(11)=1 Q "RTN","BIDX",50,0) ; "RTN","BIDX",51,0) ;---> Check for Smoking Health Factor in the last 2 years. "RTN","BIDX",52,0) S BIRISKF=$$HFSMKR(BIDFN,BIFDT) "RTN","BIDX",53,0) I Y S BIRISKF=1,BIRPROF("SMOKE")=1 "RTN","BIDX",54,0) Q "RTN","BIDX",55,0) ; "RTN","BIDX",56,0) ;********** PATCH 22, v8.5, JAN 01,2022, IHS/CMI/MWR "RTN","BIDX",57,0) ;---> Return whether patient is considered to be immunocompromised "RTN","BIDX",58,0) ; "RTN","BIDX",59,0) RISKC(BIDFN,BIFDT,BIMD,BIRISKC) ;PEP - Return whether considered immunocompromised, 1=Yes, 0=No. "RTN","BIDX",60,0) ;Determine if this patient is considered to be immunocompromised. "RTN","BIDX",61,0) ;Parameters: "RTN","BIDX",62,0) ; 1 - BIDFN (req) Patient IEN. "RTN","BIDX",63,0) ; 2 - BIFDT (opt) Forecast Date (date used for forecast). "RTN","BIDX",64,0) ; 3 - BIMD (opt) Null=both Meds and Dx's, 1=Meds only, 2=Dx's only. "RTN","BIDX",65,0) ; 4 - BIRISKC (ret) 1=Patient is immunocompromised; otherwise 0. "RTN","BIDX",66,0) ; "RTN","BIDX",67,0) ;Input checking "RTN","BIDX",68,0) S BIRISKC=0 "RTN","BIDX",69,0) Q:'$G(BIDFN) "RTN","BIDX",70,0) S:'$G(BIFDT) BIFDT=$G(DT) "RTN","BIDX",71,0) S BIMD=$G(BIMD) I BIMD'="",BIMD'=1,BIMD'=2 Q "RTN","BIDX",72,0) ; "RTN","BIDX",73,0) NEW BIIBD,TXDIEN,TXRIEN,BIIDT,VPVIEN,ICD,SMD,IDRUG,RX,BIDFDT,BIIDFDT "RTN","BIDX",74,0) ; "RTN","BIDX",75,0) ;Check for daily ^XTMP("BI_RISKC") build - quit if couldn't check "RTN","BIDX",76,0) Q:$$UPDTC()=-1 "RTN","BIDX",77,0) ; "RTN","BIDX",78,0) ;Get drug look back date - 90 days "RTN","BIDX",79,0) S BIDFDT=$$FMADD^XLFDT(BIFDT,-90) "RTN","BIDX",80,0) S BIIDFDT=9999999-BIDFDT ;determine inverse date "RTN","BIDX",81,0) ; "RTN","BIDX",82,0) ;Get start date (back 1 year from forecast date) "RTN","BIDX",83,0) S $E(BIFDT,2,3)=$E(BIFDT,2,3)-1 S:$E(BIFDT,5,7)="229" $E(BIFDT,5,7)="228" "RTN","BIDX",84,0) S BIIBD=9999999-BIFDT ;determine inverse date "RTN","BIDX",85,0) ; "RTN","BIDX",86,0) ;Check ICD10/SNOMED in V POV "RTN","BIDX",87,0) I BIMD'=1 D I (BIMD=2)!(BIRISKC) Q "RTN","BIDX",88,0) . S BIIDT=0 F S BIIDT=$O(^AUPNVPOV("AA",BIDFN,BIIDT)) Q:(BIIDT="")!(BIIDT>BIIBD) D Q:BIRISKC "RTN","BIDX",89,0) .. S VPVIEN=0 F S VPVIEN=$O(^AUPNVPOV("AA",BIDFN,BIIDT,VPVIEN)) Q:'VPVIEN D Q:BIRISKC "RTN","BIDX",90,0) ... ; "RTN","BIDX",91,0) ... ;First look for ICD10 "RTN","BIDX",92,0) ... S ICD=$P($G(^AUPNVPOV(VPVIEN,0)),U) "RTN","BIDX",93,0) ... I ICD,$D(^XTMP("BI_RISKC","DXTAX",ICD)) S BIRISKC=1 Q "RTN","BIDX",94,0) ... ; "RTN","BIDX",95,0) ... ;Next look for SNOMED "RTN","BIDX",96,0) ... S SMD=$P($G(^AUPNVPOV(VPVIEN,11)),U) "RTN","BIDX",97,0) ... I SMD,$D(^XTMP("BI_RISKC","DXSUB",SMD)) S BIRISKC=1 "RTN","BIDX",98,0) ; "RTN","BIDX",99,0) ;Check medications "RTN","BIDX",100,0) I BIMD'=2 D "RTN","BIDX",101,0) . ; "RTN","BIDX",102,0) . ;Retrieve drug/RxNorm taxonomy IENs "RTN","BIDX",103,0) . S TXDIEN=$O(^ATXAX("B","ATX IMMUNOSUPPRESS DRUGS",0)) "RTN","BIDX",104,0) . S TXRIEN=$O(^ATXAX("B","ATX IMMUNOSUPPRESS RXNORM",0)) "RTN","BIDX",105,0) . ; "RTN","BIDX",106,0) . ;Check for drug/RxNorm in V MEDICATION "RTN","BIDX",107,0) . S BIIDT=0 F S BIIDT=$O(^AUPNVMED("AA",BIDFN,BIIDT)) Q:(BIIDT="")!(BIIDT>BIIDFDT) D Q:BIRISKC "RTN","BIDX",108,0) .. S VPVIEN=0 F S VPVIEN=$O(^AUPNVMED("AA",BIDFN,BIIDT,VPVIEN)) Q:'VPVIEN D Q:BIRISKC "RTN","BIDX",109,0) ... ; "RTN","BIDX",110,0) ... ;First look for drug IEN "RTN","BIDX",111,0) ... S IDRUG=$P($G(^AUPNVMED(VPVIEN,0)),U) Q:IDRUG="" "RTN","BIDX",112,0) ... I TXDIEN,$D(^ATXAX(TXDIEN,21,"B",IDRUG)) S BIRISKC=1 Q "RTN","BIDX",113,0) ... ; "RTN","BIDX",114,0) ... ;Next look for RxNorm "RTN","BIDX",115,0) ... S RX=$P($G(^PSDRUG(IDRUG,999999924)),U,4) "RTN","BIDX",116,0) ... I RX,TXRIEN,$D(^ATXAX(TXRIEN,21,"B",RX)) S BIRISKC=1 "RTN","BIDX",117,0) ; "RTN","BIDX",118,0) Q "RTN","BIDX",119,0) ; "RTN","BIDX",120,0) ;---------- "RTN","BIDX",121,0) RISKB(BIDFN,BIFDT,BIAGE,BIRISKF) ;EP Return Hep B High Risk. "RTN","BIDX",122,0) ;---> Determine if this patient is in the Hep B due to Diabetes Risk Taxonomy. "RTN","BIDX",123,0) ;---> Parameters: "RTN","BIDX",124,0) ; 1 - BIDFN (req) Patient IEN. "RTN","BIDX",125,0) ; 2 - BIFDT (opt) Forecast Date (date used for forecast). "RTN","BIDX",126,0) ; 3 - BIAGE (req) Patient Age in years for this Forecast Date. "RTN","BIDX",127,0) ; 4 - BIRISKF (ret) 1=Patient has Risk of Hep B due to Diabetes; otherwise 0. "RTN","BIDX",128,0) ; "RTN","BIDX",129,0) S BIRISKF=0 "RTN","BIDX",130,0) Q:'$G(BIDFN) "RTN","BIDX",131,0) S:'$G(BIFDT) BIFDT=$G(DT) "RTN","BIDX",132,0) N Y "RTN","BIDX",133,0) ; "RTN","BIDX",134,0) ;---> Check Hep B Risk (2 Diabetes Dx's from DOB to Forecast Date). "RTN","BIDX",135,0) Q:(BIAGE>59) "RTN","BIDX",136,0) N Y S Y=+$$V2DM(BIDFN,,BIFDT) "RTN","BIDX",137,0) I Y=1 S BIRISKF=1,BIRPROF(4)=1 "RTN","BIDX",138,0) Q "RTN","BIDX",139,0) ;---------- "RTN","BIDX",140,0) RISKAB(BIDFN,BIFDT,BIRISKF) ;EP Return Hep A & Hep B High Risk. "RTN","BIDX",141,0) ;---> Determine if this patient is in the CLD/HepC Risk Taxonomy. "RTN","BIDX",142,0) ;---> Parameters: "RTN","BIDX",143,0) ; 1 - BIDFN (req) Patient IEN. "RTN","BIDX",144,0) ; 2 - BIFDT (opt) Forecast Date (date used for forecast). "RTN","BIDX",145,0) ; 3 - BIRISKF (ret) 1=Patient has Risk of HepA&B; otherwise 0. "RTN","BIDX",146,0) ; "RTN","BIDX",147,0) S BIRISKF=0 "RTN","BIDX",148,0) Q:'$G(BIDFN) "RTN","BIDX",149,0) S:'$G(BIFDT) BIFDT=$G(DT) "RTN","BIDX",150,0) N BIBEGDT,Y,J S BIBEGDT=$$FMADD^XLFDT(BIFDT,-(3*365)) "RTN","BIDX",151,0) ; "RTN","BIDX",152,0) ;---> Check CLD/HepC Risk (1 CLD/HepC Dx's over 3-year range). "RTN","BIDX",153,0) ;GDIT/HS/BEE 06/24/22;BI*8.5*22;FEATURE#75583;Added subset reference "RTN","BIDX",154,0) S Y=+$$HASDX(BIDFN,"BI HIGH RISK HEPA/B, CLD/HEPC",1,BIBEGDT,BIFDT,"PXRM IMHR HEPA/B, CLD/HEPC") "RTN","BIDX",155,0) I Y=1 S BIRISKF=1 F J=9,12,14 S BIRPROF(J)=1 "RTN","BIDX",156,0) Q "RTN","BIDX",157,0) ; "RTN","BIDX",158,0) ; "RTN","BIDX",159,0) ;********** PATCH 15, v8.5, SEP 30,2017, IHS/CMI/MWR "RTN","BIDX",160,0) ;---> Return Flu High Risk Value. "RTN","BIDX",161,0) ;---------- "RTN","BIDX",162,0) RISKF(BIDFN,BIFDT,BIRISKF) ;EP Return Flu High Risk. "RTN","BIDX",163,0) ;---> Determine if this patient is in the Flu High Risk Taxonomy. "RTN","BIDX",164,0) ;---> Generally patients passed are >18 yrs and <50 yrs. "RTN","BIDX",165,0) ;---> Parameters: "RTN","BIDX",166,0) ; 1 - BIDFN (req) Patient IEN. "RTN","BIDX",167,0) ; 2 - BIFDT (opt) Forecast Date (date used for forecast). "RTN","BIDX",168,0) ; 3 - BIRISKF (ret) 1=Patient has Risk of Influenza; otherwise 0. "RTN","BIDX",169,0) ; "RTN","BIDX",170,0) ;---> Check Flu Risk Taxonomy(2 Dx's within 3 yrs prior to the date passed). "RTN","BIDX",171,0) S BIRISKF=0 "RTN","BIDX",172,0) Q:'$G(BIDFN) "RTN","BIDX",173,0) S:'$G(BIFDT) BIFDT=$G(DT) "RTN","BIDX",174,0) N BIBEGDT,Y,J S BIBEGDT=$$FMADD^XLFDT(BIFDT,-(3*365)) "RTN","BIDX",175,0) ;GDIT/HS/BEE 06/24/22;BI*8.5*22;FEATURE#75583;Added subset reference "RTN","BIDX",176,0) S Y=+$$HASDX(BIDFN,"BI HIGH RISK FLU",2,BIBEGDT,BIFDT,"PXRM IMHR FLU") "RTN","BIDX",177,0) I Y S BIRISKF=1 F J=10,18 S BIRPROF(J)=1 "RTN","BIDX",178,0) Q "RTN","BIDX",179,0) ;********** "RTN","BIDX",180,0) IMMUNPNU(BIDFN,BIFDT) ;EP - Return whether considered immunocompromised, 1=Yes, 0=No. "RTN","BIDX",181,0) ;IHS/CMI/LAB - copied RISKC, removed med check, added problem list check for active problem, changed to 3 year look back for pneumo "RTN","BIDX",182,0) ;Determine if this patient is considered to be immunocompromised. "RTN","BIDX",183,0) ;Parameters: "RTN","BIDX",184,0) ; 1 - BIDFN (req) Patient IEN. "RTN","BIDX",185,0) ; 2 - BIFDT (opt) Forecast Date (date used for forecast). "RTN","BIDX",186,0) ; 4 - BIRISKC (ret) 1=Patient is immunocompromised; otherwise 0. "RTN","BIDX",187,0) ; "RTN","BIDX",188,0) ;Input checking "RTN","BIDX",189,0) S BIRISKC=0 "RTN","BIDX",190,0) I '$G(BIDFN) Q 0 "RTN","BIDX",191,0) S:'$G(BIFDT) BIFDT=$G(DT) "RTN","BIDX",192,0) ; "RTN","BIDX",193,0) NEW BIIBD,TXDIEN,TXRIEN,BIIDT,VPVIEN,ICD,SMD,IDRUG,RX,BIDFDT,BIIDFDT,PRIEN "RTN","BIDX",194,0) ; "RTN","BIDX",195,0) ;Check for daily ^XTMP("BI_RISKC") build - quit if couldn't check "RTN","BIDX",196,0) I $$UPDTC()=-1 Q 0 "RTN","BIDX",197,0) ; "RTN","BIDX",198,0) ;Get start date (back 3 years from forecast date) "RTN","BIDX",199,0) S $E(BIFDT,2,3)=$E(BIFDT,2,3)-3 S:$E(BIFDT,5,7)="229" $E(BIFDT,5,7)="228" "RTN","BIDX",200,0) S BIIBD=9999999-BIFDT ;determine inverse date "RTN","BIDX",201,0) ; "RTN","BIDX",202,0) ;Check ICD10/SNOMED in V POV "RTN","BIDX",203,0) S BIIDT=0 F S BIIDT=$O(^AUPNVPOV("AA",BIDFN,BIIDT)) Q:(BIIDT="")!(BIIDT>BIIBD)!(BIRISKC) D "RTN","BIDX",204,0) . S VPVIEN=0 F S VPVIEN=$O(^AUPNVPOV("AA",BIDFN,BIIDT,VPVIEN)) Q:'VPVIEN!(BIRISKC) D "RTN","BIDX",205,0) .. ; "RTN","BIDX",206,0) .. ;First look for ICD10 "RTN","BIDX",207,0) .. S ICD=$P($G(^AUPNVPOV(VPVIEN,0)),U) "RTN","BIDX",208,0) .. I ICD,$D(^XTMP("BI_RISKC","DXTAX",ICD)) S BIRISKC=1 Q "RTN","BIDX",209,0) .. ; "RTN","BIDX",210,0) .. ;Next look for SNOMED "RTN","BIDX",211,0) .. S SMD=$P($G(^AUPNVPOV(VPVIEN,11)),U) "RTN","BIDX",212,0) .. I SMD,$D(^XTMP("BI_RISKC","DXSUB",SMD)) S BIRISKC=1 "RTN","BIDX",213,0) ; "RTN","BIDX",214,0) I BIRISKC Q BIRISKC "RTN","BIDX",215,0) ;NOW CHECK PROBLEM LIST "RTN","BIDX",216,0) S PRIEN=0 F S PRIEN=$O(^AUPNPROB("AC",BIDFN,PRIEN)) Q:PRIEN'=+PRIEN!(BIRISKC) D "RTN","BIDX",217,0) .Q:'$D(^AUPNPROB(PRIEN,0)) ;no zero node "RTN","BIDX",218,0) .Q:$P(^AUPNPROB(PRIEN,0),U,12)="" "RTN","BIDX",219,0) .Q:"ID"[$P(^AUPNPROB(PRIEN,0),U,12) ;no deleted or inactive "RTN","BIDX",220,0) .I $P($G(^AUPNPROB(PRIEN,2)),U,2)]"" Q "RTN","BIDX",221,0) .;Look for ICD "RTN","BIDX",222,0) .S ICD=$P($G(^AUPNPROB(PRIEN,0)),U) "RTN","BIDX",223,0) .I ICD,$D(^XTMP("BI_RISKC","DXTAX",ICD)) S BIRISKC=1 Q "RTN","BIDX",224,0) .;now SNOMED "RTN","BIDX",225,0) .S SMD=$P($G(^AUPNPROB(PRIEN,800)),U) "RTN","BIDX",226,0) .I SMD,$D(^XTMP("BI_RISKC","DXSUB",SMD)) S BIRISKC=1 "RTN","BIDX",227,0) .Q "RTN","BIDX",228,0) Q BIRISKC "RTN","BIDX",229,0) ;---------- "RTN","BIDX",230,0) ;GDIT/HS/BEE 06/24/22;BI*8.5*22;FEATURE#75583;Added subset reference and moved to new routine "RTN","BIDX",231,0) HASDX(BIDFN,BITAX,BINUM,BIBD,BIED,BISUBSET,BINPLDC) ;EP "RTN","BIDX",232,0) ; "RTN","BIDX",233,0) Q $$HASDX^BIDX1(BIDFN,$G(BITAX),$G(BINUM),$G(BIBD),$G(BIED),$G(BISUBSET),$G(BINPLDC)) "RTN","BIDX",234,0) ; "RTN","BIDX",235,0) ;---------- "RTN","BIDX",236,0) HFSMKR(BIDFN,BIFDT) ;EP "RTN","BIDX",237,0) ;---> Return 1 if Patient has Last Health Factor in the TOBACCO category "RTN","BIDX",238,0) ;---> with a date of <2 years. "RTN","BIDX",239,0) ;---> Parameters: "RTN","BIDX",240,0) ; 1 - BIDFN (req) Patient's IEN (DFN). "RTN","BIDX",241,0) ; 2 - BIFDT (req) Forecast Date (date used for forecast). "RTN","BIDX",242,0) ; "RTN","BIDX",243,0) ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR "RTN","BIDX",244,0) ;---> New code to check for Smoking Health Factors. "RTN","BIDX",245,0) ; "RTN","BIDX",246,0) ;---> Return 0 if routine APCLAPIU is not in the namespace. "RTN","BIDX",247,0) ;---> APCLAPIU is from ;;2.0;IHS PCC SUITE;**2,6**;MAY 14, 2009. "RTN","BIDX",248,0) Q:('$L($T(^APCLAPIU))) 0 "RTN","BIDX",249,0) Q:'$G(BIDFN) 0 "RTN","BIDX",250,0) S:'$G(BIFDT) BIFDT=$G(DT) "RTN","BIDX",251,0) ; "RTN","BIDX",252,0) N Y S Y=$$LASTHF^APCLAPIU(BIDFN,"TOBACCO (SMOKING)",$$FMADD^XLFDT(BIFDT,-730),BIFDT) "RTN","BIDX",253,0) ;---> If there's a hit it looks like this: "RTN","BIDX",254,0) ;---> 3110815^HF: CURRENT SMOKER, SOME DAY^^2580^9000010.23^2, otherwise null. "RTN","BIDX",255,0) ;---> So, if there's a leading date, then patient has an HF "TOBACCO (SMOKING)" Category. "RTN","BIDX",256,0) ;---> Looking for these Health Factors: "RTN","BIDX",257,0) ; "RTN","BIDX",258,0) Q:(Y["CURRENT SMOKER, STATUS UNKNOWN") 1 "RTN","BIDX",259,0) Q:(Y["CURRENT SMOKER, EVERY DAY") 1 "RTN","BIDX",260,0) Q:(Y["CURRENT SMOKER, SOME DAY") 1 "RTN","BIDX",261,0) Q:(Y["CESSATION-SMOKER") 1 "RTN","BIDX",262,0) Q:(Y["HEAVY TOBACCO SMOKER") 1 "RTN","BIDX",263,0) Q:(Y["LIGHT TOBACCO SMOKER") 1 "RTN","BIDX",264,0) ; "RTN","BIDX",265,0) ;---> Patient does NOT have a SMOKER Health Factor 2 years prior to the Forecast Date. "RTN","BIDX",266,0) Q 0 "RTN","BIDX",267,0) ;********** "RTN","BIDX",268,0) ; "RTN","BIDX",269,0) ; "RTN","BIDX",270,0) ;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR "RTN","BIDX",271,0) ;---> New code from Lori Butcher to check for Diabetes (rtn: CIMZDMCK). "RTN","BIDX",272,0) V2DM(P,BDATE,EDATE) ;EP - are there 2 visits with DM? "RTN","BIDX",273,0) ;P is Patient DFN "RTN","BIDX",274,0) ;BDATE - beginning date to look default is DOB "RTN","BIDX",275,0) ;EDATE - end date to look default is DT "RTN","BIDX",276,0) ; "RTN","BIDX",277,0) ;GDIT/HS/BEE 06/24/22;BI*8.5*22;FEATURE#75583;Moved to new routine "RTN","BIDX",278,0) Q +$$V2DM^BIDX1(BIDFN,,BIFDT) "RTN","BIDX",279,0) ; "RTN","BIDX",280,0) I '$G(P) Q "" "RTN","BIDX",281,0) I '$D(^AUPNVSIT("AC",P)) Q "" ;patient has no visits "RTN","BIDX",282,0) I '$G(BDATE) S BDATE=$$DOB^AUPNPAT(P) "RTN","BIDX",283,0) I '$G(EDATE) S EDATE=DT "RTN","BIDX",284,0) NEW T,BIREF,PDA,PIEN,CDX,VST,VDT,IBDATE,IEDATE,V,G ;IHS/CMI/LAB/maw - modified and added lines to speed up the process "RTN","BIDX",285,0) ;K ^TMP($J,"A") "RTN","BIDX",286,0) ;S A="^TMP($J,""A"",",B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(B,A) "RTN","BIDX",287,0) ;I '$D(^TMP($J,"A",1)) Q "" ;no visits returned "RTN","BIDX",288,0) S T=$O(^ATXAX("B","SURVEILLANCE DIABETES",0)) "RTN","BIDX",289,0) I 'T Q "" "RTN","BIDX",290,0) ;IHS/CMI/LAB - added lines below for icd10 "RTN","BIDX",291,0) ;MWRZZZ COMMENT OUT NEXT LINE, ADD ONE AFTER. "RTN","BIDX",292,0) ;I $D(^ICDS(0)) D "RTN","BIDX",293,0) I $D(^ICDS(0)),$T(^ATXAPI)]"" D "RTN","BIDX",294,0) .K ^TMP($J,"BITAX") ;IHS/CMI/LAB - clean out old nodes just in case "RTN","BIDX",295,0) .S BIREF=$NA(^TMP($J,"BITAX")) ;IHS/CMI/LAB "RTN","BIDX",296,0) .D BLDTAX^ATXAPI("SURVEILLANCE DIABETES",BIREF,T) "RTN","BIDX",297,0) S IBDATE=9999999-BDATE "RTN","BIDX",298,0) S IEDATE=9999999-EDATE "RTN","BIDX",299,0) S G=0 "RTN","BIDX",300,0) K V "RTN","BIDX",301,0) S PDA=IEDATE-1 F S PDA=$O(^AUPNVPOV("AA",P,PDA)) Q:'PDA!(PDA>IBDATE)!(G>1) D "RTN","BIDX",302,0) . S PIEN=0 F S PIEN=$O(^AUPNVPOV("AA",P,PDA,PIEN)) Q:'PIEN D "RTN","BIDX",303,0) .. S CDX=$P($G(^AUPNVPOV(PIEN,0)),U) "RTN","BIDX",304,0) .. Q:'CDX "RTN","BIDX",305,0) .. I $D(^TMP($J,"BITAX")) Q:'$D(^TMP($J,"BITAX",CDX)) "RTN","BIDX",306,0) .. I '$D(^TMP($J,"BITAX")) Q:'$$ICD^ATXCHK(CDX,T,9) "RTN","BIDX",307,0) .. S VST=$P($G(^AUPNVPOV(PIEN,0)),U,3) "RTN","BIDX",308,0) .. Q:'VST ;HAPPENS "RTN","BIDX",309,0) .. Q:'$D(^AUPNVSIT(VST,0)) "RTN","BIDX",310,0) .. Q:"SAHOR"'[$P(^AUPNVSIT(VST,0),U,7) ;ELIMINATE TELEPHONE CALLS, CHART REVIEWS, ETC "RTN","BIDX",311,0) .. I '$D(V(VST)) S V(VST)="",G=G+1 "RTN","BIDX",312,0) K ^TMP($J,"BITAX") "RTN","BIDX",313,0) ;Q 1 ;for testing a positive hit on Diabetes. "RTN","BIDX",314,0) Q $S(G<2:"",1:1) "RTN","BIDX",315,0) ;********** "RTN","BIDX",316,0) ; "RTN","BIDX",317,0) ;---------- "RTN","BIDX",318,0) TEST ; "RTN","BIDX",319,0) ;D ^%T "RTN","BIDX",320,0) ;S P=0 F S P=$O(^AUPNPAT(P)) Q:P'=+P S X=$$HASDX(P,"BI HIGH RISK PNEUMO",2,3020101,DT) W ".",X "RTN","BIDX",321,0) ;S P=0 F S P=$O(^AUPNPAT(P)) Q:P'=+P S X=$$V2DM(P,,) I X S ^LORIHAS(P)="" W ".",P "RTN","BIDX",322,0) ;D ^%T "RTN","BIDX",323,0) ;Q "RTN","BIDX",324,0) ; "RTN","BIDX",325,0) ; "RTN","BIDX",326,0) UPDTC() ;Build the RISKC DX related taxonomies and subsets "RTN","BIDX",327,0) ; "RTN","BIDX",328,0) ;Lock the entry - current update in progress "RTN","BIDX",329,0) L +^XTMP("BI_RISKC"):10 E Q -1 "RTN","BIDX",330,0) ; "RTN","BIDX",331,0) ;See if already processed for day "RTN","BIDX",332,0) I $G(^XTMP("BI_RISKC","COMP"))'
BIIBD)!(COUNT'BIED Q ;Entry date is after ending date "RTN","BIDX1",72,0) .; "RTN","BIDX1",73,0) C1 .;Update counter "RTN","BIDX1",74,0) .S COUNT=COUNT+1 "RTN","BIDX1",75,0) ; "RTN","BIDX1",76,0) I COUNTIBDATE)!(COUNT>1) D "RTN","BIDX1",183,0) .S PIEN=0 F S PIEN=$O(^AUPNVPOV("AA",BIDFN,PDA,PIEN)) Q:'PIEN D "RTN","BIDX1",184,0) ..; "RTN","BIDX1",185,0) ..;Look in V POV for ICD or SNOMED "RTN","BIDX1",186,0) ..S BIFOUND=$$VPOV(PIEN,"SURVEILLANCE DIABETES","PXRM IMHR SURVEIL DIABETES",.BIPRBLST) Q:'BIFOUND "RTN","BIDX1",187,0) ..; "RTN","BIDX1",188,0) ..;Get the VIEN "RTN","BIDX1",189,0) ..S VST=$$GET1^DIQ(9000010.07,PIEN_",",.03,"I") Q:'VST "RTN","BIDX1",190,0) ..; "RTN","BIDX1",191,0) ..;ELIMINATE TELEPHONE CALLS, CHART REVIEWS, ETC "RTN","BIDX1",192,0) ..Q:(",S,A,H,O,R,"'[(","_$P($G(^AUPNVSIT(VST,0)),U,7)_",")) "RTN","BIDX1",193,0) ..; "RTN","BIDX1",194,0) ..;Only count visits once "RTN","BIDX1",195,0) ..Q:$D(VLIST(VST)) "RTN","BIDX1",196,0) ..; "RTN","BIDX1",197,0) ..;Log visit and increment counter "RTN","BIDX1",198,0) ..S VLIST(VST)="",COUNT=COUNT+1 "RTN","BIDX1",199,0) ; "RTN","BIDX1",200,0) ;Loop through PROBLEM file entries for patient "RTN","BIDX1",201,0) I COUNT<2 S BIPIEN=0 F S BIPIEN=$O(^AUPNPROB("AC",BIDFN,BIPIEN)) Q:BIPIEN="" D Q:(COUNT'<2) "RTN","BIDX1",202,0) .; "RTN","BIDX1",203,0) .;Look in taxonomy and subset "RTN","BIDX1",204,0) .S BIFOUND=$$PROB(BIPIEN,"SURVEILLANCE DIABETES","PXRM IMHR SURVEIL DIABETES",.BIPRBLST) Q:'BIFOUND "RTN","BIDX1",205,0) .; "RTN","BIDX1",206,0) .;Check against problem date "RTN","BIDX1",207,0) .S EDT=$$PRBDT(BIPIEN) Q:'EDT "RTN","BIDX1",208,0) .I EDTEDATE Q ;Entry date is after ending date "RTN","BIDX1",210,0) .; "RTN","BIDX1",211,0) .;Update counter "RTN","BIDX1",212,0) .S COUNT=COUNT+1 "RTN","BIDX1",213,0) ; "RTN","BIDX1",214,0) Q $S(COUNT<2:"",1:1) "RTN","BIDX1",215,0) ; "RTN","BIDX1",216,0) VPOV(VPIEN,BITAX,BISUBSET,BIPRBLST) ;Look in V POV for ICD in taxonomy or SNOMED in subset "RTN","BIDX1",217,0) ; "RTN","BIDX1",218,0) ;Return whether ICD in taxonomy or SNOMED in subset "RTN","BIDX1",219,0) ; "RTN","BIDX1",220,0) ;Input "RTN","BIDX1",221,0) ; VPIEN - V POV IEN "RTN","BIDX1",222,0) ; BITAX - Taxonomy (multiples separated by ";") "RTN","BIDX1",223,0) ; BISUBSET - SNOMED subset name (multiples separated by ";") "RTN","BIDX1",224,0) ; BIPRBLST - PROBLEM file IEN list (gets updated) "RTN","BIDX1",225,0) ; "RTN","BIDX1",226,0) ;Output - Found entry (1)/Not found (0) "RTN","BIDX1",227,0) ; "RTN","BIDX1",228,0) I +$G(VPIEN)=0 Q 0 "RTN","BIDX1",229,0) ; "RTN","BIDX1",230,0) NEW NODE0,IPL,SMD,BIFOUND,TXSB,VISIT,ICD "RTN","BIDX1",231,0) ; "RTN","BIDX1",232,0) ;Pull node into local "RTN","BIDX1",233,0) S NODE0=$G(^AUPNVPOV(VPIEN,0)) "RTN","BIDX1",234,0) ; "RTN","BIDX1",235,0) S BIFOUND=0 "RTN","BIDX1",236,0) ; "RTN","BIDX1",237,0) ;Get the problem list entry "RTN","BIDX1",238,0) S IPL=$P(NODE0,U,16) "RTN","BIDX1",239,0) ; "RTN","BIDX1",240,0) ;Next look for SNOMED "RTN","BIDX1",241,0) S SMD=$P($G(^AUPNVPOV(VPIEN,11)),U) "RTN","BIDX1",242,0) I SMD D Q:BIFOUND BIFOUND "RTN","BIDX1",243,0) . F TXSB=1:1:$L(BISUBSET,";") I $D(^XTMP("BI_TERMS","DXSUB",$P(BISUBSET,";",TXSB),SMD)) D Q:BIFOUND "RTN","BIDX1",244,0) .. ; "RTN","BIDX1",245,0) .. ;An IPL entry could generate multiple V POV entries for a visit - only count as 1 "RTN","BIDX1",246,0) .. S VISIT=$P($G(^AUPNVPOV(VPIEN,0)),U,3) "RTN","BIDX1",247,0) .. I VISIT,IPL,$D(BIPRBLST("V",IPL,VISIT)) Q "RTN","BIDX1",248,0) .. ; "RTN","BIDX1",249,0) .. ;New entry found "RTN","BIDX1",250,0) .. S BIFOUND=1 "RTN","BIDX1",251,0) .. ; "RTN","BIDX1",252,0) .. ;Log for duplicate checking "RTN","BIDX1",253,0) .. I IPL]"" D "RTN","BIDX1",254,0) ... I VISIT S BIPRBLST("V",IPL,VISIT)="" "RTN","BIDX1",255,0) ... S BIPRBLST("P",IPL)="" "RTN","BIDX1",256,0) ; "RTN","BIDX1",257,0) ;Then look for ICD9/ICD10 "RTN","BIDX1",258,0) S ICD=$P(NODE0,U) "RTN","BIDX1",259,0) I ICD D Q:BIFOUND BIFOUND "RTN","BIDX1",260,0) . F TXSB=1:1:$L(BITAX,";") I $D(^XTMP("BI_TERMS","DXTAX",$P(BITAX,";",TXSB),ICD)) D Q:BIFOUND "RTN","BIDX1",261,0) .. S BIFOUND=1 "RTN","BIDX1",262,0) .. S:IPL]"" BIPRBLST("P",IPL)="" ;Saved so only count 1 per IPL entry/Visit "RTN","BIDX1",263,0) .. S BIPRBLST("I",ICD)="" ;Saved for checking on VPOV/IPL through PCC "RTN","BIDX1",264,0) ; "RTN","BIDX1",265,0) Q BIFOUND "RTN","BIDX1",266,0) ; "RTN","BIDX1",267,0) UPDT(TAX) ;Build the requested taxonomies and subsets "RTN","BIDX1",268,0) ; "RTN","BIDX1",269,0) ;If not passed in, default to "BI_TAX" "RTN","BIDX1",270,0) I $G(TAX)="" S TAX="TERMS" "RTN","BIDX1",271,0) ; "RTN","BIDX1",272,0) I '$D(^ICDS(0)) Q -1 "RTN","BIDX1",273,0) I $T(^ATXAPI)="" Q -1 "RTN","BIDX1",274,0) ; "RTN","BIDX1",275,0) ;Lock the entry - current update in progress "RTN","BIDX1",276,0) L +^XTMP("BI"_TAX):10 E Q -1 "RTN","BIDX1",277,0) ; "RTN","BIDX1",278,0) NEW BITXTI,BITXIEN,BITEXT,BITAX,BITYPE,BIREF,BITREF "RTN","BIDX1",279,0) NEW BISUBI,BISUB,BISBIEN,BICONC,BISCNT,STAX,TTAX "RTN","BIDX1",280,0) ; "RTN","BIDX1",281,0) ;Define reference "RTN","BIDX1",282,0) S BITREF="BI_"_TAX "RTN","BIDX1",283,0) ; "RTN","BIDX1",284,0) ;See if already processed for day "RTN","BIDX1",285,0) I $G(^XTMP(BITREF,"COMP"))'
49) G RZOUT "RTN","BIDX2",24,0) ; "RTN","BIDX2",25,0) NEW BIIBD,TXDIEN,TXRIEN,BIIDT,VPVIEN,ICD,SMD,IDRUG,RX,BIIDFDT "RTN","BIDX2",26,0) ; "RTN","BIDX2",27,0) ;Check for daily ^XTMP("BI_RISKC") build - quit if couldn't check "RTN","BIDX2",28,0) I $$UPDTC^BIDX()=-1 G RZOUT "RTN","BIDX2",29,0) ; "RTN","BIDX2",30,0) ;Get drug look back date - 90 days "RTN","BIDX2",31,0) S BIDFDT=$$FMADD^XLFDT(BIFDT,-90) "RTN","BIDX2",32,0) S BIIDFDT=9999999-BIDFDT ;determine inverse date "RTN","BIDX2",33,0) ; "RTN","BIDX2",34,0) ;Get start date (back 3 year from forecast date) "RTN","BIDX2",35,0) S $E(BIFDT,2,3)=$E(BIFDT,2,3)-3 "RTN","BIDX2",36,0) S:$E(BIFDT,5,7)="229" $E(BIFDT,5,7)="228" "RTN","BIDX2",37,0) S BIIBD=9999999-BIFDT ;determine inverse date "RTN","BIDX2",38,0) ; "RTN","BIDX2",39,0) ;Check ICD10/SNOMED in V POV "RTN","BIDX2",40,0) S BIIDT=0 "RTN","BIDX2",41,0) F S BIIDT=$O(^AUPNVPOV("AA",BIDFN,BIIDT)) Q:(BIIDT="")!(BIIDT>BIIBD)!BIRISKF D "RTN","BIDX2",42,0) .S VPVIEN=0 "RTN","BIDX2",43,0) .F S VPVIEN=$O(^AUPNVPOV("AA",BIDFN,BIIDT,VPVIEN)) Q:'VPVIEN!BIRISKF D "RTN","BIDX2",44,0) ..; "RTN","BIDX2",45,0) ..;First look for ICD10 "RTN","BIDX2",46,0) ..S ICD=$P($G(^AUPNVPOV(VPVIEN,0)),U) "RTN","BIDX2",47,0) ..I ICD,$D(^XTMP("BI_RISKC","DXTAX",ICD)) D Q "RTN","BIDX2",48,0) ...S BIRISKF=1,BIRPROF(+$$BIRPROF^BIPATUP3(187))=1 Q "RTN","BIDX2",49,0) ..; "RTN","BIDX2",50,0) ..;Next look for SNOMED "RTN","BIDX2",51,0) ..S SMD=$P($G(^AUPNVPOV(VPVIEN,11)),U) "RTN","BIDX2",52,0) ..I SMD,$D(^XTMP("BI_RISKC","DXSUB",SMD)) D "RTN","BIDX2",53,0) ...S BIRISKF=1,BIRPROF(+$$BIRPROF^BIPATUP3(187))=1 "RTN","BIDX2",54,0) ; "RTN","BIDX2",55,0) I BIRISKF G RZOUT "RTN","BIDX2",56,0) ; "RTN","BIDX2",57,0) ;NOW CHECK PROBLEM LIST "RTN","BIDX2",58,0) S PRIEN=0 "RTN","BIDX2",59,0) F S PRIEN=$O(^AUPNPROB("AC",BIDFN,PRIEN)) Q:PRIEN'=+PRIEN!BIRISKF D "RTN","BIDX2",60,0) .Q:'$D(^AUPNPROB(PRIEN,0)) ;no zero node "RTN","BIDX2",61,0) .Q:$P(^AUPNPROB(PRIEN,0),U,12)="" "RTN","BIDX2",62,0) .Q:"ID"[$P(^AUPNPROB(PRIEN,0),U,12) ;no deleted or inactive "RTN","BIDX2",63,0) .I $P($G(^AUPNPROB(PRIEN,2)),U,2)]"" Q "RTN","BIDX2",64,0) .;Look for ICD "RTN","BIDX2",65,0) .S ICD=$P($G(^AUPNPROB(PRIEN,0)),U) "RTN","BIDX2",66,0) .I ICD,$D(^XTMP("BI_RISKC","DXTAX",ICD)) D Q "RTN","BIDX2",67,0) ..S BIRISKF=1,BIRPROF(+$$BIRPROF^BIPATUP3(187))=1 "RTN","BIDX2",68,0) .;now SNOMED "RTN","BIDX2",69,0) .S SMD=$P($G(^AUPNPROB(PRIEN,800)),U) "RTN","BIDX2",70,0) .I SMD,$D(^XTMP("BI_RISKC","DXSUB",SMD)) D "RTN","BIDX2",71,0) ..S BIRISKF=1,BIRPROF(+$$BIRPROF^BIPATUP3(187))=1 "RTN","BIDX2",72,0) I BIRISKF G RZOUT "RTN","BIDX2",73,0) ; "RTN","BIDX2",74,0) ;Check medications "RTN","BIDX2",75,0) ;Retrieve drug/RxNorm taxonomy IENs "RTN","BIDX2",76,0) S TXDIEN=$O(^ATXAX("B","BI RZV IMMUNOSUPPRESS DRUGS",0)) "RTN","BIDX2",77,0) S TXRIEN=$O(^ATXAX("B","BI RZV IMMUNOSUPPRESS RXNORM",0)) "RTN","BIDX2",78,0) ; "RTN","BIDX2",79,0) ;Check for drug/RxNorm in V MEDICATION "RTN","BIDX2",80,0) S BIIDT=0 "RTN","BIDX2",81,0) F S BIIDT=$O(^AUPNVMED("AA",BIDFN,BIIDT)) Q:(BIIDT="")!(BIIDT>BIIDFDT)!BIRISKF D "RTN","BIDX2",82,0) .S VPVIEN=0 "RTN","BIDX2",83,0) .F S VPVIEN=$O(^AUPNVMED("AA",BIDFN,BIIDT,VPVIEN)) Q:'VPVIEN!BIRISKF D "RTN","BIDX2",84,0) ..;First look for drug IEN "RTN","BIDX2",85,0) ..S IDRUG=$P($G(^AUPNVMED(VPVIEN,0)),U) Q:IDRUG="" "RTN","BIDX2",86,0) ..I TXDIEN,$D(^ATXAX(TXDIEN,21,"B",IDRUG)) D Q "RTN","BIDX2",87,0) ...S BIRISKF=1,BIRPROF(+$$BIRPROF^BIPATUP3(187))=1 "RTN","BIDX2",88,0) ..; "RTN","BIDX2",89,0) ..;Next look for RxNorm "RTN","BIDX2",90,0) ..S RX=$P($G(^PSDRUG(IDRUG,999999924)),U,4) "RTN","BIDX2",91,0) ..I RX,TXRIEN,$D(^ATXAX(TXRIEN,21,"B",RX)) D "RTN","BIDX2",92,0) ...S BIRISKF=1,BIRPROF(+$$BIRPROF^BIPATUP3(187))=1 "RTN","BIDX2",93,0) ; "RTN","BIDX2",94,0) RZOUT Q "RTN","BIDX2",95,0) ;===== "RTN","BIDX2",96,0) ; "RTN","BIDX2",97,0) IMMUNRZV(BIDFN,BIFDT) ;EP - Return whether considered immunocompromised, 1=Yes, 0=No. "RTN","BIDX2",98,0) ;Determine if this patient is considered to be immunocompromised. "RTN","BIDX2",99,0) ;Parameters: "RTN","BIDX2",100,0) ; 1 - BIDFN (req) Patient IEN. "RTN","BIDX2",101,0) ; 2 - BIFDT (opt) Forecast Date (date used for forecast). "RTN","BIDX2",102,0) ; 4 - BIRISKF (ret) 1=Patient is immunocompromised; otherwise 0. "RTN","BIDX2",103,0) ; "RTN","BIDX2",104,0) ;Input checking "RTN","BIDX2",105,0) S BIRISKF=0 "RTN","BIDX2",106,0) I '$G(BIDFN) Q 0 "RTN","BIDX2",107,0) S:'$G(BIFDT) BIFDT=$G(DT) "RTN","BIDX2",108,0) ; "RTN","BIDX2",109,0) NEW BIIBD,TXDIEN,TXRIEN,BIIDT,VPVIEN,ICD,SMD,IDRUG,RX,BIDFDT,BIIDFDT,PRIEN "RTN","BIDX2",110,0) ; "RTN","BIDX2",111,0) ;Check for daily ^XTMP("BI_RISKC") build - quit if couldn't check "RTN","BIDX2",112,0) I $$UPDTC^BIDX()=-1 Q 0 "RTN","BIDX2",113,0) ; "RTN","BIDX2",114,0) ;Get start date (back 3 years from forecast date) "RTN","BIDX2",115,0) S $E(BIFDT,2,3)=$E(BIFDT,2,3)-3 "RTN","BIDX2",116,0) S:$E(BIFDT,5,7)="229" $E(BIFDT,5,7)="228" "RTN","BIDX2",117,0) S BIIBD=9999999-BIFDT ;determine inverse date "RTN","BIDX2",118,0) ; "RTN","BIDX2",119,0) ;Check ICD10/SNOMED in V POV "RTN","BIDX2",120,0) S BIIDT=0 "RTN","BIDX2",121,0) F S BIIDT=$O(^AUPNVPOV("AA",BIDFN,BIIDT)) Q:(BIIDT="")!(BIIDT>BIIBD)!BIRISKF D "RTN","BIDX2",122,0) .S VPVIEN=0 "RTN","BIDX2",123,0) .F S VPVIEN=$O(^AUPNVPOV("AA",BIDFN,BIIDT,VPVIEN)) Q:'VPVIEN!BIRISKF D "RTN","BIDX2",124,0) ..; "RTN","BIDX2",125,0) ..;First look for ICD10 "RTN","BIDX2",126,0) ..S ICD=$P($G(^AUPNVPOV(VPVIEN,0)),U) "RTN","BIDX2",127,0) ..I ICD,$D(^XTMP("BI_RISKC","DXTAX",ICD)) D Q "RTN","BIDX2",128,0) ...S BIRISKF=1,BIRPROF(+$$BIRPROF^BIPATUP3(187))=1 "RTN","BIDX2",129,0) ..; "RTN","BIDX2",130,0) ..;Next look for SNOMED "RTN","BIDX2",131,0) ..S SMD=$P($G(^AUPNVPOV(VPVIEN,11)),U) "RTN","BIDX2",132,0) ..I SMD,$D(^XTMP("BI_RISKC","DXSUB",SMD)) D "RTN","BIDX2",133,0) ...S BIRISKF=1,BIRPROF(+$$BIRPROF^BIPATUP3(187))=1 "RTN","BIDX2",134,0) ; "RTN","BIDX2",135,0) I BIRISKF Q BIRISKF "RTN","BIDX2",136,0) ;NOW CHECK PROBLEM LIST "RTN","BIDX2",137,0) S PRIEN=0 "RTN","BIDX2",138,0) F S PRIEN=$O(^AUPNPROB("AC",BIDFN,PRIEN)) Q:PRIEN'=+PRIEN!BIRISKF D "RTN","BIDX2",139,0) .Q:'$D(^AUPNPROB(PRIEN,0)) ;no zero node "RTN","BIDX2",140,0) .Q:$P(^AUPNPROB(PRIEN,0),U,12)="" "RTN","BIDX2",141,0) .Q:"ID"[$P(^AUPNPROB(PRIEN,0),U,12) ;no deleted or inactive "RTN","BIDX2",142,0) .I $P($G(^AUPNPROB(PRIEN,2)),U,2)]"" Q "RTN","BIDX2",143,0) .;Look for ICD "RTN","BIDX2",144,0) .S ICD=$P($G(^AUPNPROB(PRIEN,0)),U) "RTN","BIDX2",145,0) .I ICD,$D(^XTMP("BI_RISKC","DXTAX",ICD)) D Q "RTN","BIDX2",146,0) ..S BIRISKF=1,BIRPROF(+$$BIRPROF^BIPATUP3(187))=1 "RTN","BIDX2",147,0) .;now SNOMED "RTN","BIDX2",148,0) .S SMD=$P($G(^AUPNPROB(PRIEN,800)),U) "RTN","BIDX2",149,0) .I SMD,$D(^XTMP("BI_RISKC","DXSUB",SMD)) D "RTN","BIDX2",150,0) ..S BIRISKF=1,BIRPROF(+$$BIRPROF^BIPATUP3(187))=1 "RTN","BIDX2",151,0) Q BIRISKF "RTN","BIDX2",152,0) ;===== "RTN","BIDX2",153,0) ; "RTN","BIDX2",154,0) RZVFLU(BIDFN) ;EP;SET BIFLU ARRAY FOR RZV VACCS "RTN","BIDX2",155,0) N X,Y,Z,I0,D,CVX "RTN","BIDX2",156,0) S BIFLU="" "RTN","BIDX2",157,0) S X=0 "RTN","BIDX2",158,0) F S X=$O(^AUPNVIMM("AC",BIDFN,X)) Q:'X S I0=$G(^AUPNVIMM(X,0)) D:I0 "RTN","BIDX2",159,0) .S Y=+I0 "RTN","BIDX2",160,0) .S V=+$P(I0,U,3) "RTN","BIDX2",161,0) .Q:'Y!'V "RTN","BIDX2",162,0) .S D=$P($P($G(^AUPNVSIT(V,0)),U),".") "RTN","BIDX2",163,0) .S CVX=+$P($G(^AUTTIMM(Y,0)),U,3) "RTN","BIDX2",164,0) .Q:'CVX!'D "RTN","BIDX2",165,0) .S:$D(^BIVARR("ZOS",CVX)) BIFLU(CVX,9999999-D)="" "RTN","BIDX2",166,0) Q "RTN","BIDX2",167,0) ;===== "RTN","BIDX2",168,0) ; "RTN","BIENVCHK") 0^^B26120946 "RTN","BIENVCHK",1,0) BIENVCHK ;IHS/CMI/MWR - ENVIRONMENTAL CHECK FOR KIDS; ; 10 Jun 2025 12:10 AM "RTN","BIENVCHK",2,0) ;;8.5;IMMUNIZATION;**27,28,29,30,31**;OCT 24,2011;Build 137 "RTN","BIENVCHK",3,0) ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS * "RTN","BIENVCHK",4,0) ;; ENVIRONMENTAL CHECK ROUTINE FOR KIDS INSTALLATION. "RTN","BIENVCHK",5,0) ;; PATCH 26: Check environment for Imm v8.5 Patch 26. "RTN","BIENVCHK",6,0) ; "RTN","BIENVCHK",7,0) ; "RTN","BIENVCHK",8,0) ;---------- "RTN","BIENVCHK",9,0) START ;EP "RTN","BIENVCHK",10,0) ; "RTN","BIENVCHK",11,0) F X="XP01","XPZ1","XPZ2","XPI1" S XPDDIQ(X)=0 "RTN","BIENVCHK",12,0) ; "RTN","BIENVCHK",13,0) I '$G(DUZ) W !,"DUZ UNDEFINED OR 0." D SORRY(2) Q "RTN","BIENVCHK",14,0) ; "RTN","BIENVCHK",15,0) I '$L($G(DUZ(0))) W !,"DUZ(0) UNDEFINED OR NULL." D SORRY(2) Q "RTN","BIENVCHK",16,0) ; "RTN","BIENVCHK",17,0) N X,Z "RTN","BIENVCHK",18,0) S X=$P(^VA(200,DUZ,0),U) "RTN","BIENVCHK",19,0) W !!,$$CJ^XLFSTR("Hello, "_$P(X,",",2)_" "_$P(X,","),IOM) "RTN","BIENVCHK",20,0) S X="Checking Environment for the installation of "_$P($T(+2),";",4)_" v"_$P($T(+2),";",3) "RTN","BIENVCHK",21,0) S Z=$P($P($T(+2),";",5),"**",2) "RTN","BIENVCHK",22,0) S:Z X=X_", Patch "_Z_"." "RTN","BIENVCHK",23,0) W !!,$$CJ^XLFSTR(X,IOM),! "RTN","BIENVCHK",24,0) ; "RTN","BIENVCHK",25,0) N BIQUIT S BIQUIT=0,XPDQUIT=0 "RTN","BIENVCHK",26,0) ; "RTN","BIENVCHK",27,0) ;---> REQUIREMENTS "RTN","BIENVCHK",28,0) ; "RTN","BIENVCHK",29,0) ;---> Kernel v8.0 patch 1018 (XU*8.0*1018) or later. "RTN","BIENVCHK",30,0) D CHECK("KERNEL","XU","8.0",1018,.BIQUIT) "RTN","BIENVCHK",31,0) ; "RTN","BIENVCHK",32,0) ;---> VA FileMan v22.0 patch 1018 (DI*22.0*1018) or later. "RTN","BIENVCHK",33,0) D CHECK("VA FILEMAN","DI","22.0",1018,.BIQUIT) "RTN","BIENVCHK",34,0) ;; "RTN","BIENVCHK",35,0) ;********** PATCH 21, v8.5, APR 01,2021, IHS/CMI/MWR "RTN","BIENVCHK",36,0) ;---> Per Brian Everett, DTS: "RTN","BIENVCHK",37,0) ;---> IHS STANDARD TERMINOLOGY (BSTS) v2.0 patch 1. "RTN","BIENVCHK",38,0) ;D CHECK("IHS STANDARD TERMINOLOGY","BSTS","2.0",1,.BIQUIT) "RTN","BIENVCHK",39,0) ; "RTN","BIENVCHK",40,0) ;********** PATCH 27, v8.5, AUG 01,2022, ihs/cmi/maw "RTN","BIENVCHK",41,0) ;---> Immunization v8.5 patch 24 (BI*8.5*24) or later. "RTN","BIENVCHK",42,0) ;D CHECK("IMMUNIZATION","BI","8.5",27,.BIQUIT) "RTN","BIENVCHK",43,0) ; "RTN","BIENVCHK",44,0) ;********** PATCH 28, v8.5, AUG 01,2022, ihs/cmi/maw "RTN","BIENVCHK",45,0) ;---> Immunization v8.5 patch 24 (BI*8.5*24) or later. "RTN","BIENVCHK",46,0) D CHECK("IMMUNIZATION","BI","8.5",30,.BIQUIT) "RTN","BIENVCHK",47,0) ; "RTN","BIENVCHK",48,0) ; "RTN","BIENVCHK",49,0) ;I '$$VCHK("AUT","98.1",2) S BIQUIT=2 "RTN","BIENVCHK",50,0) ;S X=$$LAST("IHS DICTIONARIES (POINTERS)","98.1") "RTN","BIENVCHK",51,0) ; "RTN","BIENVCHK",52,0) ;---> XB/ZIB v3.0 patch 11. "RTN","BIENVCHK",53,0) ;I '$$VCHK("XB","3.0",2) S BIQUIT=2 "RTN","BIENVCHK",54,0) ;S X=$$LAST("IHS/VA UTILITIES","3.0") "RTN","BIENVCHK",55,0) ; "RTN","BIENVCHK",56,0) ;---> IHS PCC REPORTS v3.0 patch 29. "RTN","BIENVCHK",57,0) ;I '$$VCHK("APCL","3.0",2) S BIQUIT=2 "RTN","BIENVCHK",58,0) ;S X=$$LAST("IHS PCC REPORTS","3.0") "RTN","BIENVCHK",59,0) ; "RTN","BIENVCHK",60,0) ;---> PCC Suite v2.0 patch 2. "RTN","BIENVCHK",61,0) ;I '$$VCHK("BJPC","2.0",2) S BIQUIT=2 "RTN","BIENVCHK",62,0) ;S X=$$LAST("IHS PCC SUITE","2.0") "RTN","BIENVCHK",63,0) ; "RTN","BIENVCHK",64,0) ;---> IHS Clinical Reporting System v9.0 patch 1. "RTN","BIENVCHK",65,0) ;I '$$VCHK("BGP","9.0",2) S BIQUIT=2 "RTN","BIENVCHK",66,0) ;S X=$$LAST("IHS CLINICAL REPORTING","9.0") "RTN","BIENVCHK",67,0) ; "RTN","BIENVCHK",68,0) ;---> Check environment for previous load of Taxonomy v5.1. "RTN","BIENVCHK",69,0) ;I '$$VCHK("ATX","5.1",2) S BIQUIT=2 "RTN","BIENVCHK",70,0) ;.S X=$$LAST("TAXONOMY","5.1") "RTN","BIENVCHK",71,0) ; "RTN","BIENVCHK",72,0) ; "RTN","BIENVCHK",73,0) ;---> Check for multiple BI entries in the Package File. "RTN","BIENVCHK",74,0) N DA,DIC "RTN","BIENVCHK",75,0) S X="BI",DIC="^DIC(9.4,",DIC(0)="",D="C" "RTN","BIENVCHK",76,0) D IX^DIC "RTN","BIENVCHK",77,0) I Y<0,$D(^DIC(9.4,"C","BI")) D S BIQUIT=2 "RTN","BIENVCHK",78,0) .W !!,$$CJ^XLFSTR("You Have More Than One Entry In The",IOM) "RTN","BIENVCHK",79,0) .W !,$$CJ^XLFSTR("PACKAGE File with a ""BI"" prefix.",IOM) "RTN","BIENVCHK",80,0) .W !,$$CJ^XLFSTR("One entry needs to be deleted.",IOM) "RTN","BIENVCHK",81,0) .W !,$$CJ^XLFSTR("Please do this before Proceeding.",IOM),!! "RTN","BIENVCHK",82,0) .Q "RTN","BIENVCHK",83,0) ; "RTN","BIENVCHK",84,0) ;---> Do not allow KIDS installation to be queued (at DEVICE: prompt). "RTN","BIENVCHK",85,0) S XPDNOQUE=1 "RTN","BIENVCHK",86,0) ;---> Do not ask "DISABLE Options...etc.?" question. "RTN","BIENVCHK",87,0) S XPDDIQ("XPZ1")=0 "RTN","BIENVCHK",88,0) ;---> Do not ask "MOVE routines to other CPUs?" question. "RTN","BIENVCHK",89,0) S XPDDIQ("XPZ2")=0 "RTN","BIENVCHK",90,0) ; "RTN","BIENVCHK",91,0) I BIQUIT D SORRY(BIQUIT) Q "RTN","BIENVCHK",92,0) ; "RTN","BIENVCHK",93,0) W !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM) "RTN","BIENVCHK",94,0) ; "RTN","BIENVCHK",95,0) ;I '$$DIR^XBDIR("E","","","","","",1) D SORRY(2) Q "RTN","BIENVCHK",96,0) Q "RTN","BIENVCHK",97,0) ; "RTN","BIENVCHK",98,0) ; "RTN","BIENVCHK",99,0) ;---------- "RTN","BIENVCHK",100,0) CHECK(BIPKG,BIPRE,BIVER,BIPAT,BIQUIT) ;EP Check the version and patch level of this package. "RTN","BIENVCHK",101,0) ;---> Parameters: "RTN","BIENVCHK",102,0) ; 1 - BIPKG (req) Package in the PACKAGE File. "RTN","BIENVCHK",103,0) ; 2 - BIPRE (req) Package Prefix in the PACKAGE File. "RTN","BIENVCHK",104,0) ; 3 - BIVER (req) Package Version in the PACKAGE File. "RTN","BIENVCHK",105,0) ; 4 - BIPAT (req) Package Last Patch in the PACKAGE File. "RTN","BIENVCHK",106,0) ; 5 - BIQUIT (ret) Package Last Patch in the PACKAGE File. "RTN","BIENVCHK",107,0) ; "RTN","BIENVCHK",108,0) I ($G(BIPKG)="")!($G(BIPRE)="")!($G(BIVER)="")!($G(BIPAT)="") D Q "RTN","BIENVCHK",109,0) .W !!,"Package parameters missing, check routine BIENVCHK!" "RTN","BIENVCHK",110,0) .W $$DIR^XBDIR("E","Press RETURN") "RTN","BIENVCHK",111,0) .S BIQUIT=2 "RTN","BIENVCHK",112,0) ; "RTN","BIENVCHK",113,0) N BIQUIT1 S BIQUIT1=0 "RTN","BIENVCHK",114,0) ; "RTN","BIENVCHK",115,0) ;---> Check Package version. "RTN","BIENVCHK",116,0) I '$$VCHK(BIPRE,BIVER,2) S BIQUIT1=2 "RTN","BIENVCHK",117,0) ; "RTN","BIENVCHK",118,0) ;---> Check Package patch level. "RTN","BIENVCHK",119,0) ; "RTN","BIENVCHK",120,0) ;********************* "RTN","BIENVCHK",121,0) ;---> Just for patch 20. "RTN","BIENVCHK",122,0) ;I $$VER^BILOGO'="8.5*20" S BIPAT=1 "RTN","BIENVCHK",123,0) ; "RTN","BIENVCHK",124,0) ;********************* "RTN","BIENVCHK",125,0) D "RTN","BIENVCHK",126,0) .S X=$$LAST(BIPKG,BIVER) "RTN","BIENVCHK",127,0) .; "RTN","BIENVCHK",128,0) .;---> Special check for BI, since mix of patches (20+ and 1000+). "RTN","BIENVCHK",129,0) .I BIPKG="IMMUNIZATION",($P($$VER^BILOGO,"*",2) All other packages. "RTN","BIENVCHK",133,0) .I ($P(X,U)'=BIPAT)&($P(X,U)'>BIPAT) D S BIQUIT1=2 Q "RTN","BIENVCHK",134,0) ..W !,$$CJ^XLFSTR(BIPKG_" v"_BIVER_" patch "_BIPAT_" is NOT INSTALLED!",IOM),! "RTN","BIENVCHK",135,0) .; "RTN","BIENVCHK",136,0) .W !,$$CJ^XLFSTR(BIPKG_" v"_BIVER_" patch "_BIPAT_"... Patch "_BIPAT_" is present.",IOM),! "RTN","BIENVCHK",137,0) ; "RTN","BIENVCHK",138,0) I BIQUIT1 S BIQUIT=BIQUIT1 "RTN","BIENVCHK",139,0) Q "RTN","BIENVCHK",140,0) ; "RTN","BIENVCHK",141,0) ; "RTN","BIENVCHK",142,0) SORRY(X) ; "RTN","BIENVCHK",143,0) K DIFQ S XPDQUIT=X "RTN","BIENVCHK",144,0) D:'$D(ZTQUEUED) "RTN","BIENVCHK",145,0) .W !!,$$CJ^XLFSTR("Sorry, the installation has been discontinued.",IOM) "RTN","BIENVCHK",146,0) .W !,$$CJ^XLFSTR("No changes have been made.",IOM),! "RTN","BIENVCHK",147,0) .W $$DIR^XBDIR("E","Press RETURN") "RTN","BIENVCHK",148,0) Q "RTN","BIENVCHK",149,0) ; "RTN","BIENVCHK",150,0) VCHK(ABMPRE,ABMVER,ABMQUIT) ; Check versions needed. "RTN","BIENVCHK",151,0) ; "RTN","BIENVCHK",152,0) NEW ABMV "RTN","BIENVCHK",153,0) S ABMV=$$VERSION^XPDUTL(ABMPRE) "RTN","BIENVCHK",154,0) I ABMV="" S ABMV=0 "RTN","BIENVCHK",155,0) W !,$$CJ^XLFSTR("Need at least "_ABMPRE_" v"_ABMVER_"... "_ABMPRE_" v"_ABMV_" is present",IOM) "RTN","BIENVCHK",156,0) I ABMV0 D "RTN","BIENVCHK",167,0) . I $P(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN,0),U,2)>LATEST S LATEST=$P(^(0),U,2),PATCH=$P(^(0),U) "RTN","BIENVCHK",168,0) . I $P(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN,0),U,2)=LATEST,$P(^(0),U)>PATCH S PATCH=$P(^(0),U) "RTN","BIENVCHK",169,0) Q PATCH_U_LATEST "RTN","BILETPR1") 0^32^B118200211 "RTN","BILETPR1",1,0) BILETPR1 ;IHS/CMI/MWR - PRINT PATIENT LETTERS.; ; 03 Aug 2025 8:54 PM "RTN","BILETPR1",2,0) ;;8.5;IMMUNIZATION;**24,25,27,31**;OCT 24,2011;Build 137 "RTN","BILETPR1",3,0) ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS * "RTN","BILETPR1",4,0) ;; BUILD ^TMP WP ARRAY FOR PRINTING LETTERS. "RTN","BILETPR1",5,0) ;; PATCH 10: If no skin tests on record, display explicitly. HISTORY1+190 "RTN","BILETPR1",6,0) ;; Display only the most recent three dates of Skin Tests. HISTORY1+209 "RTN","BILETPR1",7,0) ;; PATCH 14: Remove "NOS" from forecasted vaccines in letters. FORECAST+41 "RTN","BILETPR1",8,0) ;; PATCH 24: Add code for display filter. HISTORY1+83 "RTN","BILETPR1",9,0) ; "RTN","BILETPR1",10,0) ; "RTN","BILETPR1",11,0) ;---------- "RTN","BILETPR1",12,0) BUILD(BIDFN,BILET,BIDLOC,BIFDT) ;EP "RTN","BILETPR1",13,0) ;---> Build temporary global of populated letter in ^TMP("BILET",$J). "RTN","BILETPR1",14,0) ;---> Parameters: "RTN","BILETPR1",15,0) ; 1 - BIDFN (req) Patient's IEN in VA PATIENT File #2. "RTN","BILETPR1",16,0) ; 2 - BILET (req) IEN of Letter in BI LETTER File. "RTN","BILETPR1",17,0) ; 3 - BIDLOC (opt) Text of Date/Location line. "RTN","BILETPR1",18,0) ; 4 - BIFDT (opt) Forecast Date. "RTN","BILETPR1",19,0) ; "RTN","BILETPR1",20,0) K ^TMP("BILET",$J) "RTN","BILETPR1",21,0) N BILINE,BI31 S BILINE=0,BI31=$C(31)_$C(31) "RTN","BILETPR1",22,0) ; "RTN","BILETPR1",23,0) ;---> Error check. "RTN","BILETPR1",24,0) N BIERR S BIERR="" "RTN","BILETPR1",25,0) D I BIERR]"" D WRITE(.BILINE,BIERR) Q "RTN","BILETPR1",26,0) .I '$G(BIDFN) D ERRCD^BIUTL2(201,.BIERR) Q "RTN","BILETPR1",27,0) .I '$D(^DPT(BIDFN,0)) D ERRCD^BIUTL2(203,.BIERR) Q "RTN","BILETPR1",28,0) .I '$G(BILET) D ERRCD^BIUTL2(609,.BIERR) Q "RTN","BILETPR1",29,0) .I '$D(^BILET(BILET,0)) D ERRCD^BIUTL2(610,.BIERR) Q "RTN","BILETPR1",30,0) .S:'$G(BIFDT) BIFDT=DT "RTN","BILETPR1",31,0) ; "RTN","BILETPR1",32,0) ;---> Get forecast string (BIFORCST) and problem dose string (BIPDSS). "RTN","BILETPR1",33,0) ;---> Pass BIPDSS to HISTORY to mark problem doses with asterisks. "RTN","BILETPR1",34,0) ;---> Pass BIFORCST to FORECAST for display. "RTN","BILETPR1",35,0) ;V8.5 P31 - FID- Include '*HR*' high risk flag "RTN","BILETPR1",36,0) N BIFORCST,BIPDSS S BIPDSS="" "RTN","BILETPR1",37,0) D IMMFORC^BIRPC(.BIFORCST,BIDFN,BIFDT,,$G(BIDUZ2),.BIPDSS,1) "RTN","BILETPR1",38,0) ;---> If Forecast comes first, set BIFF=1 "RTN","BILETPR1",39,0) ;V8.5 PATCH 27 - FID- "RTN","BILETPR1",40,0) N BIFF S BIFF=$P(^BILET(BILET,0),U,6) "RTN","BILETPR1",41,0) N BIDL S BIDL=$P(^BILET(BILET,0),U,7) "RTN","BILETPR1",42,0) S:'BIDL BIDL=2 "RTN","BILETPR1",43,0) ; "RTN","BILETPR1",44,0) ;---> Retrieve and store sections of letter in WP ^TMP global. "RTN","BILETPR1",45,0) D SECTION(BILET,.BILINE,1) "RTN","BILETPR1",46,0) D "RTN","BILETPR1",47,0) .I BIFF D FORECAST(BILET,.BILINE,BIFORCST,BIFDT) Q "RTN","BILETPR1",48,0) .D:BIDL=2 HISTORY(BILET,.BILINE,BIDFN,BIPDSS) "RTN","BILETPR1",49,0) D SECTION(BILET,.BILINE,2) "RTN","BILETPR1",50,0) D "RTN","BILETPR1",51,0) .I BIFF D:BIDL=2 HISTORY(BILET,.BILINE,BIDFN,BIPDSS) Q "RTN","BILETPR1",52,0) .D FORECAST(BILET,.BILINE,BIFORCST,BIFDT) "RTN","BILETPR1",53,0) D SECTION(BILET,.BILINE,3) "RTN","BILETPR1",54,0) D DATELOC(BILET,.BILINE,BIDLOC) "RTN","BILETPR1",55,0) D SECTION(BILET,.BILINE,4) "RTN","BILETPR1",56,0) Q "RTN","BILETPR1",57,0) ; "RTN","BILETPR1",58,0) ; "RTN","BILETPR1",59,0) ;---------- "RTN","BILETPR1",60,0) SECTION(BILET,BILINE,BISEC) ;EP "RTN","BILETPR1",61,0) ;---> Store Section of letter in ^TMP("BILET",$J). "RTN","BILETPR1",62,0) ;---> Parameters: "RTN","BILETPR1",63,0) ; 1 - BILET (req) IEN of Letter in BI LETTER File. "RTN","BILETPR1",64,0) ; 2 - BILINE (ret) Last line written into ^TMP array. "RTN","BILETPR1",65,0) ; 3 - BISEC (req) Section of Form Letter to retrieve. "RTN","BILETPR1",66,0) ; "RTN","BILETPR1",67,0) N N,T S N=0 "RTN","BILETPR1",68,0) F S N=$O(^BILET(BILET,BISEC,N)) Q:'N D "RTN","BILETPR1",69,0) .;if this is street 2, it is blank and there is nothing before or after it, skip the line "RTN","BILETPR1",70,0) .S T=$G(^BILET(BILET,BISEC,N,0)) "RTN","BILETPR1",71,0) .I T["|BI MAILING ADD-STREET 2|" NEW %,Q,F,S,X S Q=0 D Q:Q "RTN","BILETPR1",72,0) ..S %=$O(^DD("FUNC","B","BI MAILING ADD-STREET 2",0)) "RTN","BILETPR1",73,0) ..Q:'% "RTN","BILETPR1",74,0) ..S X=$G(^DD("FUNC",%,1)) "RTN","BILETPR1",75,0) ..Q:X="" "RTN","BILETPR1",76,0) ..X X "RTN","BILETPR1",77,0) ..I X]"" Q ;has address so keep going "RTN","BILETPR1",78,0) ..;is there anyting before or after other than spaces or blanks "RTN","BILETPR1",79,0) ..S F=$P(T,"|BI MAILING ADD-STREET 2|",1) "RTN","BILETPR1",80,0) ..I $$HD(F) Q ;has other than space/null "RTN","BILETPR1",81,0) ..S F=$P(T,"|BI MAILING ADD-STREET 2|",2) "RTN","BILETPR1",82,0) ..I $$HD(F) Q ;has other than space/null "RTN","BILETPR1",83,0) ..S Q=1 "RTN","BILETPR1",84,0) .D WRITE(.BILINE,^BILET(BILET,BISEC,N,0)) "RTN","BILETPR1",85,0) Q "RTN","BILETPR1",86,0) HD(Z) ;is there any character besides spaces? "RTN","BILETPR1",87,0) NEW L,%,G "RTN","BILETPR1",88,0) I $G(Z)="" Q 0 "RTN","BILETPR1",89,0) S L=$L(Z) "RTN","BILETPR1",90,0) I L=0 Q 0 "RTN","BILETPR1",91,0) S G=0 "RTN","BILETPR1",92,0) F %=1:1:L I $E(Z,%)'=" " S G=1 "RTN","BILETPR1",93,0) Q G "RTN","BILETPR1",94,0) ; "RTN","BILETPR1",95,0) ; "RTN","BILETPR1",96,0) HISTORY(BILET,BILINE,BIDFN,BIPDSS) ;EP "RTN","BILETPR1",97,0) ;---> Retrieve and store Imm History in WP ^TMP global. "RTN","BILETPR1",98,0) ;---> Parameters: "RTN","BILETPR1",99,0) ; 1 - BILET (req) IEN of Letter in BI LETTER File. "RTN","BILETPR1",100,0) ; 2 - BILINE (ret) Last line written into ^TMP array. "RTN","BILETPR1",101,0) ; 3 - BIDFN (req) Patient's IEN in VA PATIENT File #2. "RTN","BILETPR1",102,0) ; 4 - BIPDSS (opt) Returned string of Visit IEN's that are Problem Doses, "RTN","BILETPR1",103,0) ; "RTN","BILETPR1",104,0) ;---> Quit if this Form Letter does not included Imm History. "RTN","BILETPR1",105,0) N BIFORM S BIFORM=$P(^BILET(BILET,0),U,2) "RTN","BILETPR1",106,0) N BINVAL S BINVAL=+$P(^BILET(BILET,0),U,5) "RTN","BILETPR1",107,0) Q:'BIFORM "RTN","BILETPR1",108,0) ; "RTN","BILETPR1",109,0) ;---> If History should be listed by Date, BIFORM=1 or 2; "RTN","BILETPR1",110,0) ;---> If History should be listed by Vaccine, BIFORM=3 or 4. "RTN","BILETPR1",111,0) D WRITE(.BILINE) "RTN","BILETPR1",112,0) D HISTORY1(.BILINE,BIDFN,BIFORM,BINVAL,"BILET",BIPDSS) "RTN","BILETPR1",113,0) D WRITE(.BILINE) "RTN","BILETPR1",114,0) D CONTRAS(.BILINE,BIDFN,"BILET") "RTN","BILETPR1",115,0) D WRITE(.BILINE) "RTN","BILETPR1",116,0) Q "RTN","BILETPR1",117,0) ; "RTN","BILETPR1",118,0) HISTORY1(BILINE,BIDFN,BIFORM,BINVAL,BIGBL,BIPDSS,BIHDRS,BINOSK,BILOC,BIMMRF,BIMMLF) ;EP "RTN","BILETPR1",119,0) ;---> Retrieve and store Imm History in WP ^TMP global. "RTN","BILETPR1",120,0) ;---> Parameters: "RTN","BILETPR1",121,0) ; 1 - BILINE (ret) Last line written into ^TMP array. "RTN","BILETPR1",122,0) ; 2 - BIDFN (req) Patient's IEN in VA PATIENT File #2. "RTN","BILETPR1",123,0) ; 3 - BIFORM (opt) 1=List by Date (default), 2=by Date w/Lot#, "RTN","BILETPR1",124,0) ; 3=List by Vaccine, 4=by Vaccine w/Lot#, "RTN","BILETPR1",125,0) ; 5=by Date w/VFC, 6=by Vaccine w/VFC "RTN","BILETPR1",126,0) ; 7=by Date w/Lot & VFC, 8=by Vaccine w/Lot & VFC. "RTN","BILETPR1",127,0) ; 4 - BINVAL (opt) 0=Include Invalid Doses, 1=Exclude Invalid Doses. "RTN","BILETPR1",128,0) ; 5 - BIGBL (opt) ^TMP global node to write to (def="BILET"). "RTN","BILETPR1",129,0) ; 6 - BIPDSS (opt) Returned string of Visit IEN's that are "RTN","BILETPR1",130,0) ; Problem Doses, according to ImmServe. "RTN","BILETPR1",131,0) ; 7 - BIHDRS (opt) 0=Print Imm and Skin Subheaders; 1=No Subeaders. "RTN","BILETPR1",132,0) ; 8 - BINOSK (opt) 0=Include Skin Tests, 1=Do not include Skin Tests "RTN","BILETPR1",133,0) ; 2=Include Skin Tests ONLY (NO Immunizations). "RTN","BILETPR1",134,0) ; 9 - BILOC (opt) 1=Add Location in the form: [4-char] for BIFORM 1&2. "RTN","BILETPR1",135,0) ; 10 - BIMMRF (opt) Imms Received Filter array (subscript=CVX's included). "RTN","BILETPR1",136,0) ; 11 - BIMMLF (opt) Lot Number Filter array (subscript=lot number text). "RTN","BILETPR1",137,0) ; "RTN","BILETPR1",138,0) S:$G(BIGBL)="" BIGBL="BILET" "RTN","BILETPR1",139,0) S:$G(BIFORM)="" BIFORM=1 S:$G(BINVAL)="" BINVAL=0 "RTN","BILETPR1",140,0) ; "RTN","BILETPR1",141,0) ;---> RPC to gather Imm Hx. "RTN","BILETPR1",142,0) ; BIRETVAL - Return value of valid data from RPC. "RTN","BILETPR1",143,0) ; BIRETERR - Return value (text string) of error from RPC. "RTN","BILETPR1",144,0) ; "RTN","BILETPR1",145,0) N BIDE,BIRETVAL,BIRETERR,I S BIRETVAL="" "RTN","BILETPR1",146,0) ; "RTN","BILETPR1",147,0) ;---> Set BIDE local array for Data Elements to be returned. "RTN","BILETPR1",148,0) ;---> The following are IEN's in ^BIEXPDD(. "RTN","BILETPR1",149,0) ;---> IEN PC DATA "RTN","BILETPR1",150,0) ;---> --- -- ---- "RTN","BILETPR1",151,0) ;---> 1 = Visit Type: "I"=Immunization, "S"=Skin Test. "RTN","BILETPR1",152,0) ;---> 4 2 = Vaccine Name, Short. "RTN","BILETPR1",153,0) ;---> 8 3 = Vaccine Components. ;v8.0 "RTN","BILETPR1",154,0) ;---> 24 4 = IEN, V File Visit. "RTN","BILETPR1",155,0) ;---> 26 5 = Location (or Outside Location) where Imm was given. "RTN","BILETPR1",156,0) ;---> 27 6 = Vaccine Group. "RTN","BILETPR1",157,0) ;---> 33 7 = Vaccine Lot#, Text. "RTN","BILETPR1",158,0) ;---> 38 8 = Skin Test Result. "RTN","BILETPR1",159,0) ;---> 39 9 = Skin Test Reading. "RTN","BILETPR1",160,0) ;---> 41 10 = Skin Test Name. "RTN","BILETPR1",161,0) ;---> 44 11 = Reaction to Imm, text. "RTN","BILETPR1",162,0) ;---> 56 12 = Date of Visit Fileman format (YYYMMDD). "RTN","BILETPR1",163,0) ;---> 65 13 = Dose Override. "RTN","BILETPR1",164,0) ;---> 69 14 = Vaccine Component CVX Code. "RTN","BILETPR1",165,0) ;---> 77 15 = VFC for this immunization. "RTN","BILETPR1",166,0) ;IHS/CMI/LAB - added piece 16 as date adm or visit date "RTN","BILETPR1",167,0) ;---> 86 16 = Date of Event/Administer shot (1201 field of V File) in FM format (YYYMMDD). "RTN","BILETPR1",168,0) ; "RTN","BILETPR1",169,0) ; "RTN","BILETPR1",170,0) F I=4,8,24,26,27,33,38,39,41,44,56,65,69,77,86 S BIDE(I)="" ;IHS/CMI/LAB PATCH 25 ADDED ITEM 86 for adm/vd "RTN","BILETPR1",171,0) D IMMHX^BIRPC(.BIRETVAL,BIDFN,.BIDE,1,0) "RTN","BILETPR1",172,0) ; "RTN","BILETPR1",173,0) ;---> If BIRETERR has a value, store it and quit. "RTN","BILETPR1",174,0) S BIRETERR=$P(BIRETVAL,BI31,2) "RTN","BILETPR1",175,0) I BIRETERR]"" D Q "RTN","BILETPR1",176,0) .D WRITE(.BILINE," "_BIRETERR,BIGBL) "RTN","BILETPR1",177,0) .D WRITE(.BILINE,,BIGBL) "RTN","BILETPR1",178,0) ; "RTN","BILETPR1",179,0) ;---> Set BIHX=to a valid Imm Hx for this patient. "RTN","BILETPR1",180,0) N BIHX S BIHX=$P(BIRETVAL,BI31,1) "RTN","BILETPR1",181,0) ; "RTN","BILETPR1",182,0) ;---> Build Listmanager array from BIHX string. "RTN","BILETPR1",183,0) ; "RTN","BILETPR1",184,0) ;---> List Immunization (and Skin Test) History by Vaccine, and quit. "RTN","BILETPR1",185,0) I (BIFORM=3)!(BIFORM=4) D HISTORY2^BILETPR3(.BILINE,BIHX,BIDFN,BIFORM,BINVAL,BIPDSS) Q "RTN","BILETPR1",186,0) ; "RTN","BILETPR1",187,0) D:$G(BINOSK)'=2 WRITE(.BILINE,,BIGBL) "RTN","BILETPR1",188,0) ; "RTN","BILETPR1",189,0) N BIAR,I,V,Y S V="|" "RTN","BILETPR1",190,0) ; "RTN","BILETPR1",191,0) ;---> List Imm Hx by Date (if call is not for Skin Test ONLY). "RTN","BILETPR1",192,0) ;---> Loop through "^"-pieces of Imm History, getting data. "RTN","BILETPR1",193,0) I $G(BINOSK)'=2 F I=1:1 S Y=$P(BIHX,U,I) Q:Y="" D "RTN","BILETPR1",194,0) .;---> Quit if this is not an Immunization. "RTN","BILETPR1",195,0) .Q:$P(Y,V)'="I" "RTN","BILETPR1",196,0) .; "RTN","BILETPR1",197,0) .;---> Set BIPD=1 if Immserve has a problem with this dose. "RTN","BILETPR1",198,0) .N BIPD S BIPD=$$PDSS^BIUTL8($P(Y,V,4),$P(Y,V,14),$G(BIPDSS)) "RTN","BILETPR1",199,0) .; "RTN","BILETPR1",200,0) .;---> Do not display if this vaccine is not in the display filter array. "RTN","BILETPR1",201,0) .; "RTN","BILETPR1",202,0) .;********** PATCH 24, v8.5, APR 01,2022, ihs/cmi/maw "RTN","BILETPR1",203,0) .;I $D(BIMMRF) Q:('$D(BIMMRF(+$P(Y,V,14)))) "RTN","BILETPR1",204,0) .I $D(BIMMRF) I '$D(BIMMRF("ALL")) Q:('$D(BIMMRF($$HL7TX^BIUTL2(+$P(Y,V,14))))) "RTN","BILETPR1",205,0) .; "RTN","BILETPR1",206,0) .;---> Do not display if this lot number is not in the display filter array. "RTN","BILETPR1",207,0) .I $D(BIMMLF) Q:('$D(BIMMLF(+$P(Y,V,7)))) "RTN","BILETPR1",208,0) .; "RTN","BILETPR1",209,0) .;---> Set Vaccine Name. "RTN","BILETPR1",210,0) .N X S X=$P(Y,V,2) "RTN","BILETPR1",211,0) .; "RTN","BILETPR1",212,0) .;---> Tack on Lot# if specified. "RTN","BILETPR1",213,0) .N BILOT S BILOT=$P(Y,V,7) "RTN","BILETPR1",214,0) .S:((BIFORM=2)&(BILOT]"")) X=X_" (#"_BILOT_")" "RTN","BILETPR1",215,0) .; "RTN","BILETPR1",216,0) .;---> Tack on VFC if specified. "RTN","BILETPR1",217,0) .N BIVFC S BIVFC=$P(Y,V,15) "RTN","BILETPR1",218,0) .S:((BIFORM=5)&(BIVFC>1)) X=X_" (VFC+)" "RTN","BILETPR1",219,0) .; "RTN","BILETPR1",220,0) .;---> Tack on Lot# & VFC if specified. "RTN","BILETPR1",221,0) .I BIFORM=7 D "RTN","BILETPR1",222,0) ..I (BILOT="")&(BIVFC<2) Q "RTN","BILETPR1",223,0) ..S X=X_" (" "RTN","BILETPR1",224,0) ..I BILOT]"" S X=X_"#"_BILOT "RTN","BILETPR1",225,0) ..I (BILOT]"")&(BIVFC>1) S X=X_", " "RTN","BILETPR1",226,0) ..I BIVFC>1 S X=X_"VFC+" "RTN","BILETPR1",227,0) ..S X=X_")" "RTN","BILETPR1",228,0) .; "RTN","BILETPR1",229,0) .;---> Tack on Location if specified. "RTN","BILETPR1",230,0) .S:$G(BILOC) X=X_" ["_$E($P(Y,V,5),1,4)_"]" "RTN","BILETPR1",231,0) .; "RTN","BILETPR1",232,0) .;---> If this Dose has a User Override or is an ImmServe Problem Dose, "RTN","BILETPR1",233,0) .;---> prepend an asterisk and tack the reason on the end. "RTN","BILETPR1",234,0) .D "RTN","BILETPR1",235,0) ..I $P(Y,V,13) D Q "RTN","BILETPR1",236,0) ...;---> But don't display text "Force Valid" ($P(Y,V,13)'=9). "RTN","BILETPR1",237,0) ...S X="*"_X "RTN","BILETPR1",238,0) ...;---> Next line would display Invalid Reason. "RTN","BILETPR1",239,0) ...;I $P(Y,V,13)'=9 S X=X_"-"_$$DOVER^BIUTL8($P(Y,V,13))_"-" "RTN","BILETPR1",240,0) ..; "RTN","BILETPR1",241,0) ..S:BIPD X="*"_X "RTN","BILETPR1",242,0) ..;---> Next line would display Immserve problem. "RTN","BILETPR1",243,0) ..;_"-INVALID--SEE IMMSERVE-" "RTN","BILETPR1",244,0) .; "RTN","BILETPR1",245,0) .;---> If there was a Reaction, tack it on. "RTN","BILETPR1",246,0) .I $P(Y,V,11)]"" S X=X_" Reaction: "_$P(Y,V,11) "RTN","BILETPR1",247,0) .; "RTN","BILETPR1",248,0) .;---> Set this Immunization in the array: "RTN","BILETPR1",249,0) .;---> BIAR(VisitDate,VaccineName,VisitIEN)=VaccineName (Lot#)--Problem Dose "RTN","BILETPR1",250,0) .;S BIAR($P(Y,V,12),$P(Y,V,2),$P(Y,V,4))=X ;IHS/CMI/LAB - PATCH 25 CHANGED TO ADMIN/VD "RTN","BILETPR1",251,0) .S BIAR($P(Y,V,16),$P(Y,V,2),$P(Y,V,4))=X "RTN","BILETPR1",252,0) ; "RTN","BILETPR1",253,0) ;---> Build Imm History lines for History Section of Form Letter. "RTN","BILETPR1",254,0) N N S N=0 "RTN","BILETPR1",255,0) F S N=$O(BIAR(N)) Q:'N D "RTN","BILETPR1",256,0) .N BIHXLN "RTN","BILETPR1",257,0) .S BIHXLN=$$SLDT2^BIUTL5(N,1)_": " "RTN","BILETPR1",258,0) .N I,M S M=0 "RTN","BILETPR1",259,0) .;---> Note: I and J below are counters for inserting ", ". "RTN","BILETPR1",260,0) .F I=1:1 S M=$O(BIAR(N,M)) Q:M="" D "RTN","BILETPR1",261,0) ..N J,P S P=0 "RTN","BILETPR1",262,0) ..F J=1:1 S P=$O(BIAR(N,M,P)) Q:'P D "RTN","BILETPR1",263,0) ...N X S X=BIAR(N,M,P) "RTN","BILETPR1",264,0) ...;---> If this line will be too long, write it and start a new line. "RTN","BILETPR1",265,0) ...I $L(BIHXLN_X)>70 D Q "RTN","BILETPR1",266,0) ....D WRITE(.BILINE," "_BIHXLN_",",BIGBL) "RTN","BILETPR1",267,0) ....S BIHXLN=" "_X "RTN","BILETPR1",268,0) ...S BIHXLN=BIHXLN_$S((I>1!(J>1)):", ",1:"")_X "RTN","BILETPR1",269,0) .D:$O(BIAR(0)) WRITE(.BILINE," "_BIHXLN,BIGBL) "RTN","BILETPR1",270,0) ; "RTN","BILETPR1",271,0) ;---> If there are no previous immunizations and this call is NOT for "RTN","BILETPR1",272,0) ;---> Skin Tests ONLY, then store next line. "RTN","BILETPR1",273,0) I '$O(BIAR(0)),$G(BINOSK)'=2 D "RTN","BILETPR1",274,0) .D WRITE(.BILINE," No previous immunizations recorded.",BIGBL) "RTN","BILETPR1",275,0) ; "RTN","BILETPR1",276,0) ;---> Quit if NOT including Skin Tests. "RTN","BILETPR1",277,0) Q:($G(BINOSK))=1 "RTN","BILETPR1",278,0) ; "RTN","BILETPR1",279,0) ;---> SKIN TESTS "RTN","BILETPR1",280,0) ;---> PC DATA "RTN","BILETPR1",281,0) ;---> -- ---- "RTN","BILETPR1",282,0) ;---> 1 = Visit Type: "I"=Immunization, "S"=Skin Test. "RTN","BILETPR1",283,0) ;---> 4 = V Skin Test File IEN. "RTN","BILETPR1",284,0) ;---> 5 = Location (or Outside Location) where Imm was given. "RTN","BILETPR1",285,0) ;---> 8 = Skin Test Result. "RTN","BILETPR1",286,0) ;---> 9 = Skin Test Reading. "RTN","BILETPR1",287,0) ;---> 10 = Skin Test Name. "RTN","BILETPR1",288,0) ;---> 12 = Date of Visit Fileman format (YYYMMDD). "RTN","BILETPR1",289,0) ; "RTN","BILETPR1",290,0) ;---> List Skin Test History by Date. "RTN","BILETPR1",291,0) ;---> Loop through "^"-pieces of Imm History, getting data. "RTN","BILETPR1",292,0) K BIAR "RTN","BILETPR1",293,0) F I=1:1 S Y=$P(BIHX,U,I) Q:Y="" D "RTN","BILETPR1",294,0) .;---> Quit if this is not a Skin Test. "RTN","BILETPR1",295,0) .Q:$P(Y,V)'="S" "RTN","BILETPR1",296,0) .;---> Set display line for this Skin Test Name and Date. "RTN","BILETPR1",297,0) .S X=$P(Y,V,10),X=$$PAD^BIUTL5(X,12) "RTN","BILETPR1",298,0) .; "RTN","BILETPR1",299,0) .D "RTN","BILETPR1",300,0) ..I $P(Y,V,8)]"" S X=X_$P(Y,V,8) Q "RTN","BILETPR1",301,0) ..I $P(Y,V,9) S X=X_$P(Y,V,9)_" mm" Q "RTN","BILETPR1",302,0) ..S X=X_"Not recorded" "RTN","BILETPR1",303,0) .; "RTN","BILETPR1",304,0) .;---> Set this Skin Test in the array: "RTN","BILETPR1",305,0) .;---> BIAR(VisitDate,SkinTestName,VisitIEN)=Skin Test display line. "RTN","BILETPR1",306,0) .S BIAR($P(Y,V,12),$P(Y,V,10),$P(Y,V,4))=X "RTN","BILETPR1",307,0) ; "RTN","BILETPR1",308,0) ;********** PATCH 10, v8.5, MAY 30,2015, IHS/CMI/MWR "RTN","BILETPR1",309,0) ;---> If no skin tests on record, display that explicitly. "RTN","BILETPR1",310,0) ;Q:'$D(BIAR) "RTN","BILETPR1",311,0) I '$D(BIAR) D Q "RTN","BILETPR1",312,0) .D WRITE(.BILINE) "RTN","BILETPR1",313,0) .S X=" Skin Tests/PPD: None on record" D WRITE(.BILINE,X) "RTN","BILETPR1",314,0) ;********** "RTN","BILETPR1",315,0) ; "RTN","BILETPR1",316,0) ;---> Skin Test Header. "RTN","BILETPR1",317,0) D:$G(BINOSK)'=2 WRITE(.BILINE,,BIGBL) "RTN","BILETPR1",318,0) D:'$G(BIHDRS) "RTN","BILETPR1",319,0) .;S X=" Skin Tests:" "RTN","BILETPR1",320,0) .S X=" Recent Skin Tests:" "RTN","BILETPR1",321,0) .D WRITE(.BILINE,X,BIGBL) "RTN","BILETPR1",322,0) .S X=" -----------------------" "RTN","BILETPR1",323,0) .D WRITE(.BILINE,X,BIGBL) "RTN","BILETPR1",324,0) ; "RTN","BILETPR1",325,0) ;---> Build Skin Test History lines for History Section of Form Letter. "RTN","BILETPR1",326,0) ; "RTN","BILETPR1",327,0) ;---> Display only the most recent three dates of Skin Tests. "RTN","BILETPR1",328,0) ; "RTN","BILETPR1",329,0) N BIZTEMP "RTN","BILETPR1",330,0) ; "RTN","BILETPR1",331,0) N N S N=0 "RTN","BILETPR1",332,0) F S N=$O(BIAR(N)) Q:'N D "RTN","BILETPR1",333,0) .N BIDT "RTN","BILETPR1",334,0) .S BIDT=$$SLDT2^BIUTL5(N,1) "RTN","BILETPR1",335,0) .N I,M S M=0 "RTN","BILETPR1",336,0) .F I=1:1 S M=$O(BIAR(N,M)) Q:M="" D "RTN","BILETPR1",337,0) ..N P S P=0 "RTN","BILETPR1",338,0) ..F S P=$O(BIAR(N,M,P)) Q:'P D "RTN","BILETPR1",339,0) ...N X S X=BIAR(N,M,P) "RTN","BILETPR1",340,0) ...S X=" "_$S(I=1:BIDT_": ",1:" ")_X "RTN","BILETPR1",341,0) ...; "RTN","BILETPR1",342,0) ...S BIZTEMP(N,M)=X "RTN","BILETPR1",343,0) ...;D WRITE(.BILINE,X,BIGBL) "RTN","BILETPR1",344,0) ; "RTN","BILETPR1",345,0) N N S N=9999999 "RTN","BILETPR1",346,0) F I=1:1:4 S N=+$O(BIZTEMP(N),-1) Q:'N "RTN","BILETPR1",347,0) F S N=$O(BIZTEMP(N)) Q:'N D "RTN","BILETPR1",348,0) .N M S M="" "RTN","BILETPR1",349,0) .F S M=$O(BIZTEMP(N,M)) Q:(M="") D "RTN","BILETPR1",350,0) ..D WRITE(.BILINE,BIZTEMP(N,M),BIGBL) "RTN","BILETPR1",351,0) ;********** "RTN","BILETPR1",352,0) ; "RTN","BILETPR1",353,0) Q "RTN","BILETPR1",354,0) ; "RTN","BILETPR1",355,0) ; "RTN","BILETPR1",356,0) ;---------- "RTN","BILETPR1",357,0) CONTRAS(BILINE,BIDFN,BIGBL) ;EP "RTN","BILETPR1",358,0) G CONTRAS^BILETPR4 "RTN","BILETPR1",359,0) ; "RTN","BILETPR1",360,0) ;---------- "RTN","BILETPR1",361,0) FORECAST(BILET,BILINE,BIFORCST,BIFDT) ;EP "RTN","BILETPR1",362,0) ;---> Calculate and store Forecast in WP ^TMP global. "RTN","BILETPR1",363,0) ;---> Parameters: "RTN","BILETPR1",364,0) ; 1 - BILET (req) IEN of Letter in BI LETTER File. "RTN","BILETPR1",365,0) ; 2 - BILINE (ret) Last line written into ^TMP array. "RTN","BILETPR1",366,0) ; 3 - BIFORCST (req) Raw forecast string back from call to IMMFORC^BIRPC. "RTN","BILETPR1",367,0) ; 4 - BIFDT (opt) Forecast Date. "RTN","BILETPR1",368,0) ; "RTN","BILETPR1",369,0) ;---> Quit if this Form Letter does not included a Forecast. "RTN","BILETPR1",370,0) Q:'$P(^BILET(BILET,0),U,3) "RTN","BILETPR1",371,0) ; "RTN","BILETPR1",372,0) ;---> If Forecast Date not provided, set it equal to today. "RTN","BILETPR1",373,0) S:'$G(BIFDT) BIFDT=DT "RTN","BILETPR1",374,0) ; "RTN","BILETPR1",375,0) ;---> RPC to gather Immunization History. "RTN","BILETPR1",376,0) ; BIFORCST - Return value of valid data from RPC. "RTN","BILETPR1",377,0) ; BIRETERR - Return value (text string) of error from RPC. "RTN","BILETPR1",378,0) ; "RTN","BILETPR1",379,0) N BIRETERR S BIRETVAL="" "RTN","BILETPR1",380,0) ; "RTN","BILETPR1",381,0) ;---> If BIRETERR has a value, store it and quit. "RTN","BILETPR1",382,0) S BIRETERR=$P(BIFORCST,BI31,2) "RTN","BILETPR1",383,0) I BIRETERR]"" D Q "RTN","BILETPR1",384,0) .D WRITE(.BILINE),WRITE(.BILINE," "_BIRETERR),WRITE(.BILINE) "RTN","BILETPR1",385,0) ; "RTN","BILETPR1",386,0) ;---> Set BIFORC=to the Immunization Forecast for this patient. "RTN","BILETPR1",387,0) N BIFORC,I,V S V="|",BIFORC=$P(BIFORCST,BI31,1) "RTN","BILETPR1",388,0) ; "RTN","BILETPR1",389,0) D WRITE(.BILINE) "RTN","BILETPR1",390,0) ; "RTN","BILETPR1",391,0) ;---> If Forecast Date is not Today, display Forecast Date in letter. "RTN","BILETPR1",392,0) D:BIFDT'=DT "RTN","BILETPR1",393,0) .;---> Set Forecast Date external form for letter text. "RTN","BILETPR1",394,0) .N BIFDT1 S BIFDT1=$$TXDT1^BIUTL5(BIFDT) "RTN","BILETPR1",395,0) .D WRITE(.BILINE," For "_BIFDT1_":") "RTN","BILETPR1",396,0) ; "RTN","BILETPR1",397,0) ;---> Loop through "^"-pieces of Imm Forecast, getting data. "RTN","BILETPR1",398,0) F I=1:1 S Y=$P(BIFORC,U,I) Q:Y="" D "RTN","BILETPR1",399,0) .; "RTN","BILETPR1",400,0) .S Y=$P(Y,V) I +Y&($E(Y,2)="-") S Y=$E(Y,3,99) "RTN","BILETPR1",401,0) .; "RTN","BILETPR1",402,0) .;********** PATCH 14, v8.5, AUG 01,2017, IHS/CMI/MWR "RTN","BILETPR1",403,0) .;---> Remove "NOS" from forecasted vaccines. "RTN","BILETPR1",404,0) .I Y[",NOS" S Y=$P(Y,",NOS")_$P(Y,",NOS",2) "RTN","BILETPR1",405,0) .;********** "RTN","BILETPR1",406,0) .; "RTN","BILETPR1",407,0) .D WRITE(.BILINE," "_$$STRIP^BIUTL5(.Y)) "RTN","BILETPR1",408,0) D WRITE(.BILINE) "RTN","BILETPR1",409,0) Q "RTN","BILETPR1",410,0) ; "RTN","BILETPR1",411,0) ; "RTN","BILETPR1",412,0) ;---------- "RTN","BILETPR1",413,0) DATELOC(BILET,BILINE,BIDLOC) ;EP "RTN","BILETPR1",414,0) D DATELOC^BILETPR2(BILET,.BILINE,BIDLOC) "RTN","BILETPR1",415,0) Q "RTN","BILETPR1",416,0) ; "RTN","BILETPR1",417,0) ; "RTN","BILETPR1",418,0) ;---------- "RTN","BILETPR1",419,0) WRITE(BILINE,BIVAL,BIGBL) ;EP "RTN","BILETPR1",420,0) D WRITE^BILETPR3(.BILINE,$G(BIVAL),$G(BIGBL)) "RTN","BILETPR1",421,0) Q "RTN","BIOUTPT5") 0^1^B132518262 "RTN","BIOUTPT5",1,0) BIOUTPT5 ;IHS/CMI/MWR - WRITE SUBHEADERS.; AUG 10,2010 "RTN","BIOUTPT5",2,0) ;;8.5;IMMUNIZATION;**31**;OCT 24,2011;Build 137 "RTN","BIOUTPT5",3,0) ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS * "RTN","BIOUTPT5",4,0) ;; WRITE SUBHEADER LINES TO ^TMP FOR REPORTS. "RTN","BIOUTPT5",5,0) ;; v8.4 PATCH 1: Manage subheader Items more than 20. SUBH+35 "RTN","BIOUTPT5",6,0) ; "RTN","BIOUTPT5",7,0) ; "RTN","BIOUTPT5",8,0) ;---------- "RTN","BIOUTPT5",9,0) SUBH(BIAR,BITEM,BITEMS,BIGBL,BILINE,BIERR,BIPC,BITM,BIAPP) ;EP "RTN","BIOUTPT5",10,0) ;---> If specific Items were selected (not ALL), then list them "RTN","BIOUTPT5",11,0) ;---> in a subheader at the top of the report. "RTN","BIOUTPT5",12,0) ;---> Parameters: "RTN","BIOUTPT5",13,0) ; 1 - BIAR (req) Array of Item IENs to be displayed. "RTN","BIOUTPT5",14,0) ; 2 - BITEM (req) Categoric name of Items being displayed. "RTN","BIOUTPT5",15,0) ; 3 - BITEMS (opt) Plural form of Categoric Item name. "RTN","BIOUTPT5",16,0) ; Provide this only if it's an exception. "RTN","BIOUTPT5",17,0) ; 4 - BIGBL (req) Item global OR File#-Field# for Set of Codes. "RTN","BIOUTPT5",18,0) ; 5 - BILINE (ret) Line number in ^TMP Listman array. "RTN","BIOUTPT5",19,0) ; 6 - BIERR (ret) Error Code returned, if any. "RTN","BIOUTPT5",20,0) ; 7 - BIPC (opt) Piece of Zero node to display as Item Name; "RTN","BIOUTPT5",21,0) ; default=1. "RTN","BIOUTPT5",22,0) ; 8 - BITM (opt) Top Margin. "RTN","BIOUTPT5",23,0) ; 9 - BIAPP (opt) Any text to be appended to the list, such as "RTN","BIOUTPT5",24,0) ; a date range. "RTN","BIOUTPT5",25,0) ; "RTN","BIOUTPT5",26,0) ;---> EXAMPLE: "RTN","BIOUTPT5",27,0) ; D SUBH^BIOUTPT5("BICC","Community",,"^AUTTCOM(",.BILINE,.BIERR) "RTN","BIOUTPT5",28,0) ; "RTN","BIOUTPT5",29,0) ; "RTN","BIOUTPT5",30,0) ;---> Check/set required variables. "RTN","BIOUTPT5",31,0) S BIERR="" "RTN","BIOUTPT5",32,0) Q:$$CHECK(.BIERR) "RTN","BIOUTPT5",33,0) S:'$G(BITM) BITM=12 "RTN","BIOUTPT5",34,0) ; "RTN","BIOUTPT5",35,0) ;---> Quit and don't write subheader if "ALL" Items were selected "RTN","BIOUTPT5",36,0) ;---> (or if NO Items were selected). "RTN","BIOUTPT5",37,0) Q:$O(@(BIAR_"(0)"))="" "RTN","BIOUTPT5",38,0) Q:$D(@(BIAR_"(""ALL"")")) "RTN","BIOUTPT5",39,0) ; "RTN","BIOUTPT5",40,0) ;---> Check/set plural form of Item Name. "RTN","BIOUTPT5",41,0) I $G(BITEMS)="" D PLURAL^BISELECT(BITEM,.BITEMS) "RTN","BIOUTPT5",42,0) ; "RTN","BIOUTPT5",43,0) ; "RTN","BIOUTPT5",44,0) ;********** PATCH 1, v8.4, AUG 01,2010, IHS/CMI/MWR "RTN","BIOUTPT5",45,0) ;---> If more than 20 subheader items and list is to the screen, simply "RTN","BIOUTPT5",46,0) ;---> state that and quit. "RTN","BIOUTPT5",47,0) N M,N S (M,N)=0 "RTN","BIOUTPT5",48,0) F S N=$O(@(BIAR_"(N)")) Q:'N S M=M+1 "RTN","BIOUTPT5",49,0) I M>20 I $G(IOSL)<25 D Q "RTN","BIOUTPT5",50,0) .N X S X=" "_BITEMS_": More than 20; Print report or review "_BITEM_" parameter." "RTN","BIOUTPT5",51,0) .D WH^BIW(.BILINE,X) "RTN","BIOUTPT5",52,0) .I $G(BISPD)'="CSV" D WH^BIW(.BILINE,$$SP^BIUTL5(79,"-")) "RTN","BIOUTPT5",53,0) ;********** "RTN","BIOUTPT5",54,0) ; "RTN","BIOUTPT5",55,0) ; "RTN","BIOUTPT5",56,0) ;---> If too much subheader text for screen, return error. "RTN","BIOUTPT5",57,0) I (BILINE>BITM)&($G(IOSL)<25) S BIERR=668 Q "RTN","BIOUTPT5",58,0) ; "RTN","BIOUTPT5",59,0) ;---> Alphabetize list. "RTN","BIOUTPT5",60,0) N BIAR1 "RTN","BIOUTPT5",61,0) D "RTN","BIOUTPT5",62,0) .I +BIGBL D Q "RTN","BIOUTPT5",63,0) ..;---> Set of Codes. "RTN","BIOUTPT5",64,0) ..N BISET S BISET=$P($G(^DD($P(BIGBL,"-"),$P(BIGBL,"-",2),0)),U,3) "RTN","BIOUTPT5",65,0) ..N N S N=0 "RTN","BIOUTPT5",66,0) ..F S N=$O(@(BIAR_"(N)")) Q:N="" D "RTN","BIOUTPT5",67,0) ...S BIAR1($P($P(BISET,N_":",2),";"))="" "RTN","BIOUTPT5",68,0) .; "RTN","BIOUTPT5",69,0) .;---> Entries from a File. "RTN","BIOUTPT5",70,0) .S:'$G(BIPC) BIPC=1 "RTN","BIOUTPT5",71,0) .N N S N=0 "RTN","BIOUTPT5",72,0) .F S N=$O(@(BIAR_"(N)")) Q:'N D "RTN","BIOUTPT5",73,0) ..S BIAR1($$NAME(N,BIGBL,BIPC))="" "RTN","BIOUTPT5",74,0) ; "RTN","BIOUTPT5",75,0) ;---> Set X=string of Items, pieced by "; " (or Z). "RTN","BIOUTPT5",76,0) N BIHEAD,I,N,Y,Z "RTN","BIOUTPT5",77,0) S N=0,X="",Z="; " "RTN","BIOUTPT5",78,0) F I=1:1 S N=$O(BIAR1(N)) Q:N="" D "RTN","BIOUTPT5",79,0) .S:I>1 X=X_Z S X=X_N "RTN","BIOUTPT5",80,0) ;---> Append any text such as date range. "RTN","BIOUTPT5",81,0) S:$G(BIAPP)]"" X=X_BIAPP "RTN","BIOUTPT5",82,0) S BIHEAD=" "_$S(I>2:BITEMS,1:BITEM)_": " "RTN","BIOUTPT5",83,0) ; "RTN","BIOUTPT5",84,0) ;---> Now write each line with as many Items as will fit on a line "RTN","BIOUTPT5",85,0) ;---> (hanging indent under the header "Item Name:"). "RTN","BIOUTPT5",86,0) S N=1 "RTN","BIOUTPT5",87,0) F D Q:$P(X,Z,I)="" Q:$G(BIERR) "RTN","BIOUTPT5",88,0) .F I=N:1 S Y=$P(X,Z,N,I) Q:$L(Y)>63 Q:$P(X,Z,I)="" "RTN","BIOUTPT5",89,0) .I N>1 S BIHEAD=$$SP^BIUTL5($L(BIHEAD)) "RTN","BIOUTPT5",90,0) .I (BILINE>BITM)&($G(IOSL)<25) S BIERR=668 Q "RTN","BIOUTPT5",91,0) .D WH^BIW(.BILINE,BIHEAD_$P(X,Z,N,I-1)) "RTN","BIOUTPT5",92,0) .S N=I "RTN","BIOUTPT5",93,0) ; "RTN","BIOUTPT5",94,0) I $G(BISPD)'="CSV" D WH^BIW(.BILINE,$$SP^BIUTL5(79,"-")) "RTN","BIOUTPT5",95,0) Q "RTN","BIOUTPT5",96,0) ; "RTN","BIOUTPT5",97,0) ; "RTN","BIOUTPT5",98,0) ;---------- "RTN","BIOUTPT5",99,0) NAME(BIIEN,BIGBL,BIPC) ;EP "RTN","BIOUTPT5",100,0) ;---> Return the .01 for this IEN in BIGBL. "RTN","BIOUTPT5",101,0) ;---> Parameters: "RTN","BIOUTPT5",102,0) ; 1 - BIIEN (req) IEN of Item. "RTN","BIOUTPT5",103,0) ; 2 - BIGBL (req) Item global. "RTN","BIOUTPT5",104,0) ; 3 - BIPC (opt) Piece of Zero node to display (default=1). "RTN","BIOUTPT5",105,0) ; "RTN","BIOUTPT5",106,0) Q:'$G(BIIEN) 0 Q:$G(BIGBL)="" 0 "RTN","BIOUTPT5",107,0) N X S:'$G(BIPC) BIPC=1 "RTN","BIOUTPT5",108,0) S X=$P(@(BIGBL_BIIEN_",0)"),U,BIPC) "RTN","BIOUTPT5",109,0) Q:X="" 0 "RTN","BIOUTPT5",110,0) Q X "RTN","BIOUTPT5",111,0) ; "RTN","BIOUTPT5",112,0) ; "RTN","BIOUTPT5",113,0) ;---> First, build array sorted by ItemName. "RTN","BIOUTPT5",114,0) N BIIEN S BIIEN=0 "RTN","BIOUTPT5",115,0) F S BIIEN=$O(@(BIARR1_"(BIIEN)")) Q:'BIIEN D "RTN","BIOUTPT5",116,0) .; "RTN","BIOUTPT5",117,0) .;---> If IEN passed does not really exist in the File, "RTN","BIOUTPT5",118,0) .;---> remove it from the Selection Array. "RTN","BIOUTPT5",119,0) .I '$D(@(BIGBL_"BIIEN,0)")) K @(BIARR1_"(BIIEN)") Q "RTN","BIOUTPT5",120,0) .; "RTN","BIOUTPT5",121,0) .;---> If (previously stored) IEN does not pass the screen, "RTN","BIOUTPT5",122,0) .;---> then remove it from the Selection Array. "RTN","BIOUTPT5",123,0) .I BISCRN]"" N Y S Y=BIIEN X BISCRN I '$T K @(BIARR1_"(BIIEN)") Q "RTN","BIOUTPT5",124,0) .; "RTN","BIOUTPT5",125,0) .N BI0,BINAME,BIIDTX "RTN","BIOUTPT5",126,0) .S BI0=@(BIGBL_"BIIEN,0)") "RTN","BIOUTPT5",127,0) .S BINAME=$P(BI0,U,BIPIECE) "RTN","BIOUTPT5",128,0) .Q:BINAME="" "RTN","BIOUTPT5",129,0) Q "RTN","BIOUTPT5",130,0) ; "RTN","BIOUTPT5",131,0) ; "RTN","BIOUTPT5",132,0) ;---------- "RTN","BIOUTPT5",133,0) CHECK(BIERR) ;EP "RTN","BIOUTPT5",134,0) ;---> Check required variables. "RTN","BIOUTPT5",135,0) ;---> Parameters: "RTN","BIOUTPT5",136,0) ; 1 - BIERR (ret) Error Code returned, if any. "RTN","BIOUTPT5",137,0) ; "RTN","BIOUTPT5",138,0) ;---> Check that Subheader Array name is present. "RTN","BIOUTPT5",139,0) I $G(BIAR)="" S BIERR=656 Q 1 "RTN","BIOUTPT5",140,0) ; "RTN","BIOUTPT5",141,0) ;---> Check that Categoric Item name is present. "RTN","BIOUTPT5",142,0) I $G(BITEM)="" S BIERR=657 Q 1 "RTN","BIOUTPT5",143,0) ; "RTN","BIOUTPT5",144,0) ;---> Check Item global. "RTN","BIOUTPT5",145,0) I $G(BIGBL)="" S BIERR=658 Q 1 "RTN","BIOUTPT5",146,0) ; "RTN","BIOUTPT5",147,0) ;---> Check that the Global or Set of Codes is legitimate. "RTN","BIOUTPT5",148,0) S BIERR="" "RTN","BIOUTPT5",149,0) D Q:BIERR 1 "RTN","BIOUTPT5",150,0) .I +BIGBL D Q "RTN","BIOUTPT5",151,0) ..;---> Test for Set of Codes. "RTN","BIOUTPT5",152,0) ..N X,Y S X=$P(BIGBL,"-"),Y=$P(BIGBL,"-",2) "RTN","BIOUTPT5",153,0) ..I 'Y S BIERR=665 Q "RTN","BIOUTPT5",154,0) ..I '$D(^DD(X,Y,0)) S BIERR=665 Q "RTN","BIOUTPT5",155,0) .; "RTN","BIOUTPT5",156,0) .;---> Test for global (entries from a file). "RTN","BIOUTPT5",157,0) .I '$D(@(BIGBL_"0)")) S BIERR=659 Q "RTN","BIOUTPT5",158,0) ; "RTN","BIOUTPT5",159,0) Q 0 "RTN","BIOUTPT5",160,0) ; "RTN","BIOUTPT5",161,0) ; "RTN","BIOUTPT5",162,0) ;---------- "RTN","BIOUTPT5",163,0) RYEAR(BIYEAR,BIRTN) ;EP "RTN","BIOUTPT5",164,0) ;---> Ask the Report Year. "RTN","BIOUTPT5",165,0) ;---> Called by Protocol BI OUTPUT REPORT YEAR. "RTN","BIOUTPT5",166,0) ;---> Parameters: "RTN","BIOUTPT5",167,0) ; 1 - BIYEAR (ret) Report Year in yyyy format. "RTN","BIOUTPT5",168,0) ; (opt) Default Year. "RTN","BIOUTPT5",169,0) ; 2 - BIRTN (req) Calling routine for reset. "RTN","BIOUTPT5",170,0) ; "RTN","BIOUTPT5",171,0) I $G(BIRTN)="" D ERRCD^BIUTL2(621,,1) Q "RTN","BIOUTPT5",172,0) ; "RTN","BIOUTPT5",173,0) N DIR,DIRA,DIRB,DIRQ,DIRNOW,BIPOP "RTN","BIOUTPT5",174,0) S:$G(BIYEAR) DIRB=+BIYEAR "RTN","BIOUTPT5",175,0) D "RTN","BIOUTPT5",176,0) .I '$G(DT) S DIRNOW=2050 Q "RTN","BIOUTPT5",177,0) .S DIRNOW=1700+$E(DT,1,3) "RTN","BIOUTPT5",178,0) S DIRA=" Please enter a Report Year: " "RTN","BIOUTPT5",179,0) S:$G(BIYEAR) DIRB=+BIYEAR "RTN","BIOUTPT5",180,0) S DIRQ=" Enter a year between 1950 and the present, in the form yyyy" "RTN","BIOUTPT5",181,0) D FULL^VALM1 "RTN","BIOUTPT5",182,0) D TITLE^BIUTL5("SELECT REPORT YEAR") "RTN","BIOUTPT5",183,0) D TEXT1 W ! "RTN","BIOUTPT5",184,0) D DIR^BIFMAN("NAO^1950:"_DIRNOW,.Y,.BIPOP,DIRA,DIRB,DIRQ) "RTN","BIOUTPT5",185,0) I $G(BIPOP) D @("RESET^"_BIRTN) Q "RTN","BIOUTPT5",186,0) S BIYEAR=+Y "RTN","BIOUTPT5",187,0) I Y<1 D @("RESET^"_BIRTN) Q "RTN","BIOUTPT5",188,0) ; "RTN","BIOUTPT5",189,0) N DIR "RTN","BIOUTPT5",190,0) W !!?3,"You may select an End Date of either December 31, ",+BIYEAR "RTN","BIOUTPT5",191,0) W " or March 31, ",(+BIYEAR)+1,".",! "RTN","BIOUTPT5",192,0) S DIR("A")=" Select December or March: " "RTN","BIOUTPT5",193,0) S DIR("B")=$S($P(BIYEAR,U,2)="m":"March",1:"December") "RTN","BIOUTPT5",194,0) S DIR(0)="SAM^d:December;m:March" "RTN","BIOUTPT5",195,0) D ^DIR K DIR "RTN","BIOUTPT5",196,0) I Y=-1!($D(DIRUT)) D @("RESET^"_BIRTN) Q "RTN","BIOUTPT5",197,0) ;---> If Y="m" concate to BIYEAR to signify End Date of March 31. Otherwise, "RTN","BIOUTPT5",198,0) ;---> default is 2nd "^"-piece of BIYEAR=""--which is End Date of Dec 31. "RTN","BIOUTPT5",199,0) I Y="m" S BIYEAR=BIYEAR_U_"m" "RTN","BIOUTPT5",200,0) ; "RTN","BIOUTPT5",201,0) D @("RESET^"_BIRTN) "RTN","BIOUTPT5",202,0) ; "RTN","BIOUTPT5",203,0) Q "RTN","BIOUTPT5",204,0) ; "RTN","BIOUTPT5",205,0) ; "RTN","BIOUTPT5",206,0) ;---------- "RTN","BIOUTPT5",207,0) TEXT1 ;EP "RTN","BIOUTPT5",208,0) ;;The "Report Year" represents the start of a particular influenza "RTN","BIOUTPT5",209,0) ;;season. So, for example, 2011 will cover the influenza season from "RTN","BIOUTPT5",210,0) ;;September 1, 2011 until December 31, 2011 (or until March 31, 2012, "RTN","BIOUTPT5",211,0) ;;if that End Date is chosen). "RTN","BIOUTPT5",212,0) ;; "RTN","BIOUTPT5",213,0) ;;The patient ages in the report will be calculated as of 12/31 of the "RTN","BIOUTPT5",214,0) ;;Report Year you select (12/31/2011 in the above example). "RTN","BIOUTPT5",215,0) ;; "RTN","BIOUTPT5",216,0) D PRINTX("TEXT1") "RTN","BIOUTPT5",217,0) Q "RTN","BIOUTPT5",218,0) ; "RTN","BIOUTPT5",219,0) ; "RTN","BIOUTPT5",220,0) ;---------- "RTN","BIOUTPT5",221,0) PRINTX(BILINL,BITAB) ;EP "RTN","BIOUTPT5",222,0) Q:$G(BILINL)="" "RTN","BIOUTPT5",223,0) N I,T,X S T="" S:'$D(BITAB) BITAB=5 F I=1:1:BITAB S T=T_" " "RTN","BIOUTPT5",224,0) F I=1:1 S X=$T(@BILINL+I) Q:X'[";;" W !,T,$P(X,";;",2) "RTN","BIOUTPT5",225,0) Q "RTN","BIOUTPT5",226,0) ; "RTN","BIOUTPT5",227,0) ; "RTN","BIOUTPT5",228,0) ;---------- "RTN","BIOUTPT5",229,0) TEXT11(BITEXT) ;EP "RTN","BIOUTPT5",230,0) ;;In producing lists and letters, you may select the group of patients "RTN","BIOUTPT5",231,0) ;;you wish to include by specifying attributes of this screen, such as "RTN","BIOUTPT5",232,0) ;;"DUE" or "ACTIVE." These attributes may also be used in various "RTN","BIOUTPT5",233,0) ;;combinations in order to further specify your patient group. "RTN","BIOUTPT5",234,0) ;;(This group may be further limited by the other criteria you select "RTN","BIOUTPT5",235,0) ;;on the main IMMUNIZATION LISTS & LETTERS Main Screen, such as Age Range, "RTN","BIOUTPT5",236,0) ;;Communities, Lot Numbers, etc.) "RTN","BIOUTPT5",237,0) ;; "RTN","BIOUTPT5",238,0) ;; DUE "RTN","BIOUTPT5",239,0) ;; ----- "RTN","BIOUTPT5",240,0) ;;"DUE" will list all Active patients who are DUE for immunizations, "RTN","BIOUTPT5",241,0) ;;subject to any other limitations on the Lists & Letters Main Screen, "RTN","BIOUTPT5",242,0) ;;such as Age Range, Community, etc.. "DUE" will also necessarily include "RTN","BIOUTPT5",243,0) ;;any patients who are "PAST DUE." By default, "DUE" will only include "RTN","BIOUTPT5",244,0) ;;patients who are "ACTIVE" unless you specify "INACTIVE" as one of the "RTN","BIOUTPT5",245,0) ;;attributes. "RTN","BIOUTPT5",246,0) ;; "RTN","BIOUTPT5",247,0) ;; PAST DUE "RTN","BIOUTPT5",248,0) ;; ---------- "RTN","BIOUTPT5",249,0) ;;"PAST DUE" will only include patients who are past their due dates "RTN","BIOUTPT5",250,0) ;;for one or more immunizations. If you select this attribute, you "RTN","BIOUTPT5",251,0) ;;will be given the opportunity to specify how many months past due "RTN","BIOUTPT5",252,0) ;;you wish to check for. By default, "PAST DUE" will only include "RTN","BIOUTPT5",253,0) ;;patients who are "ACTIVE" unless you specify "INACTIVE" as one of the "RTN","BIOUTPT5",254,0) ;;attributes. "RTN","BIOUTPT5",255,0) ;; "RTN","BIOUTPT5",256,0) ;; ACTIVE and INACTIVE "RTN","BIOUTPT5",257,0) ;; --------------------- "RTN","BIOUTPT5",258,0) ;;The choices of "ACTIVE" and "INACTIVE" will simply list patients in the "RTN","BIOUTPT5",259,0) ;;Immunization Database who have the Statuses of Active or Inactive. "RTN","BIOUTPT5",260,0) ;;"ACTIVE" and "INACTIVE" may also be used together to produce a list "RTN","BIOUTPT5",261,0) ;;of all patients in the Immunization database. "RTN","BIOUTPT5",262,0) ;; "RTN","BIOUTPT5",263,0) ;; "RTN","BIOUTPT5",264,0) ;; AUTOMATICALLY ACTIVATED "RTN","BIOUTPT5",265,0) ;; ------------------------- "RTN","BIOUTPT5",266,0) ;;"AUTOMATICALLY ACTIVATED" will restrict the list to only those patients "RTN","BIOUTPT5",267,0) ;;who were Automatically Activated in the Immunization database. You may "RTN","BIOUTPT5",268,0) ;;combine it with other attributes, such as ACTIVE or DUE, to produce a "RTN","BIOUTPT5",269,0) ;;list that is more specific. For example, you could produce a list of "RTN","BIOUTPT5",270,0) ;;patients who were AUTOMATICALLY ACTIVATED and are now PAST DUE. "RTN","BIOUTPT5",271,0) ;; "RTN","BIOUTPT5",272,0) ;; "RTN","BIOUTPT5",273,0) ;; REFUSALS "RTN","BIOUTPT5",274,0) ;; ---------- "RTN","BIOUTPT5",275,0) ;;"REFUSALS" will restrict the list to only those patients who at some "RTN","BIOUTPT5",276,0) ;;point refused an immunization (either the patient or the parent). "RTN","BIOUTPT5",277,0) ;;You may combine REFUSALS with other attributes in order to produce a "RTN","BIOUTPT5",278,0) ;;list that is more specific. For example, you could produce a list of "RTN","BIOUTPT5",279,0) ;;patients who were both INACTIVE and had REFUSALS on record. "RTN","BIOUTPT5",280,0) ;; "RTN","BIOUTPT5",281,0) ;; "RTN","BIOUTPT5",282,0) ;; FEMALES ONLY "RTN","BIOUTPT5",283,0) ;; -------------- "RTN","BIOUTPT5",284,0) ;;"FEMALES ONLY" will restrict the list to female patients only. "RTN","BIOUTPT5",285,0) ;;NOTE: The list will include both "ACTIVE" and "INACTIVE" female "RTN","BIOUTPT5",286,0) ;;patients unless you have specifically chosen Active or Inactive. "RTN","BIOUTPT5",287,0) ;; "RTN","BIOUTPT5",288,0) ;; "RTN","BIOUTPT5",289,0) ;; SEARCH TEMPLATES "RTN","BIOUTPT5",290,0) ;; ------------------ "RTN","BIOUTPT5",291,0) ;;SEARCH TEMPLATEs are groups of individual patients that have been "RTN","BIOUTPT5",292,0) ;;produced and stored by other software, usually QMAN, and saved under "RTN","BIOUTPT5",293,0) ;;a Template Name. If you choose this attribute, you will be asked to "RTN","BIOUTPT5",294,0) ;;select from a file of existing Search Templates. "RTN","BIOUTPT5",295,0) ;; "RTN","BIOUTPT5",296,0) ;;NOTE: A SEARCH TEMPLATE is a pre-defined group of patients and cannot "RTN","BIOUTPT5",297,0) ;;be combined with any of the other attributes. "RTN","BIOUTPT5",298,0) ;;For more information about Search Templates and how to create your "RTN","BIOUTPT5",299,0) ;;own, contact your computer support people for training. "RTN","BIOUTPT5",300,0) ;; "RTN","BIOUTPT5",301,0) ;; "RTN","BIOUTPT5",302,0) ;;Final note: The implications of combining too many restrictive attributes "RTN","BIOUTPT5",303,0) ;;can be difficult to predict and may produce few or no results. "RTN","BIOUTPT5",304,0) ;;It is best to limit a list to two or three combined attributes. "RTN","BIOUTPT5",305,0) ;; "RTN","BIOUTPT5",306,0) D LOADTX("TEXT11",,.BITEXT) "RTN","BIOUTPT5",307,0) Q "RTN","BIOUTPT5",308,0) ; "RTN","BIOUTPT5",309,0) ; "RTN","BIOUTPT5",310,0) ;---------- "RTN","BIOUTPT5",311,0) LOADTX(BILINL,BITAB,BITEXT) ;EP "RTN","BIOUTPT5",312,0) Q:$G(BILINL)="" "RTN","BIOUTPT5",313,0) N I,T,X S T="" S:'$D(BITAB) BITAB=5 F I=1:1:BITAB S T=T_" " "RTN","BIOUTPT5",314,0) F I=1:1 S X=$T(@BILINL+I) Q:X'[";;" S BITEXT(I)=T_$P(X,";;",2) "RTN","BIOUTPT5",315,0) Q "RTN","BIPATUP1") 0^20^B37108741 "RTN","BIPATUP1",1,0) BIPATUP1 ;IHS/CMI/MWR - UPDATE PATIENT DATA; DEC 15, 2011 [ 05/23/2025 9:36 PM ] ; 18 Aug 2025 4:15 PM "RTN","BIPATUP1",2,0) ;;8.5;IMMUNIZATION;**22,26,28,29,30,31**;OCT 24,2011;Build 137 "RTN","BIPATUP1",3,0) ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS * "RTN","BIPATUP1",4,0) ;; UPDATE PATIENT DATA, IMM FORECAST IN ^BIPDUE(. "RTN","BIPATUP1",5,0) ;; PATCH 21: For Td,NOS (139) use REC Date, regardless of site parameter. DDUE2+90 "RTN","BIPATUP1",6,0) ;; PATCH 22: Changes to check for COVID High Risk. IHSPOST, DDUE2 "RTN","BIPATUP1",7,0) ; "RTN","BIPATUP1",8,0) ; "RTN","BIPATUP1",9,0) ;---> IHS Forecast Addendum to TCH Report. "RTN","BIPATUP1",10,0) ;---------- "RTN","BIPATUP1",11,0) LDFORC(BIDFN,BIFORC,BIHX,BIFDT,BIDUZ2,BINF,BIPDSS,BIADDND,BIPROF) ;EP "RTN","BIPATUP1",12,0) ;---> Load Immserve Data (Immunizations Due) into ^BIPDUE(. "RTN","BIPATUP1",13,0) ;---> Parameters: "RTN","BIPATUP1",14,0) ; 1 - BIDFN (req) Patient IEN. "RTN","BIPATUP1",15,0) ; 2 - BIFORC (req) String containing Patient's Imms Due. "RTN","BIPATUP1",16,0) ; 3 - BIHX (req) String containing Patient's Imm History. "RTN","BIPATUP1",17,0) ; 4 - BIFDT (opt) Forecast Date (date used for forecast). "RTN","BIPATUP1",18,0) ; 5 - BIDUZ2 (opt) User's DUZ(2) indicating site parameters. "RTN","BIPATUP1",19,0) ; 6 - BINF (opt) Array of Vaccine Grp IEN'S tO'' should not be forecast. "RTN","BIPATUP1",20,0) ; 7 - BIPDSS (ret) Returned string of V IMM IEN's that are "RTN","BIPATUP1",21,0) ; Problem Doses, according to ImmServe. "RTN","BIPATUP1",22,0) ; 8 - BIADDND(ret) IHS forecasting addendum (to be added to TCH Report). "RTN","BIPATUP1",23,0) ; 9 - BIPROF (req) String containing text of Patient's Imm Report so far. "RTN","BIPATUP1",24,0) ; "RTN","BIPATUP1",25,0) Q:'$G(BIDFN) "RTN","BIPATUP1",26,0) Q:$G(BIFORC)="" "RTN","BIPATUP1",27,0) Q:$G(BIHX)="" "RTN","BIPATUP1",28,0) ;---> If no Forecast Date passed, set it equal to today. "RTN","BIPATUP1",29,0) S:'$G(BIFDT) BIFDT=DT "RTN","BIPATUP1",30,0) S:'$D(BINF) BINF="" "RTN","BIPATUP1",31,0) ; "RTN","BIPATUP1",32,0) ;---> Get Patient's Age "RTN","BIPATUP1",33,0) N BIAGE,BIAGEYRS,BIAGEMTS,BIAGEDYS "RTN","BIPATUP1",34,0) S BIAGE=$$AGE^BIUTL1(BIDFN,1,BIFDT) "RTN","BIPATUP1",35,0) S BIAGEYRS=+BIAGE "RTN","BIPATUP1",36,0) S BIAGEMTS=$P(BIAGE,U,2) "RTN","BIPATUP1",37,0) S BIAGEDYS=$P(BIAGE,U,3) "RTN","BIPATUP1",38,0) ; "RTN","BIPATUP1",39,0) ;---> Clear out previously set Immunizations Due and "RTN","BIPATUP1",40,0) ;---> Forecasting Errors for this patient. "RTN","BIPATUP1",41,0) D KILLDUE^BIPATUP2(BIDFN) "RTN","BIPATUP1",42,0) ; "RTN","BIPATUP1",43,0) S:'$G(BIDUZ2) BIDUZ2=$G(DUZ(2)) "RTN","BIPATUP1",44,0) ; "RTN","BIPATUP1",45,0) ;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR "RTN","BIPATUP1",46,0) ;---> Check for any input doses that TCH identified as problems. "RTN","BIPATUP1",47,0) ;---> Build and return a string of "V IMM IEN_%_CVX" problem doses, "RTN","BIPATUP1",48,0) ;---> as identified in the TCH Input Doses segment. "RTN","BIPATUP1",49,0) D DPROBS^BIPATUP2(BIFORC,.BIPDSS) "RTN","BIPATUP1",50,0) ;********** "RTN","BIPATUP1",51,0) ; "RTN","BIPATUP1",52,0) ;---> Seed BITCHAF to collect already forecasted Pneumo, HepB(45/189), HepA(85). "RTN","BIPATUP1",53,0) N BITCHAF "RTN","BIPATUP1",54,0) S BITCHAF="" "RTN","BIPATUP1",55,0) ; "RTN","BIPATUP1",56,0) ;---> Parse Doses Due from Forecaster string (BIFORC), perform any "RTN","BIPATUP1",57,0) ;---> necessary translations, and set as due in patient global ^BIPDUE(. "RTN","BIPATUP1",58,0) D DDUE(BIFORC,BIHX,.BINF,BIDUZ2,BIFDT,.BITCHAF,BIDFN,.BIPROF) "RTN","BIPATUP1",59,0) ; "RTN","BIPATUP1",60,0) ;---> After loading (SETDUE) TCH forecast, perform any follow-up forecasting "RTN","BIPATUP1",61,0) ;---> needed for High Risk. "RTN","BIPATUP1",62,0) D IHSPOST^BIPATUP4(BIDFN,BIHX,BIFDT,BIDUZ2,.BINF,BITCHAF,.BIADDND,.BIPROF) "RTN","BIPATUP1",63,0) ; "RTN","BIPATUP1",64,0) ;---> Remove BIICE condition next version. "RTN","BIPATUP1",65,0) ;I $G(BIICE) D "RTN","BIPATUP1",66,0) ;.I $G(BIADDND)="" S BIPROF=BIPROF_" | None|||" Q "RTN","BIPATUP1",67,0) ;.S BIPROF=BIPROF_BIADDND "RTN","BIPATUP1",68,0) ; "RTN","BIPATUP1",69,0) I $G(BIICE) D "RTN","BIPATUP1",70,0) .I $G(BIADDND)="" D Q "RTN","BIPATUP1",71,0) .. S BIPROF=BIPROF_" | None|||" "RTN","BIPATUP1",72,0) .. D FSUPPN^BIPATUP5 "RTN","BIPATUP1",73,0) .S BIPROF=BIPROF_BIADDND "RTN","BIPATUP1",74,0) .D FSUPPN^BIPATUP5 "RTN","BIPATUP1",75,0) Q "RTN","BIPATUP1",76,0) ; "RTN","BIPATUP1",77,0) ; "RTN","BIPATUP1",78,0) ;---------- "RTN","BIPATUP1",79,0) DDUE(BIFORC,BIHX,BINF,BIDUZ2,BIFDT,BITCHAF,BIDFN,BIPROF) ;EP "RTN","BIPATUP1",80,0) ;---> Parse Doses Due from Immserve string (BIFORC), perform any "RTN","BIPATUP1",81,0) ;---> necessary translations, and set as due in patient global ^BIPDUE. "RTN","BIPATUP1",82,0) ;---> Parameters: "RTN","BIPATUP1",83,0) ; 1 - BIFORC (req) Forecast string coming back from TCH. "RTN","BIPATUP1",84,0) ; 2 - BIHX (req) String containing Patient's Imm History. "RTN","BIPATUP1",85,0) ; 3 - BINF (opt) Array of Vaccine Grp IEN'S that should not be forecast. "RTN","BIPATUP1",86,0) ; 4 - BIDUZ2 (opt) User's DUZ(2) indicating site parameters. "RTN","BIPATUP1",87,0) ; 5 - BIFDT (opt) Forecast Date (date used for forecast). "RTN","BIPATUP1",88,0) ; 6 - BITCHAF (ret) [1=ICE already forecast Pneumo (33), [2=HepB(45), [3=HepA(85) "RTN","BIPATUP1",89,0) ; [4=COVID "RTN","BIPATUP1",90,0) ; 7 - BIDFN (req) Patient IEN. "RTN","BIPATUP1",91,0) ; 8 - BIPROF (req) String containing text of Patient's Imm Report so far. "RTN","BIPATUP1",92,0) ; "RTN","BIPATUP1",93,0) N BIFORC1,BIDOSE,N "RTN","BIPATUP1",94,0) S BIFORC1=$P(BIFORC,"~~~",3) "RTN","BIPATUP1",95,0) ; "RTN","BIPATUP1",96,0) ;---> Get Minimum vs Recommended Age Parameter: 1=Minimum Acceptable, 0=Recommended. "RTN","BIPATUP1",97,0) N BIMIN "RTN","BIPATUP1",98,0) S BIMIN=$$MINAGE^BIUTL2($G(BIDUZ2)) "RTN","BIPATUP1",99,0) ; "RTN","BIPATUP1",100,0) F N=1:1 S BIDOSE=$P(BIFORC1,"|||",N) Q:(BIDOSE="") D "RTN","BIPATUP1",101,0) .D DDUE2(BIDOSE,BIHX,.BINF,BIDUZ2,BIFDT,.BITCHAF,BIDFN,BIMIN,.BIPROF) "RTN","BIPATUP1",102,0) Q "RTN","BIPATUP1",103,0) ; "RTN","BIPATUP1",104,0) ; "RTN","BIPATUP1",105,0) ;---------- "RTN","BIPATUP1",106,0) DDUE2(BIDOSE,BIHX,BINF,BIDUZ2,BIFDT,BITCHAF,BIDFN,BIMIN,BIPROF) ;EP "RTN","BIPATUP1",107,0) ;---> Parse Doses. "RTN","BIPATUP1",108,0) ;---> Parameters: See DDUE immediately above! "RTN","BIPATUP1",109,0) ; "RTN","BIPATUP1",110,0) ;V8.5 PATCH 31 - FID-98853 Check for min/earliest date for HPV "RTN","BIPATUP1",111,0) N A,BI,BIQUIT,D,X,HPV "RTN","BIPATUP1",112,0) S X=BIDOSE,BIQUIT="" "RTN","BIPATUP1",113,0) S HPV=$S($P($G(^BISITE(+$G(BIDUZ2),0)),U,19)[7:1,1:0) "RTN","BIPATUP1",114,0) ; "RTN","BIPATUP1",115,0) ;---> A=CVX Code "RTN","BIPATUP1",116,0) S A=+$P(X,U) "RTN","BIPATUP1",117,0) ; "RTN","BIPATUP1",118,0) ;---> *** 6-WEEK EARLISET FOR FIRST DOSES: "RTN","BIPATUP1",119,0) ;---> -------------------------------- "RTN","BIPATUP1",120,0) ;---> 6 wk+ Forecast Earliest/Minimum for FIRST dose of some Vaccine Groups, "RTN","BIPATUP1",121,0) ;---> regardless of Min vs Rec site parameter. "RTN","BIPATUP1",122,0) I 'BIMIN D "RTN","BIPATUP1",123,0) .;---> Quit if age not at least 42 days or over 65 days. "RTN","BIPATUP1",124,0) .Q:((BIAGEDYS<42)!(BIAGEDYS>65)) "RTN","BIPATUP1",125,0) .;---> Get Vaccine Group IEN for this CVX. "RTN","BIPATUP1",126,0) .N G "RTN","BIPATUP1",127,0) .S G=$$HL7TX^BIUTL2(A,1) "RTN","BIPATUP1",128,0) .;---: Quit if Vaccine Group is not DT,POLIO,HIB,PNEUMO,ROTA "RTN","BIPATUP1",129,0) .Q:((G'=1)&(G'=2)&(G'=3)&(G'=11)&(G'=15)) "RTN","BIPATUP1",130,0) .;---> Get Minimum/earliest date for this dose. "RTN","BIPATUP1",131,0) .S BIMIN=1 "RTN","BIPATUP1",132,0) ; "RTN","BIPATUP1",133,0) ; "RTN","BIPATUP1",134,0) ;---> *** 4TH DOSE DTAP AT 12 MONTHS: "RTN","BIPATUP1",135,0) ;---> --------------------------- "RTN","BIPATUP1",136,0) ;---> If DTaP and age is 12 mths, take Earliest Date from ICE. "RTN","BIPATUP1",137,0) I $D(^BIVARR("DT",A)),(BIAGEDYS>364) S BIMIN=1 "RTN","BIPATUP1",138,0) I $D(^BIVARR("HPV",A)),$G(HPV) S BIMIN=1 "RTN","BIPATUP1",139,0) ; "RTN","BIPATUP1",140,0) ;---> "PAST"=Past Due Indicator "RTN","BIPATUP1",141,0) S BI("PAST")=$P(X,U,3) "RTN","BIPATUP1",142,0) ; "RTN","BIPATUP1",143,0) ;---> Get Fileman formats of Due Dates. "RTN","BIPATUP1",144,0) ; "RTN","BIPATUP1",145,0) ;---> "REC"=Recommended Date Due "RTN","BIPATUP1",146,0) S BI("REC")=$$TCHFMDT^BIUTL5($P(X,U,5)) S:('BI("REC")) BI("REC")="" "RTN","BIPATUP1",147,0) ; "RTN","BIPATUP1",148,0) ;---> "MIN"=Minimum Date Due (if null, set equal to REC). "RTN","BIPATUP1",149,0) S BI("MIN")=$$TCHFMDT^BIUTL5($P(X,U,4)) S:('BI("MIN")) BI("MIN")=BI("REC") "RTN","BIPATUP1",150,0) ; "RTN","BIPATUP1",151,0) ;---> "EXC"=Exceeds Date Due "RTN","BIPATUP1",152,0) S BI("EXC")=$$TCHFMDT^BIUTL5($P(X,U,6)) S:('BI("EXC")) BI("EXC")="" "RTN","BIPATUP1",153,0) ; "RTN","BIPATUP1",154,0) ;---> Determine whether to set Due Date = Rec Age or Min Accepted Age "RTN","BIPATUP1",155,0) ;---> based on Site Parameter. "RTN","BIPATUP1",156,0) S BI("DUE")=BI("REC") "RTN","BIPATUP1",157,0) I BIMIN S BI("DUE")=BI("MIN") "RTN","BIPATUP1",158,0) ;---> Quit if the Forecast Date is before the Due Date. "RTN","BIPATUP1",159,0) Q:(BIFDT If this dose is past due (BI("PAST")=1), D(2) will stuff DATE PAST DUE; "RTN","BIPATUP1",163,0) ;---> Otherwise, D(1) will stuff RECOMMENDED DATE DUE. "RTN","BIPATUP1",164,0) S (D(1),D(2))="" D "RTN","BIPATUP1",165,0) .I BI("PAST") S D(2)=BI("EXC") Q "RTN","BIPATUP1",166,0) .S D(1)=BI("DUE") "RTN","BIPATUP1",167,0) ; "RTN","BIPATUP1",168,0) ;---> *** TRANSLATIONS OF INCOMING IMMSERVE VACCINES: "RTN","BIPATUP1",169,0) ;---> ------------------------------------------- "RTN","BIPATUP1",170,0) ; "RTN","BIPATUP1",171,0) ;********** PATCH 17, v8.5, MAR 01,2019, IHS/CMI/MWR "RTN","BIPATUP1",172,0) ;---> If TCH passes CVX 171 for Flu, change to 88, Flu,NOS. "RTN","BIPATUP1",173,0) S:A=171 A=88 "RTN","BIPATUP1",174,0) ; "RTN","BIPATUP1",175,0) ;---> Check to see if Site does not forecast this Vaccine Group. "RTN","BIPATUP1",176,0) Q:$D(BINF($$HL7TX^BIUTL2(A,1))) "RTN","BIPATUP1",177,0) ; "RTN","BIPATUP1",178,0) ;---> Filter for Site Parameter Flu Season Dates. "RTN","BIPATUP1",179,0) I A=88 Q:$$OUTFLU^BIPATUP3(BIFDT,BIDUZ2) "RTN","BIPATUP1",180,0) I $D(^BIVARR("INFLU",A)) Q:$$OUTFLU^BIPATUP3(BIFDT,BIDUZ2) "RTN","BIPATUP1",181,0) ; "RTN","BIPATUP1",182,0) ;********** PATCH 17, v8.5, JUL 01,2019, IHS/CMI/MWR "RTN","BIPATUP1",183,0) ;---> Do not forecast Men-B if site parameter has it turned off. "RTN","BIPATUP1",184,0) I '$$VGROUP^BIUTL2(19,3) Q:$D(^BIVARR("MEN",A,19)) "RTN","BIPATUP1",185,0) ;********** "RTN","BIPATUP1",186,0) ; "RTN","BIPATUP1",187,0) ;********** PATCH 18, v8.5, JUL 01,2019, IHS/CMI/MWR "RTN","BIPATUP1",188,0) ;---> Do not forecast MMR or Varicella if Patient is >18 yrs. "RTN","BIPATUP1",189,0) I $D(^BIVARR("MMRV",A)) Q:(BIAGEYRS>18) "RTN","BIPATUP1",190,0) ; "RTN","BIPATUP1",191,0) ;********** PATCH 21, v8.5, APR 01,2021, IHS/CMI/MWR "RTN","BIPATUP1",192,0) ;---> For Td,NOS (139) use Recommended Date, regardless of site parameter. "RTN","BIPATUP1",193,0) I $D(^BIVARR("TD","NOS",A)) Q:(BIFDT *** TDAP-TD FORECASTING: "RTN","BIPATUP1",197,0) ;---> -------------------- "RTN","BIPATUP1",198,0) ;---> If DTAP-Td-Tdap forecast, check & translate as needed. "RTN","BIPATUP1",199,0) ;V8.5 PATCH 29 - FID-107546 Adjust Td,NOS forecast "RTN","BIPATUP1",200,0) I $D(^BIVARR("DT",A))!$D(^BIVARR("TDAP",A))!$D(^BIVARR("TD",A)),BIAGEYRS>18 D TDAP "RTN","BIPATUP1",201,0) Q:BIQUIT "RTN","BIPATUP1",202,0) ;********** "RTN","BIPATUP1",203,0) ; "RTN","BIPATUP1",204,0) ;---> *** DROP-THROUGH TO HERE TO SET DUE: "RTN","BIPATUP1",205,0) ;---> -------------------------------- "RTN","BIPATUP1",206,0) ;---> Add this Immunization Due. "RTN","BIPATUP1",207,0) D SETDUE^BIPATUP2(BIDFN_U_$$HL7TX^BIUTL2(A)_U_U_D(1)_U_D(2)) "RTN","BIPATUP1",208,0) ; "RTN","BIPATUP1",209,0) ;---> Use BITCHAF to track TCH forecasting of Pneumo, Hep A and Hep B. "RTN","BIPATUP1",210,0) ; "RTN","BIPATUP1",211,0) ;---> Pneumo 33 OR 133 was forecast by TCH. "RTN","BIPATUP1",212,0) ;I (A=33)!(A=133) S BITCHAF=BITCHAF_1 "RTN","BIPATUP1",213,0) I $D(^BIVARR("PNEU",A)) S BITCHAF=BITCHAF_1 "RTN","BIPATUP1",214,0) ;---> Hep B was forecast by TCH. "RTN","BIPATUP1",215,0) ;I (A=45)!(A=189) S BITCHAF=BITCHAF_2 "RTN","BIPATUP1",216,0) I $D(^BIVARR("HEP B",A)) S BITCHAF=BITCHAF_2 "RTN","BIPATUP1",217,0) ;---> Hep A was forecast by TCH. "RTN","BIPATUP1",218,0) ;I A=85 S BITCHAF=BITCHAF_3 "RTN","BIPATUP1",219,0) I $D(^BIVARR("HEP A",A)) S BITCHAF=BITCHAF_3 "RTN","BIPATUP1",220,0) ; "RTN","BIPATUP1",221,0) ;********** PATCH 22, v8.5, OCT 24,2011, IHS/CMI/MWR "RTN","BIPATUP1",222,0) ;---> COVID was forecast by ICE. "RTN","BIPATUP1",223,0) I $D(^BIVARR("COV",A)) S BITCHAF=BITCHAF_4 "RTN","BIPATUP1",224,0) I $$HL7TX^BIUTL2(A,1)=21 S BITCHAF=BITCHAF_4 "RTN","BIPATUP1",225,0) ; "RTN","BIPATUP1",226,0) ;****** PATCH 26, v8.5, IHS/CMI/LAB "RTN","BIPATUP1",227,0) ;----> MEN B was forecast by ICE. "RTN","BIPATUP1",228,0) I $D(^BIVARR("MEN B",A)) S BITCHAF=BITCHAF_5 "RTN","BIPATUP1",229,0) I $$HL7TX^BIUTL2(A,1)=19 S BITCHAF=BITCHAF_5 "RTN","BIPATUP1",230,0) ; "RTN","BIPATUP1",231,0) Q "RTN","BIPATUP1",232,0) ;===== "RTN","BIPATUP1",233,0) ; "RTN","BIPATUP1",234,0) TDAP ;---> If DTAP-Td-Tdap forecast, check & translate as needed. "RTN","BIPATUP1",235,0) ;V8.5 PATCH 29 - FID-107546 Adjust Td,NOS forecast "RTN","BIPATUP1",236,0) N BIARRD,BIARRV,BIDOZE,BIHXX,N "RTN","BIPATUP1",237,0) S BIHXX=$P(BIHX,"~~~",2) "RTN","BIPATUP1",238,0) F N=1:1 S BIDOZE=$P(BIHXX,"|||",N) Q:(BIDOZE="") D "RTN","BIPATUP1",239,0) .; "RTN","BIPATUP1",240,0) .;---> Quit (discount dose) if Dose Override=Invalid, pc 4=2. "RTN","BIPATUP1",241,0) .Q:($P(BIDOZE,U,4)=2) "RTN","BIPATUP1",242,0) .; "RTN","BIPATUP1",243,0) .;---> Set up 2 arrays: (CVX,Date) and (Date,CVX). "RTN","BIPATUP1",244,0) .;---> e.g., BIARRD(20000301,115)="" "RTN","BIPATUP1",245,0) .N BIV,BID "RTN","BIPATUP1",246,0) .S BIV=$P(BIDOZE,U,2) "RTN","BIPATUP1",247,0) .S BID=$P(BIDOZE,U,3) "RTN","BIPATUP1",248,0) .; "RTN","BIPATUP1",249,0) .;S:$D(^BIVARR("TDAP",BIV))!$D(^BIVARR("TD",BIV))!$D(^BIVARR("DT",BIV)) BIARRV(BIV,+BID)="",BIARRD(+BID,BIV)="" "RTN","BIPATUP1",250,0) .S:$D(^BIVARR("GRP",8,BIV)) BIARRV(BIV,+BID)="",BIARRD(+BID,BIV)="" "RTN","BIPATUP1",251,0) ; "RTN","BIPATUP1",252,0) ;---> If pt never had Tdap, ICE will forecast it properly 6 mths after "RTN","BIPATUP1",253,0) ;---> any previous Td. So, if no Tdap hx, just quit. "RTN","BIPATUP1",254,0) Q:'$O(BIARRV(0)) "RTN","BIPATUP1",255,0) ; "RTN","BIPATUP1",256,0) ;---> Patient is >18, had Tdap (115), 10 yrs since, forecast Td_Adult (9). "RTN","BIPATUP1",257,0) N X "RTN","BIPATUP1",258,0) S X=($O(BIARRD(99999999),-1)-16900000) "RTN","BIPATUP1",259,0) ; "RTN","BIPATUP1",260,0) ;I X Not yet 10 yrs since a Tdap, block this dose. "RTN","BIPATUP1",263,0) S BIQUIT=1 "RTN","BIPATUP1",264,0) Q "RTN","BIPATUP1",265,0) ;===== "RTN","BIPATUP1",266,0) ; "RTN","BIPATUP2") 0^36^B117079189 "RTN","BIPATUP2",1,0) BIPATUP2 ;IHS/CMI/MWR - UPDATE PATIENT DATA 2; OCT 15, 2010 ; 22 Aug 2025 3:29 PM "RTN","BIPATUP2",2,0) ;;8.5;IMMUNIZATION;**22,26,29,30,31**;OCT 24,2011;Build 137 "RTN","BIPATUP2",3,0) ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS * "RTN","BIPATUP2",4,0) ;; IHS FORECAST. UPDATE PATIENT DATA, RETURN PROFILE. "RTN","BIPATUP2",5,0) ;; CALLED BY BIVWXICE. "RTN","BIPATUP2",6,0) ;; "RTN","BIPATUP2",7,0) ;;V8.5 PATCH 29 - FID-107546 Adjust Td,NOS forecast "RTN","BIPATUP2",8,0) ;;V8.5 PATCH 31 - FID-98855 Force zoster valid "RTN","BIPATUP2",9,0) ; "RTN","BIPATUP2",10,0) REPORT(BIDFN,BIFDT,BIDUZ2,BINF,BICT,BIH,BIFF,BIXMLV,BIPROF) ;EP "RTN","BIPATUP2",11,0) ;---> Parameters: "RTN","BIPATUP2",12,0) ; 1 - BIDFN (req) Patient's IEN (DFN) "RTN","BIPATUP2",13,0) ; 2 - BIFDT (req) Forecast Date (date used for forecast). "RTN","BIPATUP2",14,0) ; 3 - BIDUZ2 (req) User's DUZ(2) indicating site parameters. "RTN","BIPATUP2",15,0) ; 4 - BINF (opt) Array of Vaccine Grp IEN'S that should not be forecast. "RTN","BIPATUP2",16,0) ; 5 - BICT (opt) Array of patient's contraindications BICT(CVX) "RTN","BIPATUP2",17,0) ; 6 - BIH (req) Patient Imm History Evaluation from ICE. "RTN","BIPATUP2",18,0) ; 7 - BIFF (req) Patient Imm Forecast collated by Volume Group BIFF(VG,CVX). "RTN","BIPATUP2",19,0) ; 8 - BIXMLV (req) ICE Version Number. "RTN","BIPATUP2",20,0) ; 9 - BIPROF (ret) String containing Patient's ICE Report/Profile. "RTN","BIPATUP2",21,0) ; "RTN","BIPATUP2",22,0) ;---> Set base variables "RTN","BIPATUP2",23,0) N BIAGE,BIDOB,BINMV,BIRP,I,BIFDTICE "RTN","BIPATUP2",24,0) ;V8.5 PATCH 29 - FID-107546 Tdap age check "RTN","BIPATUP2",25,0) S BIDOB=$P(^DPT(BIDFN,0),U,3) "RTN","BIPATUP2",26,0) S BIAGE=+$$AGE^BIUTL1(BIDFN,1,BIFDT) "RTN","BIPATUP2",27,0) S BINMV=$S(BIAGE>18:1,1:0) "RTN","BIPATUP2",28,0) S BIFDTICE=BIFDT+17000000 ;FORECAST DATE IN YYYYMMDD/HL7 FORMAT "RTN","BIPATUP2",29,0) ; "RTN","BIPATUP2",30,0) ;--->Format Header "RTN","BIPATUP2",31,0) N % "RTN","BIPATUP2",32,0) D NOW^%DTC "RTN","BIPATUP2",33,0) S BIRP(1)="HLN ICE Forecaster v"_BIXMLV_" for: "_$$SLDT2^BIUTL5($G(BIFDT))_" (run: "_$$SLDT1^BIUTL5(%)_")" "RTN","BIPATUP2",34,0) S BIRP(2)=" " "RTN","BIPATUP2",35,0) ; "RTN","BIPATUP2",36,0) ;---> * * * HISTORY * * * "RTN","BIPATUP2",37,0) ;---> BITDAP - If Pt has valid Tdap then = 1 "RTN","BIPATUP2",38,0) ;---> BITDLST - Date of last Td/Tdap YYYYMMDD format "RTN","BIPATUP2",39,0) ;---> BITDNXT - Date of next Td/Tdap due YYYYMMDD format "RTN","BIPATUP2",40,0) ;---> BITDEVL - Td/Tdap evaluation "RTN","BIPATUP2",41,0) ;---> BIDTPS=n - Number of Peds Series DT's "RTN","BIPATUP2",42,0) ;---> BITDAS=n - Number of Adult Series Td's "RTN","BIPATUP2",43,0) ;---> ADT - Administered Date "RTN","BIPATUP2",44,0) ;---> ADTFM - Admin Date FileMan format YYYMMDD "RTN","BIPATUP2",45,0) ;---> ADTICE - Admin Date HL7 format YYYYMMDD "RTN","BIPATUP2",46,0) ;---> VAL - Validity Status - VALID/INVALID/ACCEPTED "RTN","BIPATUP2",47,0) ; "RTN","BIPATUP2",48,0) ;---> Collate by Volume Group, then date. "RTN","BIPATUP2",49,0) N BITDAP,BITDLST,BITDNXT,BITDEVL,BIDTPS,BITDAS "RTN","BIPATUP2",50,0) N I,ADT,VAL,ADTFM,ADTICE "RTN","BIPATUP2",51,0) S (BITDAP,BIDTPS,BITDAS)=0 "RTN","BIPATUP2",52,0) S (BITDLST,BITDEVL,ADT,ADTFM,ADTICE)="" "RTN","BIPATUP2",53,0) F J=5,10,27 S BITDNXT(J)="" "RTN","BIPATUP2",54,0) ;---> Save latest DTaP, Td, or Tdap. "RTN","BIPATUP2",55,0) S BITDLST=0 "RTN","BIPATUP2",56,0) N I,J,BIVG,BIVGO,BIHH,Y "RTN","BIPATUP2",57,0) S I=0 "RTN","BIPATUP2",58,0) F S I=$O(BIH(I)) Q:'I D "RTN","BIPATUP2",59,0) .N J "RTN","BIPATUP2",60,0) .S J=0 "RTN","BIPATUP2",61,0) .F S J=$O(BIH(I,J)) Q:'J D "RTN","BIPATUP2",62,0) ..;---> Concatenate Combo CVX. "RTN","BIPATUP2",63,0) ..N BIS,BIVG,BIVGO,Y "RTN","BIPATUP2",64,0) ..S BISP=$G(BIH(I,J,"SUPP")) "RTN","BIPATUP2",65,0) ..S Y=BIH(I,J) "RTN","BIPATUP2",66,0) ..S $P(Y,U,5)=$G(BIH(I,0)) "RTN","BIPATUP2",67,0) ..S CVX=+Y "RTN","BIPATUP2",68,0) ..S ADTICE=$P(Y,U,2) ;ADMIN DATE YYYYMMDD "RTN","BIPATUP2",69,0) ..S VAL=$P(Y,U,3) ;VALID/INVALID/ACCEPTED "RTN","BIPATUP2",70,0) ..S ADTFM=ADTICE-17000000 ;ADMIN DATE FM FORMAT "RTN","BIPATUP2",71,0) ..S BIVG=$$HL7TX^BIUTL2(CVX,1),BIVGO=$$VGROUP^BIUTL2(BIVG,4) "RTN","BIPATUP2",72,0) ..S BIHH(BIVGO,$P(Y,U,2),$P(Y,U))=Y "RTN","BIPATUP2",73,0) ..S BIHH(BIVGO,$P(Y,U,2),$P(Y,U),"SUPP")=$G(BISP) ;20220131 76219 "RTN","BIPATUP2",74,0) ..Q:'BINMV "RTN","BIPATUP2",75,0) ..Q:BIVG'=1&(BIVG'=8) "RTN","BIPATUP2",76,0) ..Q:"VALIDACCEPTED"'[VAL "RTN","BIPATUP2",77,0) ..S:$D(^BIVARR("GRP",1,CVX)) BIDTPS=BIDTPS+1,BIDTPS(BIDTPS)=ADTFM "RTN","BIPATUP2",78,0) ..Q:'$D(^BIVARR("GRP",8,CVX)) "RTN","BIPATUP2",79,0) ..S BITDEVL="" "RTN","BIPATUP2",80,0) ..S BITDAS=BITDAS+1 "RTN","BIPATUP2",81,0) ..S:ADTICE>BITDLST BITDLST=ADTICE "RTN","BIPATUP2",82,0) ..S BITDAP(BITDAS)=ADTFM "RTN","BIPATUP2",83,0) I BITDLST D "RTN","BIPATUP2",84,0) .S BITDNXT(10)=BITDLST+100000 "RTN","BIPATUP2",85,0) .S BITDNXT(5)=BITDLST+50000 "RTN","BIPATUP2",86,0) .S X1=BITDNXT(10)-17000000 "RTN","BIPATUP2",87,0) .S X2=27 "RTN","BIPATUP2",88,0) .D C^%DTC "RTN","BIPATUP2",89,0) .S BITDNXT(27)=X+17000000 "RTN","BIPATUP2",90,0) I BITDLST,$E(BITDLST,1,3)-$E(BIDOB,1,3)>11 Q "RTN","BIPATUP2",91,0) I $O(BITDAP(0))!$O(BIDTPS(0)),$O(BITDAP(999),-1)<2&(BIDTPS<4) S BITDEVL="* Tdap assumed completed. " "RTN","BIPATUP2",92,0) ; "RTN","BIPATUP2",93,0) N BILN "RTN","BIPATUP2",94,0) S BILN=2 "RTN","BIPATUP2",95,0) S BILN=BILN+1,BIRP(BILN)="-- IMM HISTORY EVALUATION -----------------------------------------------" "RTN","BIPATUP2",96,0) S BILN=BILN+1,BIRP(BILN)="" "RTN","BIPATUP2",97,0) S BILN=BILN+1,BIRP(BILN)=" Date CVX Vaccine (combo) Status - Reason" "RTN","BIPATUP2",98,0) S BILN=BILN+1,BIRP(BILN)="---------- --- -------------------- ------------------------------" "RTN","BIPATUP2",99,0) ; "RTN","BIPATUP2",100,0) ;---> Build History lines by Vaccine Group, then Date. "RTN","BIPATUP2",101,0) ;;V8.5 PATCH 31 - FID-98855 Force zoster valid "RTN","BIPATUP2",102,0) D RZVE ;EVALUATE RZV VAX'S "RTN","BIPATUP2",103,0) N I,J,K "RTN","BIPATUP2",104,0) S I=0 "RTN","BIPATUP2",105,0) F S I=$O(BIHH(I)) Q:'I D S BILN=BILN+1,BIRP(BILN)=" " "RTN","BIPATUP2",106,0) .;---> Vaccine Group Order. "RTN","BIPATUP2",107,0) .S J=0 "RTN","BIPATUP2",108,0) .F S J=$O(BIHH(I,J)) Q:'J D "RTN","BIPATUP2",109,0) ..;---> Date. "RTN","BIPATUP2",110,0) ..S K=0 "RTN","BIPATUP2",111,0) ..F S K=$O(BIHH(I,J,K)) Q:'K D "RTN","BIPATUP2",112,0) ...N BIHSU,Y,Z "RTN","BIPATUP2",113,0) ...S Y=BIHH(I,J,K) "RTN","BIPATUP2",114,0) ...S BIHSUP=$G(BIHH(I,J,K,"SUPP")) "RTN","BIPATUP2",115,0) ...;---> Date Administered. "RTN","BIPATUP2",116,0) ...S Z=$$DF($P(Y,U,2)) "RTN","BIPATUP2",117,0) ...;---> CVX and Vaccine Short Name. "RTN","BIPATUP2",118,0) ...S Z=Z_$J($P(Y,U),5)_" "_$$HL7TX^BIUTL2($P(Y,U),2) "RTN","BIPATUP2",119,0) ...I $P(Y,U)'=$P(Y,U,5) S Z=Z_" ("_$$HL7TX^BIUTL2($P(Y,U,5),2)_")" "RTN","BIPATUP2",120,0) ...S Z=$$PAD^BIUTL5(Z,41) "RTN","BIPATUP2",121,0) ...;---> Status (Valid, etc.) "RTN","BIPATUP2",122,0) ...S Z=Z_$P(Y,U,3) "RTN","BIPATUP2",123,0) ...; "RTN","BIPATUP2",124,0) ...;---> Reason (if too long, break at a space and write next line). "RTN","BIPATUP2",125,0) ...N X1,X2,X3,X4 "RTN","BIPATUP2",126,0) ...D BRKSP^BIUTL12($P(Y,U,4),.X1,.X2,.X3,.X4) "RTN","BIPATUP2",127,0) ...I X1]"" S Z=Z_": "_X1 "RTN","BIPATUP2",128,0) ...I X1="",$P(Y,U,3)="INVALID" S Z=Z_": Reason not given" "RTN","BIPATUP2",129,0) ...S BILN=BILN+1,BIRP(BILN)=Z "RTN","BIPATUP2",130,0) ...I X2]"" S BILN=BILN+1,BIRP(BILN)=$$SP^BIUTL5(41)_X2 "RTN","BIPATUP2",131,0) ...I X3]"" S BILN=BILN+1,BIRP(BILN)=$$SP^BIUTL5(41)_X3 "RTN","BIPATUP2",132,0) ...I X4]"" S BILN=BILN+1,BIRP(BILN)=$$SP^BIUTL5(41)_X4 "RTN","BIPATUP2",133,0) ...I $G(BIHSUP)]"" D HSUPP^BIPATUP5 ;20230201 76219 "RTN","BIPATUP2",134,0) ...;---> If another imm in this Vaccine Group follows, insert a space. "RTN","BIPATUP2",135,0) ...I X2]"",$O(BIHH(I,J)) S BILN=BILN+1,BIRP(BILN)="" "RTN","BIPATUP2",136,0) ; "RTN","BIPATUP2",137,0) ;---> * * * FORECAST * * * "RTN","BIPATUP2",138,0) N C,I "RTN","BIPATUP2",139,0) S C=0,I="" "RTN","BIPATUP2",140,0) F S I=$O(BIFF(I)) Q:(I="") D "RTN","BIPATUP2",141,0) .N J "RTN","BIPATUP2",142,0) .S J=0 "RTN","BIPATUP2",143,0) .F S J=$O(BIFF(I,J)) Q:'J D "RTN","BIPATUP2",144,0) ..I $G(BIFF(I,J,"SUPP"))]"" D "RTN","BIPATUP2",145,0) ...S BIFSUP(I,J,"SUPP")=$G(BIFF(I,J,"SUPP")) "RTN","BIPATUP2",146,0) ; "RTN","BIPATUP2",147,0) S BILN=BILN+1,BIRP(BILN)=" " "RTN","BIPATUP2",148,0) S BILN=BILN+1,BIRP(BILN)="" "RTN","BIPATUP2",149,0) S BILN=BILN+1,BIRP(BILN)="-- FORECAST -------------------------------------------------------------" "RTN","BIPATUP2",150,0) S BILN=BILN+1,BIRP(BILN)="",BILN=BILN+1,BIRP(BILN)="DUE:" "RTN","BIPATUP2",151,0) S BILN=BILN+1,BIRP(BILN)=" | Vaccine Status Earliest Recommended Overdue" "RTN","BIPATUP2",152,0) S BILN=BILN+1,BIRP(BILN)=" | ----------- ------- ---------- ----------- ----------" "RTN","BIPATUP2",153,0) ; "RTN","BIPATUP2",154,0) ;---> Build Forecast lines. "RTN","BIPATUP2",155,0) ;---> FIRST pass through BIFF: "RECOMMENDED" "RTN","BIPATUP2",156,0) N C,I "RTN","BIPATUP2",157,0) S C=0,I="" "RTN","BIPATUP2",158,0) F S I=$O(BIFF(I)) Q:(I="") D "RTN","BIPATUP2",159,0) .N J "RTN","BIPATUP2",160,0) .S J=0 "RTN","BIPATUP2",161,0) .F S J=$O(BIFF(I,J)) Q:'J D "RTN","BIPATUP2",162,0) ..N X,Y,Z "RTN","BIPATUP2",163,0) ..S Y=BIFF(I,J) "RTN","BIPATUP2",164,0) ..S FORC=$P(Y,U,5) "RTN","BIPATUP2",165,0) ..S COMP=$P(Y,U,6) "RTN","BIPATUP2",166,0) ..Q:FORC'="RECOMMENDED" "RTN","BIPATUP2",167,0) ..;---> Pass I & J in case this node needs to be reset "RTN","BIPATUP2",168,0) ..;---> to "FUTURE_RECOMMENDED". "RTN","BIPATUP2",169,0) ..D VACLINE^BIPATUP5(Y,BIFDT,BIDUZ2,BITDEVL,.BITDNXT,.BINF,.Z,.C,I,J) "RTN","BIPATUP2",170,0) ..Q:(Z="") "RTN","BIPATUP2",171,0) ..S BILN=BILN+1,BIRP(BILN)=Z "RTN","BIPATUP2",172,0) ; "RTN","BIPATUP2",173,0) I 'C S BILN=BILN+1,BIRP(BILN)=" | None" "RTN","BIPATUP2",174,0) S BILN=BILN+1,BIRP(BILN)=" " "RTN","BIPATUP2",175,0) ; "RTN","BIPATUP2",176,0) ;---> SECOND pass through BIFF: "FUTURE_RECOMMENDED" "RTN","BIPATUP2",177,0) S BILN=BILN+1,BIRP(BILN)="FUTURE:" "RTN","BIPATUP2",178,0) S BILN=BILN+1,BIRP(BILN)=" | Vaccine Status Earliest Recommended Overdue" "RTN","BIPATUP2",179,0) S BILN=BILN+1,BIRP(BILN)=" | ----------- ------- ---------- ----------- ----------" "RTN","BIPATUP2",180,0) N C,I "RTN","BIPATUP2",181,0) S C=0,I="" "RTN","BIPATUP2",182,0) F S I=$O(BIFF(I)) Q:(I="") D "RTN","BIPATUP2",183,0) .N J S J=0 "RTN","BIPATUP2",184,0) .F S J=$O(BIFF(I,J)) Q:'J D "RTN","BIPATUP2",185,0) ..N Y,Z,FORC "RTN","BIPATUP2",186,0) ..S Y=BIFF(I,J) "RTN","BIPATUP2",187,0) ..S FORC=$P(Y,U,5) "RTN","BIPATUP2",188,0) ..S COMP=$P(Y,U,6) "RTN","BIPATUP2",189,0) ..Q:FORC'="FUTURE_RECOMMENDED" "RTN","BIPATUP2",190,0) ..D VACLINE^BIPATUP5(Y,BIFDT,BIDUZ2,BITDEVL,.BITDNXT,.BINF,.Z,.C,I,J) "RTN","BIPATUP2",191,0) ..Q:(Z="") "RTN","BIPATUP2",192,0) ..S BILN=BILN+1,BIRP(BILN)=Z "RTN","BIPATUP2",193,0) ; "RTN","BIPATUP2",194,0) I 'C S BILN=BILN+1,BIRP(BILN)=" | None" "RTN","BIPATUP2",195,0) S BILN=BILN+1,BIRP(BILN)=" " "RTN","BIPATUP2",196,0) ; "RTN","BIPATUP2",197,0) ;---> THIRD pass through BIFF: "Complete" "RTN","BIPATUP2",198,0) S BILN=BILN+1,BIRP(BILN)="COMPLETE:" "RTN","BIPATUP2",199,0) S BILN=BILN+1,BIRP(BILN)=" | Vaccine Status" "RTN","BIPATUP2",200,0) S BILN=BILN+1,BIRP(BILN)=" | ----------- -------" "RTN","BIPATUP2",201,0) N C,I "RTN","BIPATUP2",202,0) S C=0,I="" "RTN","BIPATUP2",203,0) F S I=$O(BIFF(I)) Q:(I="") D "RTN","BIPATUP2",204,0) .N J S J=0 "RTN","BIPATUP2",205,0) .F S J=$O(BIFF(I,J)) Q:'J D "RTN","BIPATUP2",206,0) ..N Y,Z "RTN","BIPATUP2",207,0) ..S Y=BIFF(I,J) "RTN","BIPATUP2",208,0) ..N BICVX,FORC,COMP "RTN","BIPATUP2",209,0) ..S BICVX=$P(Y,U) "RTN","BIPATUP2",210,0) ..S FORC=$P(Y,U,5) "RTN","BIPATUP2",211,0) ..S COMP=$P(Y,U,6) "RTN","BIPATUP2",212,0) ..Q:FORC'="NOT_RECOMMENDED" "RTN","BIPATUP2",213,0) ..Q:COMP'="COMPLETE" "RTN","BIPATUP2",214,0) ..; "RTN","BIPATUP2",215,0) ..;---> Vaccine. "RTN","BIPATUP2",216,0) ..S Z=" | "_$$PAD^BIUTL5($$HL7TX^BIUTL2($P(Y,U),2),13),C=1 "RTN","BIPATUP2",217,0) ..; "RTN","BIPATUP2",218,0) ..;---> Status and Dates. "RTN","BIPATUP2",219,0) ..N BIST "RTN","BIPATUP2",220,0) ..S BIST=$S($P(Y,U,6)="COMPLETE":"Complete",1:$P(Y,U,6)) "RTN","BIPATUP2",221,0) ..S Z=Z_BIST "RTN","BIPATUP2",222,0) ..S C=1 "RTN","BIPATUP2",223,0) ..S BILN=BILN+1,BIRP(BILN)=Z "RTN","BIPATUP2",224,0) I 'C S BILN=BILN+1,BIRP(BILN)=" | None" "RTN","BIPATUP2",225,0) S BILN=BILN+1,BIRP(BILN)=" " "RTN","BIPATUP2",226,0) ; "RTN","BIPATUP2",227,0) ; "RTN","BIPATUP2",228,0) ;---> FOURTH, High Risk tacked on in IHSPOST^BIPATUP1. "RTN","BIPATUP2",229,0) ;---> Header for: "High Risk:" "RTN","BIPATUP2",230,0) S BILN=BILN+1,BIRP(BILN)="HIGH RISK:" "RTN","BIPATUP2",231,0) S BILN=BILN+1,BIRP(BILN)=" | Vaccine Status" "RTN","BIPATUP2",232,0) S BILN=BILN+1,BIRP(BILN)=" | ----------- -------" "RTN","BIPATUP2",233,0) ; "RTN","BIPATUP2",234,0) ;---> Build Report data string. "RTN","BIPATUP2",235,0) N I "RTN","BIPATUP2",236,0) S I=0 "RTN","BIPATUP2",237,0) F S I=$O(BIRP(I)) Q:'I D "RTN","BIPATUP2",238,0) .S BIPROF=BIPROF_BIRP(I)_"|||" "RTN","BIPATUP2",239,0) Q "RTN","BIPATUP2",240,0) ;===== "RTN","BIPATUP2",241,0) ; "RTN","BIPATUP2",242,0) DPROBS(BIFORC,BIPDSS,BIID) ;EP "RTN","BIPATUP2",243,0) ;---> Check for any Input Doses that have Dose Problems. "RTN","BIPATUP2",244,0) ;---> If any exist, build the string BIPDSS, concatenating the "RTN","BIPATUP2",245,0) ;---> Visit IEN's with U. "RTN","BIPATUP2",246,0) ;---> Parameters: "RTN","BIPATUP2",247,0) ; 1 - BIFORC (req) Forecast string coming back from TCH. "RTN","BIPATUP2",248,0) ; 2 - BIPDSS (ret) Returned string of V IMM IEN Problem Doses. "RTN","BIPATUP2",249,0) ; according to ImmServe. "RTN","BIPATUP2",250,0) ; 3 - BIID (ret) NO LONGER USED. Immserve "Number of Input Doses" (Field 109 in 2010). "RTN","BIPATUP2",251,0) ; "RTN","BIPATUP2",252,0) S BIPDSS="" "RTN","BIPATUP2",253,0) ; "RTN","BIPATUP2",254,0) ;---> NOTE: Pulling HX from TCH Output String (NOT RPMS Input string). "RTN","BIPATUP2",255,0) N BIFORC1,BIDOSE,N "RTN","BIPATUP2",256,0) S BIFORC1=$P(BIFORC,"~~~",3) "RTN","BIPATUP2",257,0) ; "RTN","BIPATUP2",258,0) F N=1:1 S BIDOSE=$P(BIFORC1,"|||",N) Q:(BIDOSE="") D "RTN","BIPATUP2",259,0) .;---> If this Input Dose was TCH-invalid (pc6), set V Imm IEN_%_CVX in "RTN","BIPATUP2",260,0) .;---> Problem Doses string (BIPDSS). "RTN","BIPATUP2",261,0) .; "RTN","BIPATUP2",262,0) .;---> Mods to flag only problem components of combo vaccines. "RTN","BIPATUP2",263,0) .; "RTN","BIPATUP2",264,0) .;---> Quit if this is not a problem dose. "RTN","BIPATUP2",265,0) .Q:('$P(BIDOSE,U,6)) "RTN","BIPATUP2",266,0) .; "RTN","BIPATUP2",267,0) .N BICVXS S BICVXS=$P(BIDOSE,U,7) "RTN","BIPATUP2",268,0) .;---> If piece 7 is null then not a combo, set BIPDSS and quit. "RTN","BIPATUP2",269,0) .;---> Strip TCH's leading zero, so it matches RPMS CVX ("03"=3). "RTN","BIPATUP2",270,0) .I 'BICVXS S BIPDSS=BIPDSS_$P(BIDOSE,U)_"%"_+$P(BIDOSE,U,2)_U Q "RTN","BIPATUP2",271,0) .; "RTN","BIPATUP2",272,0) .;--> Piece 7 equals one or more problem CVX's in this combo, delimited by comma. "RTN","BIPATUP2",273,0) .N J "RTN","BIPATUP2",274,0) .F J=1:1 S BICVX=$P(BICVXS,",",J) Q:'BICVX D "RTN","BIPATUP2",275,0) ..S BIPDSS=BIPDSS_$P(BIDOSE,U)_"%"_BICVX_U "RTN","BIPATUP2",276,0) Q "RTN","BIPATUP2",277,0) ;===== "RTN","BIPATUP2",278,0) ; "RTN","BIPATUP2",279,0) KILLDUE(BIDFN) ;EP "RTN","BIPATUP2",280,0) ;---> Clear out any previously set Immunizations Due and "RTN","BIPATUP2",281,0) ;---> any Forecasting Errors for this patient. "RTN","BIPATUP2",282,0) ;---> Hardcoded to improve performance during massive reports. "RTN","BIPATUP2",283,0) ;---> Parameters: "RTN","BIPATUP2",284,0) ; 1 - BIDFN (req) Patient IEN. "RTN","BIPATUP2",285,0) ; "RTN","BIPATUP2",286,0) Q:'BIDFN "RTN","BIPATUP2",287,0) ; "RTN","BIPATUP2",288,0) ;---> Clear previous Immunizations Due. "RTN","BIPATUP2",289,0) D:$D(^BIPDUE("B",BIDFN)) "RTN","BIPATUP2",290,0) .N N "RTN","BIPATUP2",291,0) .S N=0 "RTN","BIPATUP2",292,0) .F S N=$O(^BIPDUE("B",BIDFN,N)) Q:'N D "RTN","BIPATUP2",293,0) ..N Y,Z S Y=$G(^BIPDUE(N,0)) "RTN","BIPATUP2",294,0) ..K ^BIPDUE(N),^BIPDUE("B",BIDFN,N) "RTN","BIPATUP2",295,0) ..Q:Y="" "RTN","BIPATUP2",296,0) ..S Z=$P(Y,U,4) K:Z ^BIPDUE("D",Z,N) "RTN","BIPATUP2",297,0) ..S Z=$P(Y,U,5) K:Z ^BIPDUE("D",Z,N) "RTN","BIPATUP2",298,0) ..S $P(^BIPDUE(0),U,4)=$P(^BIPDUE(0),U,4)-1 "RTN","BIPATUP2",299,0) ..; "RTN","BIPATUP2",300,0) ..;********** PATCH 13, v8.5, AUG 01,2016, IHS/CMI/MWR "RTN","BIPATUP2",301,0) ..;---> Kill "C" xref on 2nd pc, Vaccine IEN. "RTN","BIPATUP2",302,0) ..S Z=$P(Y,U,2) K:Z ^BIPDUE("C",Z,N) "RTN","BIPATUP2",303,0) ..;********** "RTN","BIPATUP2",304,0) ..; "RTN","BIPATUP2",305,0) .K ^BIPDUE("B",BIDFN),^BIPDUE("E",BIDFN) "RTN","BIPATUP2",306,0) ; "RTN","BIPATUP2",307,0) ;---> Clear previous Forecasting Errors. "RTN","BIPATUP2",308,0) D:$D(^BIPERR("B",BIDFN)) "RTN","BIPATUP2",309,0) .N N "RTN","BIPATUP2",310,0) .S N=0 "RTN","BIPATUP2",311,0) .F S N=$O(^BIPERR("B",BIDFN,N)) Q:'N D "RTN","BIPATUP2",312,0) ..K ^BIPERR("B",BIDFN,N),^BIPERR(N) "RTN","BIPATUP2",313,0) ..S $P(^BIPERR(0),U,4)=$P(^BIPERR(0),U,4)-1 "RTN","BIPATUP2",314,0) .K ^BIPERR("B",BIDFN) "RTN","BIPATUP2",315,0) Q "RTN","BIPATUP2",316,0) ; "RTN","BIPATUP2",317,0) ;---------- "RTN","BIPATUP2",318,0) IMMSDT(DATE) ;EP "RTN","BIPATUP2",319,0) ;---> Convert Immserve Date (format MMDDYYYY) TO FILEMAN "RTN","BIPATUP2",320,0) ;---> Internal format. "RTN","BIPATUP2",321,0) Q:'$G(DATE) "NO DATE" "RTN","BIPATUP2",322,0) Q ($E(DATE,5,9)-1700)_$E(DATE,1,2)_$E(DATE,3,4) "RTN","BIPATUP2",323,0) ;===== "RTN","BIPATUP2",324,0) ; "RTN","BIPATUP2",325,0) PNMAGE(BISITE) ;EP - Return Age Appropriate in years for Pneumo at this site. "RTN","BIPATUP2",326,0) ;---> Parameters: "RTN","BIPATUP2",327,0) ; 1 - BISITE (req) User's DUZ(2) "RTN","BIPATUP2",328,0) ; "RTN","BIPATUP2",329,0) Q:'$G(BISITE) "65" "RTN","BIPATUP2",330,0) N Y "RTN","BIPATUP2",331,0) S Y=$P($G(^BISITE(BISITE,0)),U,10) S:'Y Y=65 "RTN","BIPATUP2",332,0) Q Y "RTN","BIPATUP2",333,0) ;===== "RTN","BIPATUP2",334,0) ; "RTN","BIPATUP2",335,0) FLUALL(BISITE) ;EP - Return 1 to forecast Flu for ALL ages. "RTN","BIPATUP2",336,0) ;---> Parameters: "RTN","BIPATUP2",337,0) ; 1 - BISITE (req) User's DUZ(2) "RTN","BIPATUP2",338,0) ; "RTN","BIPATUP2",339,0) Q:'$G(BISITE) 1 "RTN","BIPATUP2",340,0) N Y S Y=$P($G(^BISITE(BISITE,0)),U,27) "RTN","BIPATUP2",341,0) Q:(Y=0) 0 "RTN","BIPATUP2",342,0) Q 1 "RTN","BIPATUP2",343,0) ;===== "RTN","BIPATUP2",344,0) ; "RTN","BIPATUP2",345,0) ; "RTN","BIPATUP2",346,0) ZOSTER(BISITE) ;EP - Return 1 if Zostervax should be forecast. "RTN","BIPATUP2",347,0) ;---> Parameters: "RTN","BIPATUP2",348,0) ; 1 - BISITE (req) User's DUZ(2) "RTN","BIPATUP2",349,0) ; "RTN","BIPATUP2",350,0) Q:'$G(BISITE) 1 "RTN","BIPATUP2",351,0) N Y S Y=$P($G(^BISITE(BISITE,0)),U,29) "RTN","BIPATUP2",352,0) Q:(Y=0) 0 "RTN","BIPATUP2",353,0) Q 1 "RTN","BIPATUP2",354,0) ;===== "RTN","BIPATUP2",355,0) ; "RTN","BIPATUP2",356,0) SETDUE(BIDATA) ;EP "RTN","BIPATUP2",357,0) ;---> Add this Immunization to BI PATIENT IMM DUE File #9002084.1. "RTN","BIPATUP2",358,0) ;---> Parameters: "RTN","BIPATUP2",359,0) ; 1 - BIDATA (req) Data string (5 fields) for 0-node. "RTN","BIPATUP2",360,0) ; BIDFN^Vaccine IEN^Dose#^Recommended Date^Date Past Due "RTN","BIPATUP2",361,0) ; "RTN","BIPATUP2",362,0) Q:$G(BIDATA)="" "RTN","BIPATUP2",363,0) N A,B,BIDFN,M,N "RTN","BIPATUP2",364,0) S M=^BIPDUE(0),N=$P(M,U,3),M=$P(M,U,4) S:'N N=1 "RTN","BIPATUP2",365,0) F Q:'$D(^BIPDUE(N)) S N=N+1 "RTN","BIPATUP2",366,0) S BIDFN=$P(BIDATA,U) "RTN","BIPATUP2",367,0) Q:'BIDFN "RTN","BIPATUP2",368,0) ; "RTN","BIPATUP2",369,0) ;********** PATCH 19, v8.5, JUN 01,2020, IHS/CMI/MWR "RTN","BIPATUP2",370,0) ;---> Set 6th piece equal to Date.Time (to seconds). "RTN","BIPATUP2",371,0) ;S ^BIPDUE(N,0)=BIDATA "RTN","BIPATUP2",372,0) N %,X "RTN","BIPATUP2",373,0) D NOW^%DTC "RTN","BIPATUP2",374,0) S ^BIPDUE(N,0)=BIDATA_"^"_% "RTN","BIPATUP2",375,0) ;********** "RTN","BIPATUP2",376,0) ; "RTN","BIPATUP2",377,0) ;********** PATCH 1, v8.3.1, Dec 30,2008, IHS/CMI/MWR "RTN","BIPATUP2",378,0) ;---> Add 6th pc, Date Forecast Calculated. "RTN","BIPATUP2",379,0) ;S:$G(DT) $P(^BIPDUE(N,0),U,6)=DT "RTN","BIPATUP2",380,0) ;********** "RTN","BIPATUP2",381,0) ; "RTN","BIPATUP2",382,0) S ^BIPDUE("B",BIDFN,N)="" "RTN","BIPATUP2",383,0) S A=$P(BIDATA,U,4),B=$P(BIDATA,U,5) "RTN","BIPATUP2",384,0) I A S ^BIPDUE("D",A,N)="" "RTN","BIPATUP2",385,0) I B S ^BIPDUE("D",B,N)="",^BIPDUE("E",BIDFN,B,N)="" "RTN","BIPATUP2",386,0) ; "RTN","BIPATUP2",387,0) ;********** PATCH 13, v8.5, AUG 01,2016, IHS/CMI/MWR "RTN","BIPATUP2",388,0) ;---> Add "C" xref on 2nd pc, Vaccine IEN. "RTN","BIPATUP2",389,0) N V S V=$P(BIDATA,U,2) "RTN","BIPATUP2",390,0) I V S ^BIPDUE("C",V,N)="" "RTN","BIPATUP2",391,0) ;********** "RTN","BIPATUP2",392,0) ; "RTN","BIPATUP2",393,0) S $P(^BIPDUE(0),U,3,4)=N_U_(M+1) "RTN","BIPATUP2",394,0) Q "RTN","BIPATUP2",395,0) ; "RTN","BIPATUP2",396,0) DF(BIDT) ;EP "RTN","BIPATUP2",397,0) Q $$ICEDATE^BIUTL5(BIDT) "RTN","BIPATUP2",398,0) ; "RTN","BIPATUP2",399,0) RZVE ;V8.5 PATCH 31 - FID-98855 Force RZV valid "RTN","BIPATUP2",400,0) N X,Y,A,X0,J "RTN","BIPATUP2",401,0) S J=0 "RTN","BIPATUP2",402,0) S X=0 "RTN","BIPATUP2",403,0) F S X=$O(BIHH(87,X)) Q:'X D "RTN","BIPATUP2",404,0) .S J=J+1 "RTN","BIPATUP2",405,0) .S X0=$G(BIHH(87,X,187)) "RTN","BIPATUP2",406,0) .S EVAL(J)=X0 "RTN","BIPATUP2",407,0) Q:J<2 "RTN","BIPATUP2",408,0) S E1=EVAL(1) "RTN","BIPATUP2",409,0) S D1=$P(E1,U,2) "RTN","BIPATUP2",410,0) S J2=$O(EVAL(99999),-1) "RTN","BIPATUP2",411,0) S E2=EVAL(J2) "RTN","BIPATUP2",412,0) S D2=$P(E2,U,2) "RTN","BIPATUP2",413,0) S X1=D2-17000000 "RTN","BIPATUP2",414,0) S X2=D1-17000000 "RTN","BIPATUP2",415,0) D D^%DTC "RTN","BIPATUP2",416,0) I X<28 D "RTN","BIPATUP2",417,0) .S BIFF(87,187)="187^^INVALID^Interval between doses less than 4 weeks" "RTN","BIPATUP2",418,0) .S $P(BIHH(87,D2,187),U,4)="Interval between doses less than 4 weeks" "RTN","BIPATUP2",419,0) I X>27,$P(E1,U,3)="VALID" D "RTN","BIPATUP2",420,0) .S BIFF(87,187)="187^^VALID^^NOT_RECOMMENDED^COMPLETE" "RTN","BIPATUP2",421,0) .S BIHH(87,D2,187)=187_U_D2_U_"VALID^^187" "RTN","BIPATUP2",422,0) Q "RTN","BIPATUP2",423,0) ;===== "RTN","BIPATUP2",424,0) ; "RTN","BIPATUP3") 0^37^B46816605 "RTN","BIPATUP3",1,0) BIPATUP3 ;IHS/CMI/MWR - UPDATE PATIENT DATA 2; DEC 15, 2011 [ 07/14/2025 11:12 PM ] ; 27 Aug 2025 11:09 PM "RTN","BIPATUP3",2,0) ;;8.5;IMMUNIZATION;**22,26,31**;OCT 24,2011;Build 137 "RTN","BIPATUP3",3,0) ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS * "RTN","BIPATUP3",4,0) ;; IHS FORECAST. UPDATE PATIENT DATA, IMM FORECAST IN ^BIPDUE(. "RTN","BIPATUP3",5,0) ;; HOLDING RTN IN CASE H1N1 (OR SIMILAR) FORECASTING IS NEEDED IN THE FUTURE. "RTN","BIPATUP3",6,0) ;; PATCH 1: Clarify Report explanation. IHSZOS+19 "RTN","BIPATUP3",7,0) ;; PATCH 4, v8.5: Use newer Related Contraindications call to determine "RTN","BIPATUP3",8,0) ;; contraindicaton. IHSZOS+29 "RTN","BIPATUP3",9,0) ;; PATCH 14: Move IHSPNEU & IHSHEPB call here from BIPATUP1 IHSPNEU+00 "RTN","BIPATUP3",10,0) ;; PATCH 17: Ensure and document High Risk Pneumo only satisfied by CVX 33. IHSPNEU+50 "RTN","BIPATUP3",11,0) ;; PATCH 22: COVID Immunocompromised forecasting. IHSCOV "RTN","BIPATUP3",12,0) ; "RTN","BIPATUP3",13,0) ; "RTN","BIPATUP3",14,0) ; "RTN","BIPATUP3",15,0) ;********** PATCH 14, v8.5, AUG 01,2017, IHS/CMI/MWR "RTN","BIPATUP3",16,0) ;---> Move IHSPNEU & IHSHEPB calls from rtn BIPATUP1 and add BIADDND to pass "RTN","BIPATUP3",17,0) ;---> back IHS Addendum text. "RTN","BIPATUP3",18,0) ;---------- "RTN","BIPATUP3",19,0) IHSPNEU(BIDFN,BIFLU,BIFFLU,BINF,BIFDT,BIAGE,BIDUZ2,BIRISKF,BIADDND) ;EP "RTN","BIPATUP3",20,0) ;---> IHS Pneumo Forecast. "RTN","BIPATUP3",21,0) ;---> Parameters: "RTN","BIPATUP3",22,0) ; 1 - BIDFN (req) Patient IEN. "RTN","BIPATUP3",23,0) ; 2 - BIFLU (req) Pneumo History array: BIFLU(CVX,INVDATE). "RTN","BIPATUP3",24,0) ; 3 - BIFFLU (req) If =2, for force Pneumo regardless of age. "RTN","BIPATUP3",25,0) ; 4 - BINF (opt) Array of Vaccine Grp IEN'S that should not be forecast. "RTN","BIPATUP3",26,0) ; 5 - BIFDT (req) Forecast Date (date used for forecast). "RTN","BIPATUP3",27,0) ; 6 - BIAGE (req) Patient Age in years for this Forecast Date. "RTN","BIPATUP3",28,0) ; 7 - BIDUZ2 (req) User's DUZ(2) indicating Immserve Forc Rules. "RTN","BIPATUP3",29,0) ; 5 - BIRISKF (req) 1=Patient has High Risk of Pneumo; otherwise 0. "RTN","BIPATUP3",30,0) ; 8 - BIADDND (ret) IHS forecasting addendum (to be added to TCH Report). "RTN","BIPATUP3",31,0) ; "RTN","BIPATUP3",32,0) ;---> NOTE: This call does NOT even get made if TCH has already forecast Pneumo "RTN","BIPATUP3",33,0) ;---> (LDFORC+72^BIPATUP1). "RTN","BIPATUP3",34,0) ; "RTN","BIPATUP3",35,0) ;---> Quit if Forecasting turned off for Pneumo. "RTN","BIPATUP3",36,0) Q:$D(BINF(11)) "RTN","BIPATUP3",37,0) ; "RTN","BIPATUP3",38,0) ;---> Quit if this patient has a contraindication to Pneumo. "RTN","BIPATUP3",39,0) ;********** PATCH 4, v8.5, DEC 01,2012, IHS/CMI/MWR "RTN","BIPATUP3",40,0) N BICT D CONTRA^BIUTL11(BIDFN,.BICT) "RTN","BIPATUP3",41,0) Q:$D(BICT(33)) ;suryam said to leave this alone for now per email late January "RTN","BIPATUP3",42,0) ;********** "RTN","BIPATUP3",43,0) ; "RTN","BIPATUP3",44,0) ;---> Quit if this Pt Age <5 yrs or >65 yrs, regardless of risk. "RTN","BIPATUP3",45,0) Q:((BIAGE<5)!(BIAGE>64)) "RTN","BIPATUP3",46,0) ; "RTN","BIPATUP3",47,0) ;---> Flag to indicate Pneumo already set. "RTN","BIPATUP3",48,0) N BIFLAG S BIFLAG=0 "RTN","BIPATUP3",49,0) ; "RTN","BIPATUP3",50,0) ;---> EARLY PNEUMO * * * "RTN","BIPATUP3",51,0) ;---> Forecast Early Pneumo per Site Parameter. "RTN","BIPATUP3",52,0) D "RTN","BIPATUP3",53,0) .;---> Quit if patient has had ANY Pneumo (NOT just 33 for High Risk). "RTN","BIPATUP3",54,0) .N A,Z "RTN","BIPATUP3",55,0) .S Z=0 "RTN","BIPATUP3",56,0) .S A=0 "RTN","BIPATUP3",57,0) .F S X=$O(^BIVARR("PNEU",A)) Q:'Z D "RTN","BIPATUP3",58,0) ..I $D(BIFLU(A)) S Z=1 "RTN","BIPATUP3",59,0) .;Q:Z "RTN","BIPATUP3",60,0) .;---> BIPNAGE=Site Parameter Age to forecast Pneumo ("Pneumo Age") in years. "RTN","BIPATUP3",61,0) .N BIPNAGE "RTN","BIPATUP3",62,0) .S BIPNAGE=$P($$PNMAGE^BIPATUP2(BIDUZ2),U) "RTN","BIPATUP3",63,0) .;---> Quit if patient is less than site parameter age. "RTN","BIPATUP3",64,0) .Q:(BIAGE Set patient due for Pneumo. "RTN","BIPATUP3",66,0) .D SETDUE^BIPATUP2(BIDFN_U_$$HL7TX^BIUTL2(33)_U_BIFDT) "RTN","BIPATUP3",67,0) .S BIADDND=$G(BIADDND)_" | PNEUMO Added per Site Parameter #11 (early Pneumo: " "RTN","BIPATUP3",68,0) .S BIADDND=BIADDND_BIPNAGE_" yrs)." "RTN","BIPATUP3",69,0) .S BIFLAG=1 "RTN","BIPATUP3",70,0) .S BIRISKF=1,BIRPROF(+$$BIRPROF(33))=1 "RTN","BIPATUP3",71,0) ; "RTN","BIPATUP3",72,0) Q:BIFLAG "RTN","BIPATUP3",73,0) ; "RTN","BIPATUP3",74,0) ;********** PATCH 17, v8.5, MAR 01,2019, IHS/CMI/MWR "RTN","BIPATUP3",75,0) ;---> Confirm and document High Risk Pneumo satisfied by CVX 33, 215, 216. "RTN","BIPATUP3",76,0) ;---> If 33, 215, 216 is in Imm Hx, BIFLU(33), BIFLU(215), BIFLU(216), IHSPOST+70^BIPATUP1, this call is never made. "RTN","BIPATUP3",77,0) ; "RTN","BIPATUP3",78,0) ;---> HIGH RISK * * * "RTN","BIPATUP3",79,0) ;---> Forecast Pneumo if patient has high risk medical conditions and no previous 33, 215, 216. "RTN","BIPATUP3",80,0) ; "RTN","BIPATUP3",81,0) ;---> NOTE: BIFFLU=4 "Disregard Risk Factors" checked at IHSPOST+52^BIPATUP1. "RTN","BIPATUP3",82,0) ;---> If High Risk Pneumo or Forecast for this patient regardless of Age. "RTN","BIPATUP3",83,0) I BIRISKF!(BIFFLU=2) D "RTN","BIPATUP3",84,0) .D SETDUE^BIPATUP2(BIDFN_U_$$HL7TX^BIUTL2(33)_U_BIFDT) "RTN","BIPATUP3",85,0) .I BIRISKF S BIADDND=$G(BIADDND)_" | PNEUMO Added for High Risk Medical Conditions.|||" Q "RTN","BIPATUP3",86,0) .S BIADDND=$G(BIADDND)_" | PNEUMO Added due to manual edit of High Risk for this patient.|||" "RTN","BIPATUP3",87,0) .S BIRISKF=1,BIRPROF(+$$BIRPROF(33))=1 "RTN","BIPATUP3",88,0) ; "RTN","BIPATUP3",89,0) Q "RTN","BIPATUP3",90,0) ; "RTN","BIPATUP3",91,0) ; "RTN","BIPATUP3",92,0) ;---------- "RTN","BIPATUP3",93,0) IHSHEPB(BIDFN,BINF,BIFDT,BIADDNT,BIADDND) ;EP "RTN","BIPATUP3",94,0) ;---> HS Forecast Hep B. "RTN","BIPATUP3",95,0) ;---> Parameters: "RTN","BIPATUP3",96,0) ; 1 - BIDFN (req) Patient IEN. "RTN","BIPATUP3",97,0) ; 2 - BINF (opt) Array of Vaccine Grp IEN'S that should not be forecast. "RTN","BIPATUP3",98,0) ; 3 - BIFDT (req) Forecast Date (date used for forecast). "RTN","BIPATUP3",99,0) ; 4 - BIADDNT (opt) Addendum Note parameter: 1=Diabetes, 2=CLD/HepC. "RTN","BIPATUP3",100,0) ; 5 - BIADDND (ret) IHS forecasting addendum (to be added to TCH Report). "RTN","BIPATUP3",101,0) ; "RTN","BIPATUP3",102,0) ;---> Quit if Forecasting turned off for Hep B. "RTN","BIPATUP3",103,0) Q:$D(BINF(4)) "RTN","BIPATUP3",104,0) ; "RTN","BIPATUP3",105,0) ;---> Quit if this patient has a contraindication to Hep B. "RTN","BIPATUP3",106,0) N BICT "RTN","BIPATUP3",107,0) D CONTRA^BIUTL11(BIDFN,.BICT) "RTN","BIPATUP3",108,0) Q:$D(BICT(45)) "RTN","BIPATUP3",109,0) ; "RTN","BIPATUP3",110,0) D SETDUE^BIPATUP2(BIDFN_U_$$HL7TX^BIUTL2(45)_U_BIFDT) "RTN","BIPATUP3",111,0) S BIADDND=$G(BIADDND)_" | Hep B Added for High Risk" "RTN","BIPATUP3",112,0) I $G(BIADDNT)=1 S BIADDND=BIADDND_" due to Diabetes.|||" "RTN","BIPATUP3",113,0) I $G(BIADDNT)=2 S BIADDND=BIADDND_" due to CLD/Hep C.|||" "RTN","BIPATUP3",114,0) S BIRISKF=1,BIRPROF(+$$BIRPROF(45))=1 "RTN","BIPATUP3",115,0) Q "RTN","BIPATUP3",116,0) ; "RTN","BIPATUP3",117,0) ; "RTN","BIPATUP3",118,0) ;---------- "RTN","BIPATUP3",119,0) IHSHEPA(BIDFN,BINF,BIFDT,BIADDNT,BIADDND) ;EP "RTN","BIPATUP3",120,0) ;---> IHS Forecast Hep A. "RTN","BIPATUP3",121,0) ;---> Parameters: "RTN","BIPATUP3",122,0) ; 1 - BIDFN (req) Patient IEN. "RTN","BIPATUP3",123,0) ; 2 - BINF (opt) Array of Vaccine Grp IEN'S that should not be forecast. "RTN","BIPATUP3",124,0) ; 3 - BIFDT (req) Forecast Date (date used for forecast). "RTN","BIPATUP3",125,0) ; 4 - BIADDNT (opt) Addendum Note parameter: not used for Hep A at this time. "RTN","BIPATUP3",126,0) ; 5 - BIADDND (ret) IHS forecasting addendum (to be added to TCH Report). "RTN","BIPATUP3",127,0) ; "RTN","BIPATUP3",128,0) ;---> Quit if Forecasting turned off for Hep A. "RTN","BIPATUP3",129,0) Q:$D(BINF(9)) "RTN","BIPATUP3",130,0) ; "RTN","BIPATUP3",131,0) ;---> Quit if this patient has a contraindication to Hep B. "RTN","BIPATUP3",132,0) N BICT D CONTRA^BIUTL11(BIDFN,.BICT) "RTN","BIPATUP3",133,0) Q:$D(BICT(85)) "RTN","BIPATUP3",134,0) ; "RTN","BIPATUP3",135,0) D SETDUE^BIPATUP2(BIDFN_U_$$HL7TX^BIUTL2(85)_U_BIFDT) "RTN","BIPATUP3",136,0) S BIADDND=$G(BIADDND)_" | Hep A Added for High Risk due to CLD/Hep C.|||" "RTN","BIPATUP3",137,0) S BIRISKF=1,BIRPROF(+$$BIRPROF(85))=1 "RTN","BIPATUP3",138,0) Q "RTN","BIPATUP3",139,0) ; "RTN","BIPATUP3",140,0) ;********** PATCH 22, v8.5, OCT 24,2011, IHS/CMI/MWR "RTN","BIPATUP3",141,0) ;---> IHS COVID Immunocompromised forecasting. "RTN","BIPATUP3",142,0) ; "RTN","BIPATUP3",143,0) ;---------- "RTN","BIPATUP3",144,0) IHSCOV(BIDFN,BINF,BIFDT,BICVX,BIADDND) ;EP "RTN","BIPATUP3",145,0) ;---> IHS Forecast COVID Immunocompromised. "RTN","BIPATUP3",146,0) ;---> Parameters: "RTN","BIPATUP3",147,0) ; 1 - BIDFN (req) Patient IEN. "RTN","BIPATUP3",148,0) ; 2 - BINF (opt) Array of Vaccine Grp IEN'S that should not be forecast. "RTN","BIPATUP3",149,0) ; 3 - BIFDT (req) Forecast Date (date used for forecast). "RTN","BIPATUP3",150,0) ; 4 - BICVX (opt) CVX of specific COVID Vaccine to be forecast (Mod or Pfz). "RTN","BIPATUP3",151,0) ; 5 - BIADDND (ret) IHS forecasting addendum (to be added to TCH Report). "RTN","BIPATUP3",152,0) ; "RTN","BIPATUP3",153,0) ;---> Quit if Forecasting turned off for COVID. "RTN","BIPATUP3",154,0) Q:$D(BINF(21)) "RTN","BIPATUP3",155,0) ; "RTN","BIPATUP3",156,0) ;---> Quit if this patient has a contraindication to COVID. "RTN","BIPATUP3",157,0) N BICT "RTN","BIPATUP3",158,0) D CONTRA^BIUTL11(BIDFN,.BICT) "RTN","BIPATUP3",159,0) Q:$D(BICT(213)) "RTN","BIPATUP3",160,0) ; "RTN","BIPATUP3",161,0) ;---> If COVID CVX not specified, forecast COVID,NOS. "RTN","BIPATUP3",162,0) S:'$G(BICVX) BICVX=213 "RTN","BIPATUP3",163,0) ; "RTN","BIPATUP3",164,0) D SETDUE^BIPATUP2(BIDFN_U_$$HL7TX^BIUTL2(BICVX)_U_BIFDT) "RTN","BIPATUP3",165,0) S BIADDND=$G(BIADDND)_" | "_$$HL7TX^BIUTL2(BICVX,2)_" Added for Immunocompromised.|||" "RTN","BIPATUP3",166,0) S (BIRISKF,BIRISKC)=1,BIRPROF(+$$BIRPROF(213))=1 "RTN","BIPATUP3",167,0) Q "RTN","BIPATUP3",168,0) ; "RTN","BIPATUP3",169,0) ; "RTN","BIPATUP3",170,0) ;---------- "RTN","BIPATUP3",171,0) IHSH1N1(BIDFN,BIFLU,BIFFLU,BIRISKI,BINF,BIFDT,BIAGE,BIIMMH1,BILIVE) ;EP "RTN","BIPATUP3",172,0) ;---> IHS H1N1 Forecast. "RTN","BIPATUP3",173,0) ;---> Parameters: "RTN","BIPATUP3",174,0) ; 1 - BIDFN (req) Patient IEN. "RTN","BIPATUP3",175,0) ; 2 - BIFLU (req) Influ, Pneumo, and H1N1 History array: BIFLU(CVX,INVDATE). "RTN","BIPATUP3",176,0) ; 3 - BIFFLU (req) * NOT USED FOR NOW! * "RTN","BIPATUP3",177,0) ; Value (0-4) for force Flu/Pneumo regardless of age. "RTN","BIPATUP3",178,0) ; 4 - BIRISKI (req) 1=Patient has Risk of Influenza; otherwise 0. "RTN","BIPATUP3",179,0) ; 5 - BINF (opt) Array of Vaccine Grp IEN'S that should not be forecast. "RTN","BIPATUP3",180,0) ; 6 - BIFDT (req) Forecast Date (date used for forecast). "RTN","BIPATUP3",181,0) ; 7 - BIAGE (req) Patient Age in months for this Forecast Date. "RTN","BIPATUP3",182,0) ; 8 - BIIMMH1 (opt) BIIMMFL=1 means Immserve already forecast H1N1. "RTN","BIPATUP3",183,0) ; 9 - BILIVE (opt) 1-Patient received a LIVE vaccine <28 days before "RTN","BIPATUP3",184,0) ; the forecast date. "RTN","BIPATUP3",185,0) ; "RTN","BIPATUP3",186,0) ;---> Quit if Forecasting turned off for H1N1. "RTN","BIPATUP3",187,0) Q:$D(BINF(18)) "RTN","BIPATUP3",188,0) ; "RTN","BIPATUP3",189,0) ;---> Quit if Immserve already forecast H1N1. "RTN","BIPATUP3",190,0) Q:$G(BIIMMH1) "RTN","BIPATUP3",191,0) ; "RTN","BIPATUP3",192,0) ;*********************************************************** "RTN","BIPATUP3",193,0) ;********** PATCH 4, v8.3, DEC 30,2009, IHS/CMI/MWR "RTN","BIPATUP3",194,0) ;---> PATCH: No longer consider live vaccine factor in H1N1 forecasting. "RTN","BIPATUP3",195,0) ;---> Quit if patient received a LIVE vaccine <28 days before forecast date. "RTN","BIPATUP3",196,0) ;---> Also quit if patient received Flu-nasal CVX 111 on the Forecast Date. "RTN","BIPATUP3",197,0) ;Q:$G(BILIVE) "RTN","BIPATUP3",198,0) ;*********************************************************** "RTN","BIPATUP3",199,0) ; "RTN","BIPATUP3",200,0) ;---> Set numeric Year, Month, and MonthDay. "RTN","BIPATUP3",201,0) N BIYEAR,BIMTH,BIMDAY "RTN","BIPATUP3",202,0) S BIYEAR=$E(BIFDT,1,3),BIMTH=$E(BIFDT,4,5),BIMDAY=+$E(BIFDT,4,7) "RTN","BIPATUP3",203,0) ; "RTN","BIPATUP3",204,0) ;---> Quit if the Forecast Date is not between Oct 1 and April 30. "RTN","BIPATUP3",205,0) Q:((BIMDAY<1001)&(BIMDAY>430)) "RTN","BIPATUP3",206,0) ; "RTN","BIPATUP3",207,0) ;---> Quit if this patient has a contraindication to H1N1. "RTN","BIPATUP3",208,0) N BICONTR D CONTRA^BIUTL11(BIDFN,.BICONTR) "RTN","BIPATUP3",209,0) Q:$D(BICONTR(125)) "RTN","BIPATUP3",210,0) ; "RTN","BIPATUP3",211,0) ;---> Change: Quit if patient is <6 months. "RTN","BIPATUP3",212,0) Q:BIAGE<6 "RTN","BIPATUP3",213,0) ; "RTN","BIPATUP3",214,0) ;---> Get value for forced Influenza regardless of age. "RTN","BIPATUP3",215,0) ;S:(31'[BIFFLU) BIFFLU=0 "RTN","BIPATUP3",216,0) ; "RTN","BIPATUP3",217,0) ;---> Quit if over 65 yrs old and no previous H1N1 dose (regardless of risk). "RTN","BIPATUP3",218,0) Q:((BIAGE>779)&('$D(BIFLU(125)))) "RTN","BIPATUP3",219,0) ; "RTN","BIPATUP3",220,0) ;---> Forecast H1N1 up to 25 yrs old, and over 50 yrs. "RTN","BIPATUP3",221,0) ;---> Quit if not age appropriate and no risk and not forced and no previous H1N1 dose. "RTN","BIPATUP3",222,0) Q:((BIAGE>299)&('BIRISKI)&('BIFFLU)&('$D(BIFLU(125)))) "RTN","BIPATUP3",223,0) ; "RTN","BIPATUP3",224,0) ;*********************************************************** "RTN","BIPATUP3",225,0) ;********** PATCH 4, v8.3, DEC 30,2009, IHS/CMI/MWR "RTN","BIPATUP3",226,0) ; "RTN","BIPATUP3",227,0) ;---> Quit if patient is 10yrs or older and has a one H1N1 already. "RTN","BIPATUP3",228,0) ;Q:((BIAGE>120)&($D(BIFLU(125)))) "RTN","BIPATUP3",229,0) Q:((BIAGE'<120)&($D(BIFLU(125)))) "RTN","BIPATUP3",230,0) ; "RTN","BIPATUP3",231,0) ;---> PATCH: Quit if the patient has had 2 doses. "RTN","BIPATUP3",232,0) N M,N S M=0,N=0 "RTN","BIPATUP3",233,0) F S M=$O(BIFLU(125,M)) Q:'M S N=N+1 "RTN","BIPATUP3",234,0) Q:(N>1) "RTN","BIPATUP3",235,0) ;*********************************************************** "RTN","BIPATUP3",236,0) ; "RTN","BIPATUP3",237,0) N X,X1,X2 "RTN","BIPATUP3",238,0) S X1=BIFDT,X2=9999999-$O(BIFLU(125,0)) S:X2=9999999 X2=0 "RTN","BIPATUP3",239,0) D ^%DTC "RTN","BIPATUP3",240,0) ;---> Quit if patient received a H1N1 shot today. "RTN","BIPATUP3",241,0) Q:X=0 "RTN","BIPATUP3",242,0) ;---> Quit if patient had a H1N1 vac <28 days prior to Forecast date. "RTN","BIPATUP3",243,0) Q:((X>0)&(X<28)) "RTN","BIPATUP3",244,0) ; "RTN","BIPATUP3",245,0) ;---> X must be either null (never had flu shot) or negative (had "RTN","BIPATUP3",246,0) ;---> a shot recently, but AFTER the Forecast Date). "RTN","BIPATUP3",247,0) ; "RTN","BIPATUP3",248,0) ;---> If not Jan, Feb, or March, then due date=Apr 30 of the new year. "RTN","BIPATUP3",249,0) S:BIMDAY>430 BIYEAR=BIYEAR+1 "RTN","BIPATUP3",250,0) ;---> Due by April 30. "RTN","BIPATUP3",251,0) N BIDUEDT S BIDUEDT=BIYEAR_0430 "RTN","BIPATUP3",252,0) ;---> Set CVX 127 due by April 30. "RTN","BIPATUP3",253,0) D SETDUE^BIPATUP2(BIDFN_U_$$HL7TX^BIUTL2(127)_U_U_BIYEAR_"0430") "RTN","BIPATUP3",254,0) S BIRISKF=1,BIRPROF(+$$BIRPROF(127))=1 "RTN","BIPATUP3",255,0) Q "RTN","BIPATUP3",256,0) ; "RTN","BIPATUP3",257,0) ; "RTN","BIPATUP3",258,0) OUTFLU(BIFDT,BIDUZ2) ;EP "RTN","BIPATUP3",259,0) ;---> Return 1 if Forecast Date is outside of Flu Dates. "RTN","BIPATUP3",260,0) ; 1 - BIFDT (req) Forecast Date (date used for forecast). "RTN","BIPATUP3",261,0) ; 2 - BIDUZ2 (req) User's DUZ(2) indicating site parameters. "RTN","BIPATUP3",262,0) ; "RTN","BIPATUP3",263,0) Q:'BIFDT 0 "RTN","BIPATUP3",264,0) S:'$G(BIDUZ2) BIDUZ2=$G(DUZ(2)) "RTN","BIPATUP3",265,0) Q:'BIDUZ2 0 "RTN","BIPATUP3",266,0) ; "RTN","BIPATUP3",267,0) N A,B,C,D S A=$E(BIFDT,4,7),B=$$FLUDATS^BIUTL8(BIDUZ2) "RTN","BIPATUP3",268,0) S C=$TR($P(B,"%"),"/"),D=$TR($P(B,"%",2),"/") "RTN","BIPATUP3",269,0) I (A(D-1)) Q 1 "RTN","BIPATUP3",270,0) Q 0 "RTN","BIPATUP3",271,0) ;===== "RTN","BIPATUP3",272,0) ; "RTN","BIPATUP3",273,0) ;V8.5 PATCH 31 FID-98855 RZV HR EVALUATION "RTN","BIPATUP3",274,0) RZV(BIDFN,BIFLU,BIFFLU,BINF,BIFDT,BIYRS,BIDUZ2,BIRISKF) ;EP "RTN","BIPATUP3",275,0) ;---> IHS RZV Forecast. "RTN","BIPATUP3",276,0) ;---> Parameters: "RTN","BIPATUP3",277,0) ; 1 - BIDFN (req) Patient IEN. "RTN","BIPATUP3",278,0) ; 2 - BIFLU (req) RZV History array: BIFLU(CVX,INVDATE). "RTN","BIPATUP3",279,0) ; 3 - BIFFLU (req) If =2, for force RZV regardless of age. "RTN","BIPATUP3",280,0) ; 4 - BINF (opt) Array of Vaccine Grp IEN'S that should "RTN","BIPATUP3",281,0) ; not be forecast. "RTN","BIPATUP3",282,0) ; 5 - BIFDT (req) Forecast Date (date used for forecast). "RTN","BIPATUP3",283,0) ; 6 - BIYRS (req) Patient Age in years for this Forecast Date. "RTN","BIPATUP3",284,0) ; 7 - BIDUZ2 (req) User's DUZ(2) indicating Immserve Forc Rules. "RTN","BIPATUP3",285,0) ; 5 - BIRISKF (req) 1=Patient has High Risk of RZV; otherwise 0. "RTN","BIPATUP3",286,0) ; "RTN","BIPATUP3",287,0) ;---> NOTE: This call does NOT even get made if TCH has already forecast RZV "RTN","BIPATUP3",288,0) ;---> (LDFORC+72^BIPATUP1). "RTN","BIPATUP3",289,0) ; "RTN","BIPATUP3",290,0) ;---> Quit if Forecasting turned off for RZV. "RTN","BIPATUP3",291,0) ;Q:$D(BINF(11)) "RTN","BIPATUP3",292,0) ; "RTN","BIPATUP3",293,0) ;N BICT "RTN","BIPATUP3",294,0) ;D CONTRA^BIUTL11(BIDFN,.BICT) "RTN","BIPATUP3",295,0) ;Q:$D(BICT(33)) ;suryam said to leave this alone for now per email late January "RTN","BIPATUP3",296,0) ;********** "RTN","BIPATUP3",297,0) ; "RTN","BIPATUP3",298,0) ;---> Quit if this Pt Age <19 yrs or >49 yrs, regardless of risk. "RTN","BIPATUP3",299,0) Q:((BIYRS<19)!(BIYRS>49)) "RTN","BIPATUP3",300,0) ; "RTN","BIPATUP3",301,0) ;---> Flag to indicate RZV already set. "RTN","BIPATUP3",302,0) N BIFLAG "RTN","BIPATUP3",303,0) S BIFLAG=0 "RTN","BIPATUP3",304,0) ; "RTN","BIPATUP3",305,0) ;---> EARLY PNEUMO * * * "RTN","BIPATUP3",306,0) ;---> Forecast Early RZV per Site Parameter. "RTN","BIPATUP3",307,0) D "RTN","BIPATUP3",308,0) .;---> Quit if patient has had more than 1 RZV "RTN","BIPATUP3",309,0) .N A,Z,J "RTN","BIPATUP3",310,0) .S Z=0 "RTN","BIPATUP3",311,0) .S A=0 "RTN","BIPATUP3",312,0) .F S A=$O(^BIVARR("ZOS",A)) Q:'A D "RTN","BIPATUP3",313,0) ..I $D(BIFLU(A)) S J=J+1 "RTN","BIPATUP3",314,0) ..S:J>1 Z=1 "RTN","BIPATUP3",315,0) .Q:Z "RTN","BIPATUP3",316,0) .;---> Set patient due for RZV. "RTN","BIPATUP3",317,0) .D SETDUE^BIPATUP2(BIDFN_U_$$HL7TX^BIUTL2(187)_U_BIFDT) "RTN","BIPATUP3",318,0) .S BIRISKF=1,BIRPROF(+$$BIRPROF(187))=1 "RTN","BIPATUP3",319,0) Q "RTN","BIPATUP3",320,0) ;===== "RTN","BIPATUP3",321,0) ; "RTN","BIPATUP3",322,0) BIRPROF(CVX) ;EP;SET VACCINE GROUP FOR *HR* "RTN","BIPATUP3",323,0) N VG,VGO,VDA,I0 "RTN","BIPATUP3",324,0) S CVX=+$G(CVX) "RTN","BIPATUP3",325,0) S VG=0 "RTN","BIPATUP3",326,0) S VGO=0 "RTN","BIPATUP3",327,0) S VDA=+$O(^AUTTIMM("C",CVX,0)) "RTN","BIPATUP3",328,0) S I0=$G(^AUTTIMM(VDA,0)) "RTN","BIPATUP3",329,0) S VG=+$P(I0,U,9) "RTN","BIPATUP3",330,0) S VGO=+$P($G(^BISERT(VG,0)),U,2) "RTN","BIPATUP3",331,0) Q VGO "RTN","BIPATUP3",332,0) ;===== "RTN","BIPATUP3",333,0) ; "RTN","BIPATUP4") 0^21^B107877633 "RTN","BIPATUP4",1,0) BIPATUP4 ;IHS/CMI/MWR - UPDATE PATIENT DATA; DEC 15, 2011 [ 07/15/2025 10:27 PM ] ; 25 Aug 2025 2:40 PM "RTN","BIPATUP4",2,0) ;;8.5;IMMUNIZATION;**22,26,29,30,31**;OCT 24,2011;Build 137 "RTN","BIPATUP4",3,0) ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS * "RTN","BIPATUP4",4,0) ;; UPDATE PATIENT DATA, IMM FORECAST IN ^BIPDUE(. "RTN","BIPATUP4",5,0) ;; PATCH 22: Changes to check for COVID High Risk. IHSPOST "RTN","BIPATUP4",6,0) ;; V8.5 P 29 FID-107546 106351 106359 "RTN","BIPATUP4",7,0) ; "RTN","BIPATUP4",8,0) ;V8.5 PATCH 29 - FID-106359 Relocation MenB to BI Site Parameters "RTN","BIPATUP4",9,0) ;V8.5 PATCH 31 - FID-116770 Expand to 23 yrs "RTN","BIPATUP4",10,0) ;V8.5 PATCH 29 - FID-106351 Force RSV for 60-74 "RTN","BIPATUP4",11,0) ;V8.5 PATCH 31 - FID-118921 Nirsevimab 8-19 mts, Oct thru Mar "RTN","BIPATUP4",12,0) ;---------- "RTN","BIPATUP4",13,0) ; "RTN","BIPATUP4",14,0) IHSPOST(BIDFN,BIHX,BIFDT,BIDUZ2,BINF,BITCHAF,BIADDND,BIPROF) ;EP "RTN","BIPATUP4",15,0) ;---> Post forecast; after ICE forecast, perform any follow-up "RTN","BIPATUP4",16,0) ;---> forecasting needed for High Risk. "RTN","BIPATUP4",17,0) ;---> Parameters: "RTN","BIPATUP4",18,0) ; 1 - BIDFN (req) Patient IEN. "RTN","BIPATUP4",19,0) ; 2 - BIHX (req) String containing Patient's Imm History. "RTN","BIPATUP4",20,0) ; 3 - BIFDT (req) Forecast Date (date used for forecast). "RTN","BIPATUP4",21,0) ; 4 - BIDUZ2 (req) User's DUZ(2) for High Risk Site Parameter. "RTN","BIPATUP4",22,0) ; 5 - BINF (opt) Array of Vaccine Grp IEN'S that should not be forecast. "RTN","BIPATUP4",23,0) ; 6 - BITCHAF (ret) [1=ICE already forecast Pneumo (33), [2=HepB(45), [3=HepA(85) "RTN","BIPATUP4",24,0) ; [4=COVID "RTN","BIPATUP4",25,0) ; 7 - BIADDND (ret) IHS forecasting addendum (to be added to TCH Report). "RTN","BIPATUP4",26,0) ; 8 - BIPROF (ret) String containing text of Patient's Imm Report so far. "RTN","BIPATUP4",27,0) ; "RTN","BIPATUP4",28,0) ; "RTN","BIPATUP4",29,0) ;---> SET FORECAST DATE "RTN","BIPATUP4",30,0) S:'$G(BIFDT) BIFDT=$G(DT) "RTN","BIPATUP4",31,0) ; "RTN","BIPATUP4",32,0) ;---> GET PATIENT AGE IN YEARS "RTN","BIPATUP4",33,0) N BIAGE,BIYRS,BIMTS,BIDYS,BIRPROF "RTN","BIPATUP4",34,0) S BIAGE=$$AGE^BIUTL1(BIDFN,1,BIFDT) "RTN","BIPATUP4",35,0) ;QUIT IF DECEASED OR UNKNOWN "RTN","BIPATUP4",36,0) Q:$E(BIAGE)?1U "RTN","BIPATUP4",37,0) S BIYRS=+BIAGE "RTN","BIPATUP4",38,0) S BIMTS=$P(BIAGE,U,2) "RTN","BIPATUP4",39,0) S BIDYS=$P(BIAGE,U,3) "RTN","BIPATUP4",40,0) ; "RTN","BIPATUP4",41,0) ;---> GET SITE RISK FACTORS "RTN","BIPATUP4",42,0) ; "RTN","BIPATUP4",43,0) ;---> 1="Pneumo" "RTN","BIPATUP4",44,0) ;---> 2="Hep B-DM" "RTN","BIPATUP4",45,0) ;---> 3="Heb A&B" "RTN","BIPATUP4",46,0) ;---> 4="COVID" "RTN","BIPATUP4",47,0) ;---> 5="Men-B for 16-23" "RTN","BIPATUP4",48,0) ;---> 6="RSV for 60-74" "RTN","BIPATUP4",49,0) ;---> 7="HPV Early forecast at age 9" "RTN","BIPATUP4",50,0) ;---> 8="RecombZV for 19 to 48 yrs" "RTN","BIPATUP4",51,0) ;---> S="Smoking" "RTN","BIPATUP4",52,0) ; "RTN","BIPATUP4",53,0) ;---> Loop through RPMS History "RTN","BIPATUP4",54,0) ;---> Collect for prior select IMMS "RTN","BIPATUP4",55,0) ; "RTN","BIPATUP4",56,0) D BIDOSE ;Put Imm HX in BIFLU(CVX,REVERSE DATE) "RTN","BIPATUP4",57,0) ; "RTN","BIPATUP4",58,0) ;---> Patient RIST FACTORS "RTN","BIPATUP4",59,0) ; "RTN","BIPATUP4",60,0) ;---> Forced Pneumo or Disregard Risk Factors. "RTN","BIPATUP4",61,0) ;---> BIFFLU: "RTN","BIPATUP4",62,0) ; 0=Normal "RTN","BIPATUP4",63,0) ; 1=Influenze "RTN","BIPATUP4",64,0) ; 2=Pneumococcal "RTN","BIPATUP4",65,0) ; 3=Influenza and Pneumo "RTN","BIPATUP4",66,0) ; 4=Disregard Risk Factors. "RTN","BIPATUP4",67,0) ; "RTN","BIPATUP4",68,0) N BIFFLU "RTN","BIPATUP4",69,0) S BIFFLU=$$INFL^BIUTL11(BIDFN) "RTN","BIPATUP4",70,0) ; "RTN","BIPATUP4",71,0) ;---> Smoking - BIRISK includes 'S' "RTN","BIPATUP4",72,0) N BIRISK "RTN","BIPATUP4",73,0) S BIRISK=$$RISKP^BIUTL2(BIDUZ2) "RTN","BIPATUP4",74,0) ; "RTN","BIPATUP4",75,0) N BISMKR "RTN","BIPATUP4",76,0) S BISMKR=$S(BIRISK["S":1,1:0) "RTN","BIPATUP4",77,0) ; "RTN","BIPATUP4",78,0) I BIRISK[1,BIYRS>18 D PNEUMO "RTN","BIPATUP4",79,0) I BIRISK[2,BIYRS>18,BIYRS<60 D HEPBDIAB "RTN","BIPATUP4",80,0) I BIRISK[3,BIYRS>18 D HEPABC "RTN","BIPATUP4",81,0) I BIRISK[4,BIYRS>11 D COVID "RTN","BIPATUP4",82,0) I BIRISK[5,BIYRS>15,BIYRS<24 D MENB "RTN","BIPATUP4",83,0) I BIRISK[6,BIYRS>59,BIYRS<75 D RSV(BIDFN) "RTN","BIPATUP4",84,0) I BIRISK[7,BIYRS>8,BIYRS<11 S BIRPROF(18)=1 "RTN","BIPATUP4",85,0) I BIRISK[8,BIYRS>18,BIYRS<50 D RZV(BIDFN,BIYRS,.BIFLU,BIRISK,"D") "RTN","BIPATUP4",86,0) I BIRISK[9,BIDYS>249,BIDYS<598,+$E(BIFDT,4,5)>9!(+$E(BIFDT,4,5)<4) D RSV819(BIDFN) "RTN","BIPATUP4",87,0) ; "RTN","BIPATUP4",88,0) K ^BITMP($J,BIDFN,"BIRPROF") "RTN","BIPATUP4",89,0) M ^BITMP($J,BIDFN,"BIRPROF")=BIRPROF "RTN","BIPATUP4",90,0) Q "RTN","BIPATUP4",91,0) ; "RTN","BIPATUP4",92,0) ;---> * * * Forecast Pneumo for High Risk * * * "RTN","BIPATUP4",93,0) PNEUMO ;---> High Risk for Pneumo BIRISKPN=1 "RTN","BIPATUP4",94,0) ; "RTN","BIPATUP4",95,0) N BIRISKPN "RTN","BIPATUP4",96,0) D RISKP^BIDX(BIDFN,BIFDT,BIYRS,BISMKR,.BIRISKPN) "RTN","BIPATUP4",97,0) Q:'BIRISKPN "RTN","BIPATUP4",98,0) ; "RTN","BIPATUP4",99,0) ;---> Forced Pneumo or Disregard Risk Factors. "RTN","BIPATUP4",100,0) ;---> BIFFLU: "RTN","BIPATUP4",101,0) ; 0=Normal "RTN","BIPATUP4",102,0) ; 1=Influenze "RTN","BIPATUP4",103,0) ; 2=Pneumococcal "RTN","BIPATUP4",104,0) ; 3=Influenza and Pneumo "RTN","BIPATUP4",105,0) ; 4=Disregard Risk Factors. "RTN","BIPATUP4",106,0) ; "RTN","BIPATUP4",107,0) N BIFFLU "RTN","BIPATUP4",108,0) S BIFFLU=$$INFL^BIUTL11(BIDFN) "RTN","BIPATUP4",109,0) ; "RTN","BIPATUP4",110,0) ;---> * * * Forecast Pneumo for High Risk if needed. * * * "RTN","BIPATUP4",111,0) ; "RTN","BIPATUP4",112,0) ;---> Quit if CVX 33, 215 or 216 already in the history "RTN","BIPATUP4",113,0) Q:($D(BIFLU(33))) "RTN","BIPATUP4",114,0) Q:($D(BIFLU(215))) ;ihs/cmi/lab p26 added 215 "RTN","BIPATUP4",115,0) Q:($D(BIFLU(216))) ;ihs/cmi/lab p26 added 216 "RTN","BIPATUP4",116,0) ; "RTN","BIPATUP4",117,0) ;---> Quit if TCH already forecast Pneumo (33). "RTN","BIPATUP4",118,0) ; "RTN","BIPATUP4",119,0) ;---> Check if Site Parameter includes Smoking (includes 9). "RTN","BIPATUP4",120,0) N BIRISKF,BISMKR "RTN","BIPATUP4",121,0) S BISMKR=$S(BIRISK["S":1,1:0) "RTN","BIPATUP4",122,0) ;---> Check for High Risk. "RTN","BIPATUP4",123,0) D RISKP^BIDX(BIDFN,BIFDT,BIYRS,BISMKR,.BIRISKF) "RTN","BIPATUP4",124,0) D:BIRISKF "RTN","BIPATUP4",125,0) .S BIRPROF(+$$BIRPROF^BIPATUP3(33))=1 "RTN","BIPATUP4",126,0) Q:(BITCHAF[1) "RTN","BIPATUP4",127,0) ; "RTN","BIPATUP4",128,0) ;---> Set Early Forecast or High Risk if needed. "RTN","BIPATUP4",129,0) D IHSPNEU^BIPATUP3(BIDFN,.BIFLU,BIFFLU,.BINF,BIFDT,BIYRS,BIDUZ2,BIRISKF,.BIADDND) "RTN","BIPATUP4",130,0) Q "RTN","BIPATUP4",131,0) ;===== "RTN","BIPATUP4",132,0) ; "RTN","BIPATUP4",133,0) HEPBDIAB ;---> * * * Forecast Hep B for Diabetes if needed. * * * "RTN","BIPATUP4",134,0) ;---> High Risk for Hep B if BIRISKHB=1 "RTN","BIPATUP4",135,0) ;---> Quit if Hep B (45) is in the history, ever received a Hep B. "RTN","BIPATUP4",136,0) ;---> Quit if Site Parameter does not include Hep B for Diabetes. "RTN","BIPATUP4",137,0) Q:($D(BIFLU(45))) "RTN","BIPATUP4",138,0) ; "RTN","BIPATUP4",139,0) ; "RTN","BIPATUP4",140,0) N BIRISKHB "RTN","BIPATUP4",141,0) D RISKB^BIDX(BIDFN,BIFDT,BIYRS,.BIRISKHB) "RTN","BIPATUP4",142,0) Q:'$G(BIRISKHB) "RTN","BIPATUP4",143,0) S BIRPROF(+$$BIRPROF^BIPATUP3(45))=1 "RTN","BIPATUP4",144,0) ; "RTN","BIPATUP4",145,0) ;---> Quit if TCH already forecast Hep B (45). "RTN","BIPATUP4",146,0) Q:(BITCHAF[2) "RTN","BIPATUP4",147,0) ; "RTN","BIPATUP4",148,0) ;---> Set Early Forecast or High Risk if needed. "RTN","BIPATUP4",149,0) D IHSHEPB^BIPATUP3(BIDFN,.BINF,BIFDT,1,.BIADDND) "RTN","BIPATUP4",150,0) S BITCHAF=BITCHAF_2 "RTN","BIPATUP4",151,0) Q "RTN","BIPATUP4",152,0) ;===== "RTN","BIPATUP4",153,0) ; "RTN","BIPATUP4",154,0) ;---> * * * Forecast Hep A & B for CLD/HepC * * * "RTN","BIPATUP4",155,0) HEPABC ;---> * * * Forecast Hep A & B for CLD/HepC if needed. * * * "RTN","BIPATUP4",156,0) ;---> No High Risk computation under 19 years. "RTN","BIPATUP4",157,0) ; "RTN","BIPATUP4",158,0) ;---> Quit if Site Parameter does not include Hep A&B for CLD/HepC. "RTN","BIPATUP4",159,0) Q:(BIRISK'[3) "RTN","BIPATUP4",160,0) ; "RTN","BIPATUP4",161,0) ;---> Quit if Hep A (85) and Hep B (45) are BOTH in the history. "RTN","BIPATUP4",162,0) Q:($D(BIFLU(85))&$D(BIFLU(45))) "RTN","BIPATUP4",163,0) ; "RTN","BIPATUP4",164,0) ;---> High Risk for Hep A & Hep B BIRISKAB=1 "RTN","BIPATUP4",165,0) ; "RTN","BIPATUP4",166,0) N BIRISKAB "RTN","BIPATUP4",167,0) D RISKAB^BIDX(BIDFN,BIFDT,.BIRISKAB) "RTN","BIPATUP4",168,0) Q:'BIRISKAB "RTN","BIPATUP4",169,0) N CVX "RTN","BIPATUP4",170,0) F CVX=45,85 S BIRPROF(+$$BIRPROF^BIPATUP3(CVX))=1 "RTN","BIPATUP4",171,0) ; "RTN","BIPATUP4",172,0) ;---> If TCH did NOT already forecast Hep B (45), forecast Hep B for CLD/HepC. "RTN","BIPATUP4",173,0) I '$D(BIFLU(45))&(BITCHAF'[2) D IHSHEPB^BIPATUP3(BIDFN,.BINF,BIFDT,2,.BIADDND) "RTN","BIPATUP4",174,0) ; "RTN","BIPATUP4",175,0) ;---> If TCH did NOT already forecast Hep A (85), forecast Hep A for CLD/HepC. "RTN","BIPATUP4",176,0) I '$D(BIFLU(85))&(BITCHAF'[3) D IHSHEPA^BIPATUP3(BIDFN,.BINF,BIFDT,,.BIADDND) "RTN","BIPATUP4",177,0) Q "RTN","BIPATUP4",178,0) ;===== "RTN","BIPATUP4",179,0) ; "RTN","BIPATUP4",180,0) ;---> * * * Forecast COVID for Immunocompromised if needed. * * * "RTN","BIPATUP4",181,0) ; "RTN","BIPATUP4",182,0) N BIRISKC "RTN","BIPATUP4",183,0) D RISKC^BIDX(BIDFN,BIFDT,,.BIRISKC) "RTN","BIPATUP4",184,0) Q:'BIRISKC "RTN","BIPATUP4",185,0) S BIRPROF(+$$BIRPROF^BIPATUP3(213))=1 "RTN","BIPATUP4",186,0) ; "RTN","BIPATUP4",187,0) Q "RTN","BIPATUP4",188,0) ;===== "RTN","BIPATUP4",189,0) ; "RTN","BIPATUP4",190,0) BIDOSE ;---> Loop through RPMS History in BIHX1 "RTN","BIPATUP4",191,0) ;---> Collect for prior select IMMS "RTN","BIPATUP4",192,0) ;---> Store in BIFLU by HL7 Code, inverse date. "RTN","BIPATUP4",193,0) ; "RTN","BIPATUP4",194,0) N BIDOSE,BIHX1,I,X,Y "RTN","BIPATUP4",195,0) S BIHX1=$P(BIHX,"~~~",2) S ^BITMP("BIHX")=BIHX "RTN","BIPATUP4",196,0) ; "RTN","BIPATUP4",197,0) F I=1:1 S BIDOSE=$P(BIHX1,"|||",I) Q:BIDOSE="" D BD1 "RTN","BIPATUP4",198,0) Q "RTN","BIPATUP4",199,0) ;===== "RTN","BIPATUP4",200,0) ; "RTN","BIPATUP4",201,0) BD1 ;---> For this Immunization, set A=CVX Code, D=Date. "RTN","BIPATUP4",202,0) N A,D,IEN,I0,IGRP "RTN","BIPATUP4",203,0) S A=$P(BIDOSE,U,2) "RTN","BIPATUP4",204,0) S D=$P(BIDOSE,U,3) "RTN","BIPATUP4",205,0) Q:'A!'D "RTN","BIPATUP4",206,0) S IEN=+$O(^AUTTIMM("C",A,0)) "RTN","BIPATUP4",207,0) S I0=$G(^AUTTIMM(IEN,0)) "RTN","BIPATUP4",208,0) S IGRP=$P(I0,U,9) "RTN","BIPATUP4",209,0) ; "RTN","BIPATUP4",210,0) ;---> Quit if Dose Override is Invalid (1-4). "RTN","BIPATUP4",211,0) I $P(BIDOSE,U,4),$P(BIDOSE,U,4)<9 Q "RTN","BIPATUP4",212,0) ; "RTN","BIPATUP4",213,0) ;---> If this is Hep B or Hep A, "RTN","BIPATUP4",214,0) ;---> translate and store it in local array BIFLU(CVX,Inverse Fm date). "RTN","BIPATUP4",215,0) ; "RTN","BIPATUP4",216,0) ;---> For special case Twinrix 104, both HepA and HepB, save both "RTN","BIPATUP4",217,0) ;---> and quit. Prevent HepB 45 getting saved, but Hep A 85 lost. "RTN","BIPATUP4",218,0) I A=104 D Q "RTN","BIPATUP4",219,0) .S BIFLU(45,9999999-$$TCHFMDT^BIUTL5(D))="" "RTN","BIPATUP4",220,0) .S BIFLU(85,9999999-$$TCHFMDT^BIUTL5(D))="" "RTN","BIPATUP4",221,0) ;********** "RTN","BIPATUP4",222,0) ; "RTN","BIPATUP4",223,0) ;---> Collect Hep B CVX's. "RTN","BIPATUP4",224,0) I $D(^BIVARR("HEP B",A)) S BIFLU(45,9999999-$$TCHFMDT^BIUTL5(D))="" "RTN","BIPATUP4",225,0) ; "RTN","BIPATUP4",226,0) ;---> Collect Hep A CVX's. "RTN","BIPATUP4",227,0) I $D(^BIVARR("HEP A",A)) S BIFLU(85,9999999-$$TCHFMDT^BIUTL5(D))="" "RTN","BIPATUP4",228,0) ; "RTN","BIPATUP4",229,0) ;---> Save any Pneumo's "RTN","BIPATUP4",230,0) I IGRP=11 S BIFLU(A,9999999-$$TCHFMDT^BIUTL5(D))="" Q "RTN","BIPATUP4",231,0) ; "RTN","BIPATUP4",232,0) ;---> Add save of any RZV's "RTN","BIPATUP4",233,0) I IGRP=20 S BIFLU(A,9999999-$$TCHFMDT^BIUTL5(D))="" Q "RTN","BIPATUP4",234,0) ; "RTN","BIPATUP4",235,0) ;---> Add save of any COVID's "RTN","BIPATUP4",236,0) I IGRP=21 S BIFLU(A,9999999-$$TCHFMDT^BIUTL5(D))="" Q "RTN","BIPATUP4",237,0) ; "RTN","BIPATUP4",238,0) ;---> Save any RSV's "RTN","BIPATUP4",239,0) I IGRP=24 S BIFLU(A,9999999-$$TCHFMDT^BIUTL5(D))="" Q "RTN","BIPATUP4",240,0) ; "RTN","BIPATUP4",241,0) ;********** PATCH 26, v8.5, JAN 31, 2023, IHS/CMI/LAB "RTN","BIPATUP4",242,0) ;---> Add save of any MEN B. "RTN","BIPATUP4",243,0) ;I A=162!(A=163) D "RTN","BIPATUP4",244,0) ;I A=162!(A=163)!(A=316) D "RTN","BIPATUP4",245,0) I $D(^BIVARR("MEN-B",A)) S BIFLU(A,9999999-$$TCHFMDT^BIUTL5(D))="" "RTN","BIPATUP4",246,0) ; "RTN","BIPATUP4",247,0) Q "RTN","BIPATUP4",248,0) ;===== "RTN","BIPATUP4",249,0) ; "RTN","BIPATUP4",250,0) ;===== "RTN","BIPATUP4",251,0) ; "RTN","BIPATUP4",252,0) COVID ;---> No Immunocompromised for under 12 years. "RTN","BIPATUP4",253,0) ; "RTN","BIPATUP4",254,0) N BIRISKC "RTN","BIPATUP4",255,0) D RISKC^BIDX(BIDFN,BIFDT,,.BIRISKC) "RTN","BIPATUP4",256,0) Q:'BIRISKC "RTN","BIPATUP4",257,0) S BIRPROF(+$$BIRPROF^BIPATUP3(213))=1 "RTN","BIPATUP4",258,0) ; "RTN","BIPATUP4",259,0) ;---> Quit if ICE already forecast COVID. "RTN","BIPATUP4",260,0) ; "RTN","BIPATUP4",261,0) Q:(BITCHAF[4) "RTN","BIPATUP4",262,0) ;---> Quit if patient has received any COVID other than Mod or Pfz. "RTN","BIPATUP4",263,0) N BILD,BILAST,COV,TOT "RTN","BIPATUP4",264,0) ;BILD = COV DATE "RTN","BIPATUP4",265,0) ;BILAST = LAST COV DATE "RTN","BIPATUP4",266,0) S (BILD,BILAST,TOT)="" "RTN","BIPATUP4",267,0) S COV=0 "RTN","BIPATUP4",268,0) F S COV=$O(BIFLU(COV)) Q:'COV D:$D(^BIVARR("COV",COV)) "RTN","BIPATUP4",269,0) .S BIL=0 "RTN","BIPATUP4",270,0) .F S BIL=$O(BIFLU(COV,BIL)) Q:'BIL D "RTN","BIPATUP4",271,0) ..S TOT=TOT+1 "RTN","BIPATUP4",272,0) ..S BILD=9999999-BIL "RTN","BIPATUP4",273,0) ..S:BILD>BILAST BILAST=BILD "RTN","BIPATUP4",274,0) I $G(TOT)>1 S BIRISKC=0 Q "RTN","BIPATUP4",275,0) S:TOT<2 BIRISKC=1 "RTN","BIPATUP4",276,0) ; "RTN","BIPATUP4",277,0) Q:'BIRISKC "RTN","BIPATUP4",278,0) ; "RTN","BIPATUP4",279,0) S BIRPROF(+$$BIRPROF^BIPATUP3(213))=1 "RTN","BIPATUP4",280,0) ;---> Determine which to forecast, Mod or Pfr. "RTN","BIPATUP4",281,0) S BICVX=213 "RTN","BIPATUP4",282,0) ; "RTN","BIPATUP4",283,0) ;---> Set COVID High Risk if needed. "RTN","BIPATUP4",284,0) D IHSCOV^BIPATUP3(BIDFN,.BINF,BIFDT,BICVX,.BIADDND) "RTN","BIPATUP4",285,0) Q "RTN","BIPATUP4",286,0) ;===== "RTN","BIPATUP4",287,0) ; "RTN","BIPATUP4",288,0) RSV(BIDFN) ;V8.5 PATCH 29 - FID-106351 CHECK RSV "RTN","BIPATUP4",289,0) N X,Y,DOB,IEN,I0,X1,X2,RSVDT,QUIT,IMM,V0,VDT,CVX "RTN","BIPATUP4",290,0) S VDT="" "RTN","BIPATUP4",291,0) S IEN=9999999999 "RTN","BIPATUP4",292,0) F S IEN=$O(^AUPNVIMM("AC",BIDFN,IEN),-1) Q:'IEN!VDT D "RTN","BIPATUP4",293,0) .S I0=$G(^AUPNVIMM(IEN,0)) "RTN","BIPATUP4",294,0) .S IDA=+I0 "RTN","BIPATUP4",295,0) .S IMM=$G(^AUTTIMM(IDA,0)) "RTN","BIPATUP4",296,0) .S CVX=$P(IMM,U,3) "RTN","BIPATUP4",297,0) .Q:IMM'["RSV" "RTN","BIPATUP4",298,0) .S V=$P(I0,U,3) "RTN","BIPATUP4",299,0) .S V0=$G(^AUPNVSIT(V,0)) "RTN","BIPATUP4",300,0) .S VDT=$P($P(V0,U),".") "RTN","BIPATUP4",301,0) Q:VDT "RTN","BIPATUP4",302,0) S CVX=$O(^BIVARR("RSV","NOS",0)) "RTN","BIPATUP4",303,0) Q:'CVX "RTN","BIPATUP4",304,0) D SETDUE^BIPATUP2(BIDFN_U_$$HL7TX^BIUTL2(CVX)_U_BIFDT) "RTN","BIPATUP4",305,0) S BIADDND=$G(BIADDND)_" | RSV Added for High Risk|||" "RTN","BIPATUP4",306,0) N NOS "RTN","BIPATUP4",307,0) S NOS=0 "RTN","BIPATUP4",308,0) S NOS=0 "RTN","BIPATUP4",309,0) F S NOS=$O(^BIVARR("RSV","NOS",NOS)) Q:'NOS D "RTN","BIPATUP4",310,0) .S BIRPROF(+$$BIRPROF^BIPATUP3(NOS))=1 "RTN","BIPATUP4",311,0) Q "RTN","BIPATUP4",312,0) ;===== "RTN","BIPATUP4",313,0) ; "RTN","BIPATUP4",314,0) MENB ;V8.5 PATCH 29 - FID-106359 MEN B "RTN","BIPATUP4",315,0) ; "RTN","BIPATUP4",316,0) ;---> * * * FORECAST FIRST MEN B IF 16-23 YRS AND NEVER HAD MEN B * * * "RTN","BIPATUP4",317,0) ; "RTN","BIPATUP4",318,0) ;---> Quit if MEN-B already forecast by ICE "RTN","BIPATUP4",319,0) ; "RTN","BIPATUP4",320,0) ;---> Quit if MEN-B CVX already in the history "RTN","BIPATUP4",321,0) N MENB,QUIT "RTN","BIPATUP4",322,0) S QUIT=0 "RTN","BIPATUP4",323,0) S MENB=0 "RTN","BIPATUP4",324,0) F S MENB=$O(^BIVARR("MEN-B",MENB)) Q:'MENB!QUIT S:$D(BIFLU(MENB)) QUIT=1 "RTN","BIPATUP4",325,0) Q:QUIT "RTN","BIPATUP4",326,0) ; "RTN","BIPATUP4",327,0) ;CHECK FOR EXISTING MEN B FOR THE PATIENT "RTN","BIPATUP4",328,0) N X,Y,CVX,I0,V0,MENB "RTN","BIPATUP4",329,0) S MENB=0 "RTN","BIPATUP4",330,0) S X=0 "RTN","BIPATUP4",331,0) F S X=$O(^AUPNVIMM("AC",BIDFN,X)) Q:'X S I0=$G(^AUPNVIMM(X,0)) D:I0 "RTN","BIPATUP4",332,0) .S IMM=+I0 "RTN","BIPATUP4",333,0) .S CVX=+$P($G(^AUTTIMM(IMM,0)),U,3) "RTN","BIPATUP4",334,0) .S:$D(^BIVARR("MEN-B",CVX)) MENB=1 "RTN","BIPATUP4",335,0) Q:MENB "RTN","BIPATUP4",336,0) ; "RTN","BIPATUP4",337,0) S CVX=$O(^BIVARR("MEN-B","NOS",0)) "RTN","BIPATUP4",338,0) Q:'CVX "RTN","BIPATUP4",339,0) S BIRPROF(+$$BIRPROF^BIPATUP3(CVX))=1 "RTN","BIPATUP4",340,0) ; "RTN","BIPATUP4",341,0) Q:(BITCHAF[5) "RTN","BIPATUP4",342,0) ; "RTN","BIPATUP4",343,0) D SETDUE^BIPATUP2(BIDFN_U_$$HL7TX^BIUTL2(CVX)_U_BIFDT) "RTN","BIPATUP4",344,0) S BIADDND=$G(BIADDND)_" | MEN B Added for High Risk|||" "RTN","BIPATUP4",345,0) Q "RTN","BIPATUP4",346,0) ;===== "RTN","BIPATUP4",347,0) ; "RTN","BIPATUP4",348,0) RSV819(BIDFN) ; "RTN","BIPATUP4",349,0) N X,Y,DOB,IEN,I0,X1,X2,RSVDT,QUIT,IM0,V0,VDT,CVX "RTN","BIPATUP4",350,0) S VDT="" "RTN","BIPATUP4",351,0) S IEN=9999999999 "RTN","BIPATUP4",352,0) F S IEN=$O(^AUPNVIMM("AC",BIDFN,IEN),-1) Q:'IEN!VDT D "RTN","BIPATUP4",353,0) .S I0=$G(^AUPNVIMM(IEN,0)) "RTN","BIPATUP4",354,0) .S IDA=+I0 "RTN","BIPATUP4",355,0) .S IM0=$G(^AUTTIMM(IDA,0)) "RTN","BIPATUP4",356,0) .S CVX=$P(IM0,U,3) "RTN","BIPATUP4",357,0) .Q:CVX'=307 "RTN","BIPATUP4",358,0) .S V=$P(I0,U,3) "RTN","BIPATUP4",359,0) .S V0=$G(^AUPNVSIT(V,0)) "RTN","BIPATUP4",360,0) .S VDT=$P($P(V0,U),".") "RTN","BIPATUP4",361,0) Q:VDT "RTN","BIPATUP4",362,0) S CVX=315 "RTN","BIPATUP4",363,0) D SETDUE^BIPATUP2(BIDFN_U_$$HL7TX^BIUTL2(CVX)_U_BIFDT) "RTN","BIPATUP4",364,0) S BIADDND=$G(BIADDND)_" | RSV Added for High Risk|||" "RTN","BIPATUP4",365,0) S BIRPROF(+$$BIRPROF^BIPATUP3(315))=1 "RTN","BIPATUP4",366,0) Q "RTN","BIPATUP4",367,0) ;===== "RTN","BIPATUP4",368,0) ; "RTN","BIPATUP4",369,0) ;V8.5 P31 FID-98855 "RTN","BIPATUP4",370,0) ;DETERMINE IF PT NEEDS RZV "RTN","BIPATUP4",371,0) ; "RTN","BIPATUP4",372,0) RZV(BIDFN,BIYRS,BIFLU,BIRISKF,BITYP) ;EP; EVALUATE CURRENT RZV STATUS "RTN","BIPATUP4",373,0) ;BIDFN = (REQ) PATIENT DFN "RTN","BIPATUP4",374,0) ;BIYRS = PATIENT AGE IN YRS "RTN","BIPATUP4",375,0) ;BIFLU = ARRAY of imm history "RTN","BIPATUP4",376,0) ;BIRISKF = (Ret) "RTN","BIPATUP4",377,0) ; 1 at risk "RTN","BIPATUP4",378,0) ; 0 no risk "RTN","BIPATUP4",379,0) ;BITYP = (OPT) "RTN","BIPATUP4",380,0) ; D = ADD TO DUE LIST "RTN","BIPATUP4",381,0) ; R = SET REPORT CATEGORY TO DUE "RTN","BIPATUP4",382,0) ; "RTN","BIPATUP4",383,0) S BIRISKF=0 "RTN","BIPATUP4",384,0) S:$G(BITYP)="" BITYP="D" "RTN","BIPATUP4",385,0) ; "RTN","BIPATUP4",386,0) ;EVAL 1 "RTN","BIPATUP4",387,0) ;Age check, not at risk <19 or >49 yrs "RTN","BIPATUP4",388,0) Q:(BIYRS<19)!(BIYRS>49) "RTN","BIPATUP4",389,0) ; "RTN","BIPATUP4",390,0) ;EVAL 2 "RTN","BIPATUP4",391,0) ;Quit if more than 1 RZV and >27 DAYS apart "RTN","BIPATUP4",392,0) Q:$$RZVCOMP(BIDFN) "RTN","BIPATUP4",393,0) ; "RTN","BIPATUP4",394,0) ;Eval 3 "RTN","BIPATUP4",395,0) ;---> Check if Immune Compromised and RZV risk "RTN","BIPATUP4",396,0) ;BIRISKF=1 if compromised "RTN","BIPATUP4",397,0) D RISKRZV^BIDX2(BIDFN,BIFDT,BIYRS,.BIRISKF) "RTN","BIPATUP4",398,0) Q:'$G(BIRISKF) "RTN","BIPATUP4",399,0) ; "RTN","BIPATUP4",400,0) ;---> Set Early Forecast or High Risk if needed. "RTN","BIPATUP4",401,0) S BIRPROF(87)=1 "RTN","BIPATUP4",402,0) ; "RTN","BIPATUP4",403,0) ;If RZV alread in patient due list, don't add again "RTN","BIPATUP4",404,0) ; "RTN","BIPATUP4",405,0) Q:$$RZVAD(BIDFN) "RTN","BIPATUP4",406,0) ; "RTN","BIPATUP4",407,0) D:BITYP="D" ;setdue if for due list skip if for report eval "RTN","BIPATUP4",408,0) .S CVX=187 "RTN","BIPATUP4",409,0) .D SETDUE^BIPATUP2(BIDFN_U_$$HL7TX^BIUTL2(CVX)_U_BIFDT) "RTN","BIPATUP4",410,0) .S BIADDND=$G(BIADDND)_" | RecombZV Added for "_$S($G(BIRISKF):"High Risk",1:"Age")_"|||" "RTN","BIPATUP4",411,0) .S BIRPROF(+$$BIRPROF^BIPATUP3(187))=1 "RTN","BIPATUP4",412,0) Q "RTN","BIPATUP4",413,0) ;===== "RTN","BIPATUP4",414,0) ; "RTN","BIPATUP4",415,0) RZVAD(BIDFN) ;EP;RZV already on patient due list "RTN","BIPATUP4",416,0) ;0 = RZV on due list, so not due "RTN","BIPATUP4",417,0) ;1 = RZV not on due list, so due for RZV "RTN","BIPATUP4",418,0) ; "RTN","BIPATUP4",419,0) N AD,AD0,X "RTN","BIPATUP4",420,0) S AD=0 "RTN","BIPATUP4",421,0) S X=0 "RTN","BIPATUP4",422,0) F S X=$O(^BIPDUE("B",BIDFN,X)) Q:'X!AD D "RTN","BIPATUP4",423,0) .S AD0=$G(^BIPDUE(X,0)) "RTN","BIPATUP4",424,0) .S:$P(AD0,U,2)=291 AD=1 "RTN","BIPATUP4",425,0) Q AD "RTN","BIPATUP4",426,0) ;===== "RTN","BIPATUP4",427,0) ; "RTN","BIPATUP4",428,0) RZVCOMP(BIDFN) ;EP;Eval Patient RZV's status "RTN","BIPATUP4",429,0) ;1 = RZV's complete "RTN","BIPATUP4",430,0) ;0 = RZV's due "RTN","BIPATUP4",431,0) N BICOMP,RZV,CNT,IEN,I0,IDA,VDA,V0,D1,D2,X1,X2 "RTN","BIPATUP4",432,0) K RZVLAST "RTN","BIPATUP4",433,0) S BICOMP=0 "RTN","BIPATUP4",434,0) S CNT=0 "RTN","BIPATUP4",435,0) S IEN=0 "RTN","BIPATUP4",436,0) F S IEN=$O(^AUPNVIMM("AC",BIDFN,IEN)) Q:'IEN D "RTN","BIPATUP4",437,0) .S I0=$G(^AUPNVIMM(IEN,0)) "RTN","BIPATUP4",438,0) .S IDA=+I0 "RTN","BIPATUP4",439,0) .S VDA=+$P(I0,U,3) "RTN","BIPATUP4",440,0) .S V0=$G(^AUPNVSIT(VDA,0)) "RTN","BIPATUP4",441,0) .S CVX=$P($G(^AUTTIMM(IDA,0)),U,3) "RTN","BIPATUP4",442,0) .Q:'CVX "RTN","BIPATUP4",443,0) .Q:'$D(^BIVARR("ZOS",CVX)) "RTN","BIPATUP4",444,0) .S IDT=$P($P(V0,U),".") "RTN","BIPATUP4",445,0) .S CNT=CNT+1 "RTN","BIPATUP4",446,0) .S RZV(IDT)="" "RTN","BIPATUP4",447,0) .S RZVLAST(IDT)="" "RTN","BIPATUP4",448,0) I CNT=1 D "RTN","BIPATUP4",449,0) .S X2=$O(RZV(0)) "RTN","BIPATUP4",450,0) .S X1=BIFDT "RTN","BIPATUP4",451,0) .D ^%DTC "RTN","BIPATUP4",452,0) .I X<28 S BICOMP=1 "RTN","BIPATUP4",453,0) I CNT>1 D "RTN","BIPATUP4",454,0) .S D1=$O(RZV(0)) "RTN","BIPATUP4",455,0) .S D2=$O(RZV(9999999999),-1) "RTN","BIPATUP4",456,0) .Q:'D1!'D2 "RTN","BIPATUP4",457,0) .S X1=D1,X2=+27 "RTN","BIPATUP4",458,0) .D C^%DTC "RTN","BIPATUP4",459,0) .I X Build LM array for Patient Data Screen. "RTN","BIPATVW1",12,0) ;---> Parameters: "RTN","BIPATVW1",13,0) ; 1 - BIPRT (opt) If BIPRT=1 array is for print: skip INIT. "RTN","BIPATVW1",14,0) ; "RTN","BIPATVW1",15,0) ;---> Check for BIDFN. "RTN","BIPATVW1",16,0) Q:$$DFNCHECK^BIUTL2() "RTN","BIPATVW1",17,0) Q:$$DUZCHECK^BIUTL2() "RTN","BIPATVW1",18,0) ; "RTN","BIPATVW1",19,0) N BI31,BIENT,BIFORCST,BILINE,BIPDSS,BIRETVAL,BIRETERR,BILMAX,BIRMAX "RTN","BIPATVW1",20,0) S BIENT=0,BILMAX=0,BIRMAX=0,BI31=$C(31)_$C(31) "RTN","BIPATVW1",21,0) S:'$G(BIFDT) BIFDT=$G(DT) "RTN","BIPATVW1",22,0) ; "RTN","BIPATVW1",23,0) D:'$G(BIPRT) INIT "RTN","BIPATVW1",24,0) ;---> Get forecast string (BIFORCST) and problem dose string (BIPDSS). "RTN","BIPATVW1",25,0) ;---> Pass BIPDSS to HISTORY to mark problem doses with asterisks. "RTN","BIPATVW1",26,0) ;---> Pass BIFORCST to FORECAST for display. "RTN","BIPATVW1",27,0) ;V8.5 P31 - FID- Include '*RB*' high risk flag "RTN","BIPATVW1",28,0) D IMMFORC^BIRPC(.BIFORCST,BIDFN,BIFDT,,$G(BIDUZ2),.BIPDSS,1) "RTN","BIPATVW1",29,0) D HISTORY(BIDFN,$G(BIPDSS),.BILMAX,.BIENT) "RTN","BIPATVW1",30,0) D FORECAST(BIFORCST,.BIRMAX) "RTN","BIPATVW1",31,0) D LASTLET^BIPATVW3(BIDFN,.BIRMAX,.BIENT) "RTN","BIPATVW1",32,0) D CONTRAS^BIPATVW3(BIDFN,.BILMAX,.BIRMAX,.BIENT) "RTN","BIPATVW1",33,0) ; "RTN","BIPATVW1",34,0) N BILINE S BILINE=$S(BIRMAX>BILMAX:BIRMAX,1:BILMAX) "RTN","BIPATVW1",35,0) D ADDINFO^BIPATVW3(BIDFN,.BILINE,.BIENT,$G(BIDUZ2),BIFDT) "RTN","BIPATVW1",36,0) ; "RTN","BIPATVW1",37,0) D:$G(BIPRT) "RTN","BIPATVW1",38,0) .N X S X="Printed: "_$$NOW^BIUTL5() D CENTERT^BIUTL5(.X) "RTN","BIPATVW1",39,0) .D WRITE(.BILINE,X) "RTN","BIPATVW1",40,0) ; "RTN","BIPATVW1",41,0) ;---> Finish up Listmanager List Count. "RTN","BIPATVW1",42,0) S VALMCNT=BILINE "RTN","BIPATVW1",43,0) I VALMCNT>12 D "RTN","BIPATVW1",44,0) .S VALMSG="Scroll down to view more. Type ?? or Q to QUIT." "RTN","BIPATVW1",45,0) Q "RTN","BIPATVW1",46,0) ; "RTN","BIPATVW1",47,0) ; "RTN","BIPATVW1",48,0) ;---------- "RTN","BIPATVW1",49,0) INIT ;EP "RTN","BIPATVW1",50,0) ;---> Initialize variables and list array. "RTN","BIPATVW1",51,0) ; "RTN","BIPATVW1",52,0) S VALMSG="Type ?? for more actions or Q to Quit." "RTN","BIPATVW1",53,0) ; "RTN","BIPATVW1",54,0) ;---> Set default date for Screenman (if not already set, today). "RTN","BIPATVW1",55,0) S:'$D(BIDEFDT) BIDEFDT=$G(DT) "RTN","BIPATVW1",56,0) ; "RTN","BIPATVW1",57,0) ;---> If no Forecast Date passed, set it equal to today. "RTN","BIPATVW1",58,0) S:'$G(BIFDT) BIFDT=DT "RTN","BIPATVW1",59,0) ; "RTN","BIPATVW1",60,0) ;---> Show Forecast Date on Imms Due column header. "RTN","BIPATVW1",61,0) D:$G(BIFDT) "RTN","BIPATVW1",62,0) .N X S X="Immunizations DUE on "_$$SLDT2^BIUTL5(BIFDT) "RTN","BIPATVW1",63,0) .D CHGCAP^VALM("IMMUNIZATIONS DUE",X) "RTN","BIPATVW1",64,0) Q "RTN","BIPATVW1",65,0) ; "RTN","BIPATVW1",66,0) ; "RTN","BIPATVW1",67,0) ;---------- "RTN","BIPATVW1",68,0) HISTORY(BIDFN,BIPDSS,BILMAX,BIENT) ;EP "RTN","BIPATVW1",69,0) ;---> Gather Immunization History and set in Listman display array. "RTN","BIPATVW1",70,0) ;---> Parameters: "RTN","BIPATVW1",71,0) ; 1 - BIDFN (req) Patient's IEN in VA PATIENT File #2. "RTN","BIPATVW1",72,0) ; 2 - BIPDSS (opt) Returned string of Visit IEN's that are "RTN","BIPATVW1",73,0) ; Problem Doses, according to ImmServe. "RTN","BIPATVW1",74,0) ; 3 - BILMAX (ret) Maximum Left column line number. "RTN","BIPATVW1",75,0) ; 4 - BIENT (ret) Entry Number for LM selection in VALMY "RTN","BIPATVW1",76,0) ; "RTN","BIPATVW1",77,0) ;---> Check for BIDFN. "RTN","BIPATVW1",78,0) Q:$$DFNCHECK^BIUTL2() "RTN","BIPATVW1",79,0) ; "RTN","BIPATVW1",80,0) ;---> Call RPC to gather Immunization History. "RTN","BIPATVW1",81,0) ; BIRETVAL - Return value of valid data from RPC. "RTN","BIPATVW1",82,0) ; BIRETERR - Return value (text string) of error from RPC. "RTN","BIPATVW1",83,0) ; "RTN","BIPATVW1",84,0) N BIRETVAL,BIRETERR S BIRETVAL="" "RTN","BIPATVW1",85,0) D IMMHX^BIRPC(.BIRETVAL,BIDFN,,1,0) "RTN","BIPATVW1",86,0) ; "RTN","BIPATVW1",87,0) ;---> If BIRETERR has a value, display it and quit. "RTN","BIPATVW1",88,0) S BIRETERR=$P(BIRETVAL,BI31,2) "RTN","BIPATVW1",89,0) I BIRETERR]"" D EN^DDIOL("* "_BIRETERR,"","!!?5"),DIRZ^BIUTL3() Q "RTN","BIPATVW1",90,0) ; "RTN","BIPATVW1",91,0) ;---> Set BIHX(BIDFN)=to a valid Immunization History for this patient. "RTN","BIPATVW1",92,0) ;---> * NOTE! BIHX(BIDFN) is not newed; it is used to edit and delete "RTN","BIPATVW1",93,0) ; Immunizations for this patient (sub BIDFN for insurance). "RTN","BIPATVW1",94,0) ; "RTN","BIPATVW1",95,0) S BIHX(BIDFN)=$P(BIRETVAL,BI31,1) "RTN","BIPATVW1",96,0) ;X ^O "RTN","BIPATVW1",97,0) ; "RTN","BIPATVW1",98,0) ;---> Build Listmanager array from BIHX(BIDFN) string. "RTN","BIPATVW1",99,0) K ^TMP("BILMVW",$J) "RTN","BIPATVW1",100,0) N BILINE,BISK,I,V,X,Y,Z "RTN","BIPATVW1",101,0) S BILINE=0,V="|",Z="" "RTN","BIPATVW1",102,0) ; "RTN","BIPATVW1",103,0) ;---> Loop through "^"-pieces of Imm History, displaying. "RTN","BIPATVW1",104,0) F I=1:1 S Y=$P(BIHX(BIDFN),U,I) Q:Y="" D "RTN","BIPATVW1",105,0) .; "RTN","BIPATVW1",106,0) .;---> IMMUNIZATIONS "RTN","BIPATVW1",107,0) .;---> If this is an Immunization, display as follows and quit. "RTN","BIPATVW1",108,0) .I $P(Y,V)="I" D Q "RTN","BIPATVW1",109,0) ..; "RTN","BIPATVW1",110,0) ..;---> If not the same Vaccine Group, insert a blank line. "RTN","BIPATVW1",111,0) ..I $P(Y,V,6)'=Z D:I>1 RTCOL(.BILINE,,BIENT) S Z=$P(Y,V,6) "RTN","BIPATVW1",112,0) ..; "RTN","BIPATVW1",113,0) ..S BIENT=BIENT+1 "RTN","BIPATVW1",114,0) ..;---> Set display line for this immunization. "RTN","BIPATVW1",115,0) ..;S X=$S(BIENT>9:" ",1:" ")_BIENT_" "_$P(Y,V,17) "RTN","BIPATVW1",116,0) ..S X=$S(BIENT>9:" ",1:" ")_BIENT_" "_$P(Y,V,24) ;IHS/CMI/LAB - changed 17th piece to 24th piece for date administered or visit date "RTN","BIPATVW1",117,0) ..; "RTN","BIPATVW1",118,0) ..;---> Next line: Prepend asterisk if this Dose has a User Override "RTN","BIPATVW1",119,0) ..;---> or is an ImmServe Problem Dose (flag stored in BIPDSSA). "RTN","BIPATVW1",120,0) ..;---> (Override=pc 16, ImmServe string of prob doses=pc 4.) "RTN","BIPATVW1",121,0) ..N A,BIPDSSA S A=" ",BIPDSSA=0 "RTN","BIPATVW1",122,0) ..D "RTN","BIPATVW1",123,0) ...I $P(Y,V,16) S A=" *" Q "RTN","BIPATVW1",124,0) ...; "RTN","BIPATVW1",125,0) ...;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR "RTN","BIPATVW1",126,0) ...;---> For now just flag invalid by V Imm IEN (not by component CVX). "RTN","BIPATVW1",127,0) ...;W !!,Y,!!,$P(Y,V,18),!,BIPDSS,! R ZZZ "RTN","BIPATVW1",128,0) ...I $$PDSS^BIUTL8($P(Y,V,4),$P(Y,V,18),BIPDSS) S A=" *",BIPDSSA=1 "RTN","BIPATVW1",129,0) ..S X=X_A_$P(Y,V,2) "RTN","BIPATVW1",130,0) ..; "RTN","BIPATVW1",131,0) ..;---> Pad with spaces to line up in columns. "RTN","BIPATVW1",132,0) ..S X=$$PAD^BIUTL5(X,37) "RTN","BIPATVW1",133,0) ..;---> Pre-pend "+" if this immunization was imported from an outside registry. "RTN","BIPATVW1",134,0) ..S X=X_$S($P(Y,V,20):"+",1:" ") "RTN","BIPATVW1",135,0) ..;---> Display first 4 characters of Location of Visit. "RTN","BIPATVW1",136,0) ..S X=X_$E($P(Y,V,5),1,4) "RTN","BIPATVW1",137,0) ..S X=$$PAD^BIUTL5(X,43)_"|" "RTN","BIPATVW1",138,0) ..; "RTN","BIPATVW1",139,0) ..;---> Set formatted line and index in ^TMP. "RTN","BIPATVW1",140,0) ..D WRITE(.BILINE,X,,BIENT) "RTN","BIPATVW1",141,0) ..; "RTN","BIPATVW1",142,0) ..;---> If this is a Dose Override by user, set another line to display it. "RTN","BIPATVW1",143,0) ..D:$P(Y,V,16) "RTN","BIPATVW1",144,0) ...S X=" -"_$$DOVER^BIUTL8($P(Y,V,16))_"-" "RTN","BIPATVW1",145,0) ...;---> Pad Result with trailing spaces to justify columns. "RTN","BIPATVW1",146,0) ...D WRITE(.BILINE,$$PAD^BIUTL5(X,43)_"|",,BIENT) "RTN","BIPATVW1",147,0) ..; "RTN","BIPATVW1",148,0) ..;---> If this is a Problem Dose by ImmServe, set another line to display it. "RTN","BIPATVW1",149,0) ..D:$G(BIPDSSA) "RTN","BIPATVW1",150,0) ...; "RTN","BIPATVW1",151,0) ...;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR "RTN","BIPATVW1",152,0) ...;---> Change text. "RTN","BIPATVW1",153,0) ...;S X=" -INVALID--SEE IMMSERVE-" "RTN","BIPATVW1",154,0) ...S X=" -INVALID--SEE REPORT-" "RTN","BIPATVW1",155,0) ...;********** "RTN","BIPATVW1",156,0) ...;---> Pad Result with trailing spaces to justify columns. "RTN","BIPATVW1",157,0) ...D WRITE(.BILINE,$$PAD^BIUTL5(X,43)_"|",,BIENT) "RTN","BIPATVW1",158,0) ..; "RTN","BIPATVW1",159,0) ..; "RTN","BIPATVW1",160,0) ..;---> If there was a Reaction, set another line to display it. "RTN","BIPATVW1",161,0) ..D:$P(Y,V,13)]"" "RTN","BIPATVW1",162,0) ...S X=" ("_$P(Y,V,13)_")" "RTN","BIPATVW1",163,0) ...;---> Pad Result with trailing spaces to justify columns. "RTN","BIPATVW1",164,0) ...D WRITE(.BILINE,$$PAD^BIUTL5(X,43)_"|",,BIENT) "RTN","BIPATVW1",165,0) ..; "RTN","BIPATVW1",166,0) ..; "RTN","BIPATVW1",167,0) ..;---> If this was created by a CPT Coded Visit, set a line to display it. "RTN","BIPATVW1",168,0) ..D:$P(Y,V,19) "RTN","BIPATVW1",169,0) ...S X=" (CPT-Coded visit)" "RTN","BIPATVW1",170,0) ...;---> Pad Result with trailing spaces to justify columns. "RTN","BIPATVW1",171,0) ...D WRITE(.BILINE,$$PAD^BIUTL5(X,43)_"|",,BIENT) "RTN","BIPATVW1",172,0) ..; "RTN","BIPATVW1",173,0) .; "RTN","BIPATVW1",174,0) .; "RTN","BIPATVW1",175,0) .;---> SKIN TESTS "RTN","BIPATVW1",176,0) .;---> If this is a Skin Test, display as follows and quit. "RTN","BIPATVW1",177,0) .I $P(Y,V)="S" D Q "RTN","BIPATVW1",178,0) ..; "RTN","BIPATVW1",179,0) ..;---> Insert a blank line to set apart Skin Tests. "RTN","BIPATVW1",180,0) ..I I>1 I '$D(BISK) S BISK="" D RTCOL(.BILINE,,BIENT) "RTN","BIPATVW1",181,0) ..; "RTN","BIPATVW1",182,0) ..S BIENT=BIENT+1 "RTN","BIPATVW1",183,0) ..;---> Set display line for this Skin Test. "RTN","BIPATVW1",184,0) ..;S X=$S(BIENT>9:" ",1:" ")_BIENT_" "_$P($P(Y,V,7)," @") v8.0 "RTN","BIPATVW1",185,0) ..S X=$S(BIENT>9:" ",1:" ")_BIENT_" "_$P(Y,V,17) "RTN","BIPATVW1",186,0) ..S X=X_" "_$P(Y,V,11) "RTN","BIPATVW1",187,0) ..D "RTN","BIPATVW1",188,0) ...;---> Pad with spaces to line up columns. "RTN","BIPATVW1",189,0) ...S X=$$PAD^BIUTL5(X,38)_$E($P(Y,V,5),1,4) "RTN","BIPATVW1",190,0) ...S X=$$PAD^BIUTL5(X,43)_"|" "RTN","BIPATVW1",191,0) ..; "RTN","BIPATVW1",192,0) ..;---> Set formatted line and index in ^TMP. "RTN","BIPATVW1",193,0) ..D WRITE(.BILINE,X,,BIENT) "RTN","BIPATVW1",194,0) ..; "RTN","BIPATVW1",195,0) ..;---> Now set second line (results) of Skin Test. "RTN","BIPATVW1",196,0) ..S X=" ("_$P(Y,V,8) "RTN","BIPATVW1",197,0) ..D "RTN","BIPATVW1",198,0) ...I $P(Y,V,8)="" I $P(Y,V,9)="" D Q "RTN","BIPATVW1",199,0) ....S X=X_"No result",X=$$PAD^BIUTL5(X,25) "RTN","BIPATVW1",200,0) ...;---> Pad out to reading column. "RTN","BIPATVW1",201,0) ...S X=$$PAD^BIUTL5(X,24) "RTN","BIPATVW1",202,0) ..D "RTN","BIPATVW1",203,0) ...;---> Justify Reading column. "RTN","BIPATVW1",204,0) ...N Z S Z=$P(Y,V,9) "RTN","BIPATVW1",205,0) ...Q:Z="" "RTN","BIPATVW1",206,0) ...S:Z<10 Z=" "_Z "RTN","BIPATVW1",207,0) ...S X=X_" "_Z_"mm" "RTN","BIPATVW1",208,0) ..D "RTN","BIPATVW1",209,0) ...;---> Justify Read Date column. "RTN","BIPATVW1",210,0) ...N Z S Z=$P(Y,V,10) "RTN","BIPATVW1",211,0) ...Q:'Z "RTN","BIPATVW1",212,0) ...S X=X_" on "_Z "RTN","BIPATVW1",213,0) ..S X=X_")",X=$$PAD^BIUTL5(X,43)_"|" "RTN","BIPATVW1",214,0) ..; "RTN","BIPATVW1",215,0) ..D WRITE(.BILINE,X,,BIENT) "RTN","BIPATVW1",216,0) ; "RTN","BIPATVW1",217,0) ;---> Save maximum left column line number. "RTN","BIPATVW1",218,0) S BILMAX=BILINE "RTN","BIPATVW1",219,0) Q "RTN","BIPATVW1",220,0) ; "RTN","BIPATVW1",221,0) ; "RTN","BIPATVW1",222,0) ;---------- "RTN","BIPATVW1",223,0) FORECAST(BIFORCST,BIRMAX) ;EP "RTN","BIPATVW1",224,0) ;---> Now retrieve ImmServe Forecast and append to right half "RTN","BIPATVW1",225,0) ;---> of screen. "RTN","BIPATVW1",226,0) ;---> Parameters: "RTN","BIPATVW1",227,0) ; 1 - BIFORCST (req) Raw forecast string back from call to IMMFORC^BIRPC. "RTN","BIPATVW1",228,0) ; 2 - BIRMAX (ret) Maximum Right column line number. "RTN","BIPATVW1",229,0) ; "RTN","BIPATVW1",230,0) N BII,BILINE,BIRETERR "RTN","BIPATVW1",231,0) ; "RTN","BIPATVW1",232,0) ;---> If BIRETERR has a value, this is a FATAL ERROR in Forecasting; "RTN","BIPATVW1",233,0) ;---> Display the error, and set its text in the forecast box. "RTN","BIPATVW1",234,0) S BILINE=0,BIRETERR=$P(BIFORCST,BI31,2) "RTN","BIPATVW1",235,0) I BIRETERR]"" D S BIRMAX=BILINE Q "RTN","BIPATVW1",236,0) .;---> Display error, require to go on. "RTN","BIPATVW1",237,0) .D EN^DDIOL("* "_BIRETERR,"","!!?5"),DIRZ^BIUTL3() "RTN","BIPATVW1",238,0) .D PARSE(.BILINE,BIRETERR," ERROR:",BIENT) "RTN","BIPATVW1",239,0) ; "RTN","BIPATVW1",240,0) ;---> If there is NO fatal error, then process forecast string. "RTN","BIPATVW1",241,0) ;---> Set BIFORC=to an Immunization Forecast for this patient. "RTN","BIPATVW1",242,0) N BIFORC,BIPC S BIFORC=$P(BIFORCST,BI31,1) "RTN","BIPATVW1",243,0) ; "RTN","BIPATVW1",244,0) ;---> Sample code to insert forecaster version in to Patient View screen. "RTN","BIPATVW1",245,0) ;S BIFORC=BIFORC_"| TCH v3.7.1^" "RTN","BIPATVW1",246,0) ; "RTN","BIPATVW1",247,0) ;---> Build Listmanager array from BIFORC string. "RTN","BIPATVW1",248,0) ;---> For each piece of the Forecast, format and set in Listman. "RTN","BIPATVW1",249,0) F BII=1:1 S BIPC=$P(BIFORC,U,BII) Q:BIPC="" D "RTN","BIPATVW1",250,0) .; "RTN","BIPATVW1",251,0) .;---> If forecast contains a minor error, write it and quit. "RTN","BIPATVW1",252,0) .I BIPC["ERROR:" D PARSE(.BILINE,BIPC,,BIENT) Q "RTN","BIPATVW1",253,0) .; "RTN","BIPATVW1",254,0) .;---> Set display line for this forecast immunization. "RTN","BIPATVW1",255,0) .;---> Pad Date with trailing spaces to line up in a columns. "RTN","BIPATVW1",256,0) .N V S V="|" "RTN","BIPATVW1",257,0) .D "RTN","BIPATVW1",258,0) ..N Z S Z=$P(BIPC,V) "RTN","BIPATVW1",259,0) ..;---> If "No Immunizations Due", write this instead of other data. "RTN","BIPATVW1",260,0) ..;---> ("No immunizations due." text is set in ^BIRPC.) "RTN","BIPATVW1",261,0) ..I Z="No immunizations due." S X=" "_Z Q "RTN","BIPATVW1",262,0) ..S X=" "_Z,X=$$PAD^BIUTL5(X,16)_$P(BIPC,V,2)_$P(BIPC,V,3) "RTN","BIPATVW1",263,0) .; "RTN","BIPATVW1",264,0) .;---> Set formatted Imm Due line and index in ^TMP. "RTN","BIPATVW1",265,0) .D RTCOL(.BILINE,X,BIENT) "RTN","BIPATVW1",266,0) ; "RTN","BIPATVW1",267,0) ;---> Save maximum right column line number. "RTN","BIPATVW1",268,0) S BIRMAX=BILINE "RTN","BIPATVW1",269,0) Q "RTN","BIPATVW1",270,0) ; "RTN","BIPATVW1",271,0) ; "RTN","BIPATVW1",272,0) ;---------- "RTN","BIPATVW1",273,0) RTCOL(BILINE,BIVAL,BIENT) ;EP "RTN","BIPATVW1",274,0) ;---> Set right column entries in ^TMP. "RTN","BIPATVW1",275,0) ;---> Parameters: "RTN","BIPATVW1",276,0) ; 1 - BILINE (ret) Last line# written. "RTN","BIPATVW1",277,0) ; 2 - BIVAL (opt) Value/text of line (Null=blank line). "RTN","BIPATVW1",278,0) ; (Null=blank line.) "RTN","BIPATVW1",279,0) ; 3 - BIENT (opt) Entry Number for LM selection in VALMY "RTN","BIPATVW1",280,0) ; "RTN","BIPATVW1",281,0) ;---> If an Imm History line already exists, append to it. "RTN","BIPATVW1",282,0) N Z S Z=$G(^TMP("BILMVW",$J,BILINE+1,0)) "RTN","BIPATVW1",283,0) I Z]"" S BIVAL=Z_$G(BIVAL) D WRITE(.BILINE,BIVAL) Q "RTN","BIPATVW1",284,0) ; "RTN","BIPATVW1",285,0) ;---> If this is a new line, set line count and index. "RTN","BIPATVW1",286,0) D WRITE(.BILINE,$$SP^BIUTL5(43)_"|"_$G(BIVAL),,$G(BIENT)) "RTN","BIPATVW1",287,0) Q "RTN","BIPATVW1",288,0) ; "RTN","BIPATVW1",289,0) ; "RTN","BIPATVW1",290,0) ;---------- "RTN","BIPATVW1",291,0) WRITE(BILINE,BIVAL,BIBLNK,BIENT) ;EP "RTN","BIPATVW1",292,0) ;---> Write lines to ^TMP (see documentation in ^BIW). "RTN","BIPATVW1",293,0) ;---> Parameters: "RTN","BIPATVW1",294,0) ; 1 - BILINE (ret) Last line# written. "RTN","BIPATVW1",295,0) ; 2 - BIVAL (opt) Value/text of line (Null=blank line). "RTN","BIPATVW1",296,0) ; 3 - BIBLNK (opt) Number of blank lines to add after line sent. "RTN","BIPATVW1",297,0) ; 4 - BIENT (opt) Entry Number for LM selection in VALMY "RTN","BIPATVW1",298,0) ; "RTN","BIPATVW1",299,0) Q:'$D(BILINE) "RTN","BIPATVW1",300,0) D WL^BIW(.BILINE,"BILMVW",$G(BIVAL),$G(BIBLNK),$G(BIENT)) "RTN","BIPATVW1",301,0) Q "RTN","BIPATVW1",302,0) ; "RTN","BIPATVW1",303,0) ; "RTN","BIPATVW1",304,0) ;---------- "RTN","BIPATVW1",305,0) PARSE(BILINE,BISTR,BIFLN,BIENT) ;EP "RTN","BIPATVW1",306,0) ;---> Parse Right Column lines to fit in proper length. "RTN","BIPATVW1",307,0) ;---> Parameters: "RTN","BIPATVW1",308,0) ; 1 - BILINE (req) Line Number, Right Column. "RTN","BIPATVW1",309,0) ; 2 - BISTR (req) String of text to be parsed out. "RTN","BIPATVW1",310,0) ; 3 - BIFLN (opt) First line (if null, blank line inserted). "RTN","BIPATVW1",311,0) ; 4 - BIENT (ret) Entry Number for LM selection in VALMY "RTN","BIPATVW1",312,0) ; "RTN","BIPATVW1",313,0) Q:'$D(BILINE) Q:$G(BISTR)="" "RTN","BIPATVW1",314,0) N A,Y,Z "RTN","BIPATVW1",315,0) D RTCOL(.BILINE,$G(BIFLN),$G(BIENT)) "RTN","BIPATVW1",316,0) S A=1 "RTN","BIPATVW1",317,0) F D Q:Y="" "RTN","BIPATVW1",318,0) .S Z=A+31,Y=$E(BISTR,A,Z) "RTN","BIPATVW1",319,0) .D:$L(Y)=32 "RTN","BIPATVW1",320,0) ..F Q:$E(BISTR,Z)=" " S Z=Z-1 Q:Z<10 "RTN","BIPATVW1",321,0) ..S Y=$E(BISTR,A,Z) "RTN","BIPATVW1",322,0) .;---> Set formatted Error line and index in ^TMP. "RTN","BIPATVW1",323,0) .D:Y]"" RTCOL(.BILINE," "_Y,$G(BIENT)) "RTN","BIPATVW1",324,0) .S A=Z+1 "RTN","BIPATVW1",325,0) Q "RTN","BIPATVW3") 0^29^B115766424 "RTN","BIPATVW3",1,0) BIPATVW3 ;IHS/CMI/MWR - ADD OTHER ITEMS, DISPLAY HELP; MAY 10, 2010 [ 06/29/2025 9:06 PM ] ; 30 Jun 2025 1:18 AM "RTN","BIPATVW3",2,0) ;;8.5;IMMUNIZATION;**14,29,30,31**;OCT 24,2011;Build 137 "RTN","BIPATVW3",3,0) ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS * "RTN","BIPATVW3",4,0) ;; BUILD LISTMANAGER ARRAY FOR DISPLAY AND EDIT OF "RTN","BIPATVW3",5,0) ;; PATIENT'S IMMUNIZATION DATA, DISPLAY HELP. "RTN","BIPATVW3",6,0) ;; PATCH 8: Changes to discontinue High Risk forecast for Flu HADINFO+51,+56 "RTN","BIPATVW3",7,0) ;; PATCH 9: Accommodate new parameter options for HepB (Diabetes). ADDINFO+51 "RTN","BIPATVW3",8,0) ;; PATCH 14: Code to collect High Risk Pneumo, HepB (DM), HepA&B (CLD/HepC) ADDINFO+64 "RTN","BIPATVW3",9,0) ;; PATCH 31: FID-98855 RZV added to risk "RTN","BIPATVW3",10,0) ; "RTN","BIPATVW3",11,0) ; "RTN","BIPATVW3",12,0) ;---------- "RTN","BIPATVW3",13,0) LASTLET(BIDFN,BIRMAX,BIENT) ;EP "RTN","BIPATVW3",14,0) ;---> Retrieve date of last letter sent to this patient and "RTN","BIPATVW3",15,0) ;---> display it just below forecast. "RTN","BIPATVW3",16,0) ;---> Parameters: "RTN","BIPATVW3",17,0) ; 1 - BIDFN (req) Patient's IEN in VA PATIENT File #2. "RTN","BIPATVW3",18,0) ; 2 - BIRMAX (ret) Maximum Right column line number. "RTN","BIPATVW3",19,0) ; 3 - BIENT (ret) Entry Number for LM selection in VALMY "RTN","BIPATVW3",20,0) ; "RTN","BIPATVW3",21,0) ;---> Check for BIDFN. "RTN","BIPATVW3",22,0) Q:$$DFNCHECK^BIUTL2() "RTN","BIPATVW3",23,0) ; "RTN","BIPATVW3",24,0) ;---> Call RPC to retrieve date of last letter sent. "RTN","BIPATVW3",25,0) ; BIRETVAL - Return value of valid data from RPC. "RTN","BIPATVW3",26,0) ; BIRETERR - Return value (text string) of error from RPC. "RTN","BIPATVW3",27,0) ; "RTN","BIPATVW3",28,0) N BIRETVAL,BIRETERR S BIRETVAL="" "RTN","BIPATVW3",29,0) ; "RTN","BIPATVW3",30,0) ;---> RPC to retrieve date of last letter sent. "RTN","BIPATVW3",31,0) D LASTLET^BIRPC5(.BIRETVAL,BIDFN) "RTN","BIPATVW3",32,0) ; "RTN","BIPATVW3",33,0) ;---> If BIRETERR has a value, display it and quit. "RTN","BIPATVW3",34,0) S BIRETERR=$P(BIRETVAL,BI31,2) "RTN","BIPATVW3",35,0) I BIRETERR]"" D "RTN","BIPATVW3",36,0) .D EN^DDIOL("* "_BIRETERR,"","!!?5"),DIRZ^BIUTL3() "RTN","BIPATVW3",37,0) .S BIRETVAL="ERROR!" "RTN","BIPATVW3",38,0) ; "RTN","BIPATVW3",39,0) ;---> Set BIDATE=to date of last letter sent to this patient. "RTN","BIPATVW3",40,0) N BIDATE S BIDATE=$P(BIRETVAL,BI31,1) "RTN","BIPATVW3",41,0) ; "RTN","BIPATVW3",42,0) ;---> Set formatted Last Letter Date line and index in ^TMP. "RTN","BIPATVW3",43,0) D RTCOL^BIPATVW1(.BIRMAX,,BIENT) "RTN","BIPATVW3",44,0) D RTCOL^BIPATVW1(.BIRMAX," Last Letter: "_BIDATE,BIENT) "RTN","BIPATVW3",45,0) ; "RTN","BIPATVW3",46,0) Q "RTN","BIPATVW3",47,0) ; "RTN","BIPATVW3",48,0) ; "RTN","BIPATVW3",49,0) ;---------- "RTN","BIPATVW3",50,0) CONTRAS(BIDFN,BILMAX,BIRMAX,BIENT) ;EP "RTN","BIPATVW3",51,0) ;---> Now retrieve Patient's Contraindications and append to "RTN","BIPATVW3",52,0) ;---> right half of screen, below Forecast. "RTN","BIPATVW3",53,0) ;---> Parameters: "RTN","BIPATVW3",54,0) ; 1 - BIDFN (req) Patient's IEN in VA PATIENT File #2. "RTN","BIPATVW3",55,0) ; 2 - BILMAX (ret) Maximum Left column line number. "RTN","BIPATVW3",56,0) ; 3 - BIRMAX (ret) Maximum Right column line number. "RTN","BIPATVW3",57,0) ; 4 - BIENT (ret) Entry Number for LM selection in VALMY "RTN","BIPATVW3",58,0) ; "RTN","BIPATVW3",59,0) ;---> Check for BIDFN. "RTN","BIPATVW3",60,0) Q:$$DFNCHECK^BIUTL2() "RTN","BIPATVW3",61,0) ; "RTN","BIPATVW3",62,0) ;---> Call RPC to retrieve Contraindications. "RTN","BIPATVW3",63,0) ; BIRETVAL - Return value of valid data from RPC. "RTN","BIPATVW3",64,0) ; BIRETERR - Return value (text string) of error from RPC. "RTN","BIPATVW3",65,0) ; "RTN","BIPATVW3",66,0) N BIRETVAL,BIRETERR S BIRETVAL="" "RTN","BIPATVW3",67,0) ; "RTN","BIPATVW3",68,0) ;---> RPC to retrieve Contraindications. "RTN","BIPATVW3",69,0) D CONTRAS^BIRPC5(.BIRETVAL,BIDFN) "RTN","BIPATVW3",70,0) ; "RTN","BIPATVW3",71,0) ;---> If BIRETERR has a value, display it and quit. "RTN","BIPATVW3",72,0) S BIRETERR=$P(BIRETVAL,BI31,2) "RTN","BIPATVW3",73,0) I BIRETERR]"" D EN^DDIOL("* "_BIRETERR,"","!!?5"),DIRZ^BIUTL3() Q "RTN","BIPATVW3",74,0) ; "RTN","BIPATVW3",75,0) ;---> Set BICONT=to a string of Contraindications for this patient. "RTN","BIPATVW3",76,0) N BICONT,BILINE S BICONT=$P(BIRETVAL,BI31,1) "RTN","BIPATVW3",77,0) S BILINE=BIRMAX S:BILINE<1 BILINE=1 "RTN","BIPATVW3",78,0) ; "RTN","BIPATVW3",79,0) ;---> Write Contraindications Header. "RTN","BIPATVW3",80,0) D:BICONT]"" "RTN","BIPATVW3",81,0) .D RTCOL^BIPATVW1(.BILINE,,BIENT) "RTN","BIPATVW3",82,0) .N X S X="-----------------------------------" "RTN","BIPATVW3",83,0) .D RTCOL^BIPATVW1(.BILINE,X,BIENT) "RTN","BIPATVW3",84,0) .D RTCOL^BIPATVW1(.BILINE," * CONTRAINDICATIONS/REFUSALS *",BIENT) "RTN","BIPATVW3",85,0) .D RTCOL^BIPATVW1(.BILINE,,BIENT) "RTN","BIPATVW3",86,0) ; "RTN","BIPATVW3",87,0) ;---> Build Listmanager array from BICONT string. "RTN","BIPATVW3",88,0) ; "RTN","BIPATVW3",89,0) F I=1:1 S Y=$P(BICONT,U,I) Q:Y="" D "RTN","BIPATVW3",90,0) .;---> Build display line for this Contraindication. "RTN","BIPATVW3",91,0) .N V S V="|" "RTN","BIPATVW3",92,0) .;S X=" "_$P(Y,V,2)_":",X=$$PAD^BIUTL5(X,14)_$P(Y,V,3),X=$E(X,1,40) "RTN","BIPATVW3",93,0) .S X=" "_$P(Y,V,2)_": "_$P(Y,V,3),X=$E(X,1,36) "RTN","BIPATVW3",94,0) .;---> Set formatted Contraindication line and index in ^TMP. "RTN","BIPATVW3",95,0) .D RTCOL^BIPATVW1(.BILINE,X,BIENT) "RTN","BIPATVW3",96,0) ; "RTN","BIPATVW3",97,0) ;---> Save maximum right column line number. "RTN","BIPATVW3",98,0) S BIRMAX=BILINE "RTN","BIPATVW3",99,0) Q "RTN","BIPATVW3",100,0) ; "RTN","BIPATVW3",101,0) ; "RTN","BIPATVW3",102,0) ;---------- "RTN","BIPATVW3",103,0) ADDINFO(BIDFN,BILINE,BIENT,BIDUZ2,BIFDT) ;EP "RTN","BIPATVW3",104,0) ;---> Display Additional Information from Patient Edit screen. "RTN","BIPATVW3",105,0) ;---> Parameters: "RTN","BIPATVW3",106,0) ; 1 - BIDFN (req) Patient's IEN in VA PATIENT File #2. "RTN","BIPATVW3",107,0) ; 2 - BIRMAX (req) Last Line# (last node in ^TMP array). "RTN","BIPATVW3",108,0) ; 3 - BIENT (ret) Entry Number for LM selection in VALMY "RTN","BIPATVW3",109,0) ; 5 - BIDUZ2 (req) DUZ(2) (for forecasting parameter display). "RTN","BIPATVW3",110,0) ; 4 - BIFDT (req) Forecast date (for High Risk display). "RTN","BIPATVW3",111,0) ; "RTN","BIPATVW3",112,0) ;---> Check for BIDFN. "RTN","BIPATVW3",113,0) Q:$$DFNCHECK^BIUTL2() "RTN","BIPATVW3",114,0) S:'$G(BIDUZ2) BIDUZ2=$G(DUZ(2)) "RTN","BIPATVW3",115,0) S:'$G(BIFDT) BIFDT=$G(DT) "RTN","BIPATVW3",116,0) ; "RTN","BIPATVW3",117,0) N X,Z S Z=BIENT "RTN","BIPATVW3",118,0) D WRITE^BIPATVW1(.BILINE,,1,Z) "RTN","BIPATVW3",119,0) D WRITE^BIPATVW1(.BILINE," ADDITIONAL PATIENT INFORMATION",,Z) "RTN","BIPATVW3",120,0) D WRITE^BIPATVW1(.BILINE," ------------------------------",,Z) "RTN","BIPATVW3",121,0) S X=$$DECEASED^BIUTL1(BIDFN,1) "RTN","BIPATVW3",122,0) D:X "RTN","BIPATVW3",123,0) .S X=" DECEASED on..........: "_$$TXDT1^BIUTL5(X) "RTN","BIPATVW3",124,0) .D WRITE^BIPATVW1(.BILINE,X,,Z) "RTN","BIPATVW3",125,0) I '$D(^BIP(BIDFN,0)) D Q "RTN","BIPATVW3",126,0) .S X=" This Patient is not in the Register." "RTN","BIPATVW3",127,0) .D WRITE^BIPATVW1(.BILINE,X,1,Z) "RTN","BIPATVW3",128,0) ; "RTN","BIPATVW3",129,0) S X=" Case Manager.........: "_$$CMGR^BIUTL1(BIDFN,1) "RTN","BIPATVW3",130,0) D WRITE^BIPATVW1(.BILINE,X,,Z) "RTN","BIPATVW3",131,0) S X=" Designated Provider..: "_$$DPRV^BIUTL1(BIDFN,1) "RTN","BIPATVW3",132,0) D WRITE^BIPATVW1(.BILINE,X,,Z) "RTN","BIPATVW3",133,0) S X=" Parent/Guardian......: "_$$PARENT^BIUTL1(BIDFN) "RTN","BIPATVW3",134,0) D WRITE^BIPATVW1(.BILINE,X,,Z) "RTN","BIPATVW3",135,0) S X=" Current Community....: "_$$CURCOM^BIUTL11(BIDFN,1) "RTN","BIPATVW3",136,0) D WRITE^BIPATVW1(.BILINE,X,,Z) "RTN","BIPATVW3",137,0) S X=" Date First Entered...: "_$$ENTERED^BIUTL1(BIDFN,,1) "RTN","BIPATVW3",138,0) S X=X_" ("_$$ENTERED^BIUTL1(BIDFN,1,1)_")" "RTN","BIPATVW3",139,0) D WRITE^BIPATVW1(.BILINE,X,,Z) "RTN","BIPATVW3",140,0) D "RTN","BIPATVW3",141,0) .N Y S Y=$$INACT^BIUTL1(BIDFN,1) "RTN","BIPATVW3",142,0) .Q:'Y "RTN","BIPATVW3",143,0) .S X=" Inactive Date........: "_Y "RTN","BIPATVW3",144,0) .I Z]"" S X=X_" (Reason: "_$$INACTRE^BIUTL1(BIDFN)_")" "RTN","BIPATVW3",145,0) .D WRITE^BIPATVW1(.BILINE,X,,Z) "RTN","BIPATVW3",146,0) .S X=" Made Inactive by.....: "_$$INACTUSR^BIUTL1(BIDFN) "RTN","BIPATVW3",147,0) .D WRITE^BIPATVW1(.BILINE,X,,Z) "RTN","BIPATVW3",148,0) ; "RTN","BIPATVW3",149,0) S X=$$MOVEDLOC^BIUTL1(BIDFN) "RTN","BIPATVW3",150,0) I X]"" S X=" Moved to/Tx Elsewhere: "_X D WRITE^BIPATVW1(.BILINE,X,,Z) "RTN","BIPATVW3",151,0) S X="" D "RTN","BIPATVW3",152,0) .Q:'$G(DT) N BIRISKI,BIRISKP "RTN","BIPATVW3",153,0) .; "RTN","BIPATVW3",154,0) .;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR "RTN","BIPATVW3",155,0) .;---> Accommodate new parameter options for HepB (Diabetes). "RTN","BIPATVW3",156,0) .;---> Set risk parameter equal to 12 = Hep B & Pneumo (this is NOT forecasting, "RTN","BIPATVW3",157,0) .;---> merely displaying Additional Patient Info). "RTN","BIPATVW3",158,0) .N BIRSK,BIRISKH S BIRSK=12 "RTN","BIPATVW3",159,0) .; "RTN","BIPATVW3",160,0) .;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR "RTN","BIPATVW3",161,0) .;---> Collect only Pneumo High Risk. "RTN","BIPATVW3",162,0) .;D RISK^BIDX(BIDFN,BIFDT,0,.BIRISKI,.BIRISKP) "RTN","BIPATVW3",163,0) .; "RTN","BIPATVW3",164,0) .;---> New parameter to return Hep B risk. (No longer include Flu.) "RTN","BIPATVW3",165,0) .;D RISK^BIDX(BIDFN,BIFDT,2,.BIRISKI,.BIRISKP) "RTN","BIPATVW3",166,0) .; "RTN","BIPATVW3",167,0) .;********** PATCH 14, v8.5, AUG 01,2017, IHS/CMI/MWR "RTN","BIPATVW3",168,0) .;---> Code to collect High Risk Pneumo, HepB (DM), HepA&B (CLD/HepC) "RTN","BIPATVW3",169,0) .;D RISK^BIDX(BIDFN,BIFDT,BIRSK,,.BIRISKP,.BIRISKH) "RTN","BIPATVW3",170,0) .; "RTN","BIPATVW3",171,0) .;---> Set Patient Age in years for this Forecast Date. "RTN","BIPATVW3",172,0) .;V8.5 PATCH 29 - FID-106359 Tdap age check "RTN","BIPATVW3",173,0) .N BIAGE "RTN","BIPATVW3",174,0) .S BIAGE=+$$AGE^BIUTL1(BIDFN,1,BIFDT) "RTN","BIPATVW3",175,0) .N BIRISKF "RTN","BIPATVW3",176,0) .S BIRISKF="",BIRSK="" "RTN","BIPATVW3",177,0) .D RISKP^BIDX(BIDFN,BIFDT,BIAGE,1,.BIRISKF) S:BIRISKF BIRSK=BIRSK_1 "RTN","BIPATVW3",178,0) .D RISKB^BIDX(BIDFN,BIFDT,BIAGE,.BIRISKF) S:BIRISKF BIRSK=BIRSK_2 "RTN","BIPATVW3",179,0) .D RISKAB^BIDX(BIDFN,BIFDT,.BIRISKF) S:BIRISKF BIRSK=BIRSK_3 "RTN","BIPATVW3",180,0) .;V8.9 P31 - FID-98855 RZV RISK "RTN","BIPATVW3",181,0) .D RISKRZV^BIDX2(BIDFN,BIFDT,BIAGE,.BIRISKF) I BIRISKF S BIRSK=BIRSK_9 "RTN","BIPATVW3",182,0) .I 'BIRSK S X="None on record" Q "RTN","BIPATVW3",183,0) .S X=$$RISKTX^BISITE1(BIRSK) "RTN","BIPATVW3",184,0) S X=" High Risk Pneumo,Hep.: "_X "RTN","BIPATVW3",185,0) ;********** "RTN","BIPATVW3",186,0) ; "RTN","BIPATVW3",187,0) S X=X_" (as of "_$$SLDT2^BIUTL5(BIFDT,1)_")" "RTN","BIPATVW3",188,0) D WRITE^BIPATVW1(.BILINE,X,,Z) "RTN","BIPATVW3",189,0) S X=" Forecast Flu/Pneumo..: "_$$INFL^BIUTL11(BIDFN,1) "RTN","BIPATVW3",190,0) D WRITE^BIPATVW1(.BILINE,X,,Z) "RTN","BIPATVW3",191,0) ;D:$G(BIDUZ2) ;Uncomment to display Pneumo Site Parameter. "RTN","BIPATVW3",192,0) ;.N X,Y,Z S X=$$PNMAGE^BIPATUP2(BIDUZ2) "RTN","BIPATVW3",193,0) ;.S Y=$P(X,U),Z=$P(X,U,2) "RTN","BIPATVW3",194,0) ;. X=Y_" years old, "_$S(Z:"every 6 years.",1:"one time only.") "RTN","BIPATVW3",195,0) ;.S X=" Pneumo Site Parameter: Set at "_X "RTN","BIPATVW3",196,0) ;.D WRITE^BIPATVW1(.BILINE,X,,Z) "RTN","BIPATVW3",197,0) S X=" Mother's HBsAG Status: "_$$T^BITRS($$MOTHER^BIUTL11(BIDFN,1)) "RTN","BIPATVW3",198,0) D WRITE^BIPATVW1(.BILINE,X,,Z) "RTN","BIPATVW3",199,0) S X=$$NEXTAPPT^BIUTL11(BIDFN) "RTN","BIPATVW3",200,0) I ((X]"")&(X'="None")) S X=" Next Appointment.....: "_$E(X,1,54) D "RTN","BIPATVW3",201,0) .D WRITE^BIPATVW1(.BILINE,X,,Z) "RTN","BIPATVW3",202,0) D "RTN","BIPATVW3",203,0) .N Y S Y=$$CONSENT^BIUTL1(BIDFN) "RTN","BIPATVW3",204,0) .I Y=1 S X="Consented" Q "RTN","BIPATVW3",205,0) .I Y=0 S X="Declined" Q "RTN","BIPATVW3",206,0) .S X="Unknown" "RTN","BIPATVW3",207,0) S X=" State Registry.......: "_X "RTN","BIPATVW3",208,0) D WRITE^BIPATVW1(.BILINE,X,,Z) "RTN","BIPATVW3",209,0) S X=" Other Information....: "_$$OTHERIN^BIUTL11(BIDFN) "RTN","BIPATVW3",210,0) D WRITE^BIPATVW1(.BILINE,X,,Z) "RTN","BIPATVW3",211,0) D WRITE^BIPATVW1(.BILINE,,,Z) "RTN","BIPATVW3",212,0) Q "RTN","BIPATVW3",213,0) ; "RTN","BIPATVW3",214,0) ; "RTN","BIPATVW3",215,0) ;---------- "RTN","BIPATVW3",216,0) HELP ;EP "RTN","BIPATVW3",217,0) ;----> Explanation of this report. "RTN","BIPATVW3",218,0) N BITEXT D TEXT1(.BITEXT) "RTN","BIPATVW3",219,0) D START^BIHELP("PATIENT VIEW SCREEN - HELP",.BITEXT) "RTN","BIPATVW3",220,0) Q "RTN","BIPATVW3",221,0) ; "RTN","BIPATVW3",222,0) ; "RTN","BIPATVW3",223,0) ;---------- "RTN","BIPATVW3",224,0) TEXT1(BITEXT) ;EP "RTN","BIPATVW3",225,0) ;; "RTN","BIPATVW3",226,0) ;;This is the main Patient View Screen, the single point from "RTN","BIPATVW3",227,0) ;;which you manage all of an individual patient's immunization data. "RTN","BIPATVW3",228,0) ;; "RTN","BIPATVW3",229,0) ;;The screen is divided horizontally into THREE SECTIONS: "RTN","BIPATVW3",230,0) ;; "RTN","BIPATVW3",231,0) ;;The TOP third of the screen lists the patient's demographic information, "RTN","BIPATVW3",232,0) ;;most of which is edited through the RPMS Patient Registration. "RTN","BIPATVW3",233,0) ;; "RTN","BIPATVW3",234,0) ;;The MIDDLE third of the screen is subdivided into LEFT and RIGHT Columns: "RTN","BIPATVW3",235,0) ;; "RTN","BIPATVW3",236,0) ;; The LEFT column lists the Patient's Immunization and Skin Test "RTN","BIPATVW3",237,0) ;; history, including adverse reactions. "RTN","BIPATVW3",238,0) ;; "RTN","BIPATVW3",239,0) ;; The RIGHT column lists the patient's Immunizations Due, date of last "RTN","BIPATVW3",240,0) ;; letter sent to the patient, and any contraindications. "RTN","BIPATVW3",241,0) ;; "RTN","BIPATVW3",242,0) ;;The BOTTOM third of the screen lists Actions you can take to add or edit "RTN","BIPATVW3",243,0) ;;the patient's immunization data, or to display other relevant patient "RTN","BIPATVW3",244,0) ;;information. "RTN","BIPATVW3",245,0) ;; "RTN","BIPATVW3",246,0) ;;For many patients, there is more information than can be displayed "RTN","BIPATVW3",247,0) ;;in the middle section of the screen. To view all of the information "RTN","BIPATVW3",248,0) ;;on a Patient's Immunization History it may be necessary to use the "RTN","BIPATVW3",249,0) ;;"arrow keys" to scroll up and down. "RTN","BIPATVW3",250,0) ;; "RTN","BIPATVW3",251,0) ;;The Actions at the bottom of the screen are: "RTN","BIPATVW3",252,0) ;; "RTN","BIPATVW3",253,0) ;; A Add Immunization - to add a new immunization "RTN","BIPATVW3",254,0) ;; D Delete Visit - to delete an immunization "RTN","BIPATVW3",255,0) ;; P Patient Edit - to edit patient guardian, inactive date, etc. "RTN","BIPATVW3",256,0) ;; S Skin Test Add - to add a skin test "RTN","BIPATVW3",257,0) ;; I ImmServe Profile - to view details of the forecast "RTN","BIPATVW3",258,0) ;; C Contraindications - to add/edit/delete contraindications "RTN","BIPATVW3",259,0) ;; E Edit Visit - to change data of an immunization "RTN","BIPATVW3",260,0) ;; H Health Summary - to view the patient's Health Summary "RTN","BIPATVW3",261,0) ;; L Letter Print - to select and print a patient letter "RTN","BIPATVW3",262,0) ;; "RTN","BIPATVW3",263,0) ;; "RTN","BIPATVW3",264,0) ;;There are also Hidden Actions, which you can review by typing ?? "RTN","BIPATVW3",265,0) ;;at the "Select Action:" prompt. If you entered ??, the Hidden "RTN","BIPATVW3",266,0) ;;Actions will be displayed in a list after this text. Any of the "RTN","BIPATVW3",267,0) ;;Hidden Actions can be executed by typing their names or synonyms "RTN","BIPATVW3",268,0) ;;at the "Select Action:" prompt, just as with the primary Actions. "RTN","BIPATVW3",269,0) ;; "RTN","BIPATVW3",270,0) ;;NOTE! There are two ways to print a patient's Immunization History: "RTN","BIPATVW3",271,0) ;; "RTN","BIPATVW3",272,0) ;; 1) At the Select Action prompt enter "PL" or "Print List". "RTN","BIPATVW3",273,0) ;; This action will print or queue the entire Patient View Screen "RTN","BIPATVW3",274,0) ;; as it appears on your screen. "RTN","BIPATVW3",275,0) ;; "RTN","BIPATVW3",276,0) ;; or 2) Enter "L" or "Letter Print" and select the "Official "RTN","BIPATVW3",277,0) ;; Immunization Record" for the form letter to print. "RTN","BIPATVW3",278,0) ;; "RTN","BIPATVW3",279,0) D LOADTX("TEXT1",,.BITEXT) "RTN","BIPATVW3",280,0) Q "RTN","BIPATVW3",281,0) ; "RTN","BIPATVW3",282,0) ; "RTN","BIPATVW3",283,0) ;---------- "RTN","BIPATVW3",284,0) LOADTX(BILINL,BITAB,BITEXT) ;EP "RTN","BIPATVW3",285,0) Q:$G(BILINL)="" "RTN","BIPATVW3",286,0) N I,T,X S T="" S:'$D(BITAB) BITAB=5 F I=1:1:BITAB S T=T_" " "RTN","BIPATVW3",287,0) F I=1:1 S X=$T(@BILINL+I) Q:X'[";;" S BITEXT(I)=T_$P(X,";;",2) "RTN","BIPATVW3",288,0) Q "RTN","BIPOST") 0^28^B40999662 "RTN","BIPOST",1,0) BIPOST ;IHS/CMI/MWR - POST-INIT ROUTINE; ; 07 May 2025 1:35 PM [ 06/12/2025 12:05 PM ] "RTN","BIPOST",2,0) ;;8.5;IMMUNIZATION;**27,28,29,30,31**;OCT 24,2011;Build 137 "RTN","BIPOST",3,0) ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS * "RTN","BIPOST",4,0) ;; PATCH 3: Set MenCY-Hib (148) and Flu-nasal4 (149) and all Skin Tests "RTN","BIPOST",5,0) ;; in the Vaccine Table to Inactive. START+30 "RTN","BIPOST",6,0) ;; PATCH 3: Set all Skin Tests in the Skin Test table to Inactive, except "RTN","BIPOST",7,0) ;; PPD and Tetanus. START+38 "RTN","BIPOST",8,0) ;; PATCH 4, v8.5: Update Source options in Imm Lot File. START+9 "RTN","BIPOST",9,0) ;; PATCH 5, v8.5: Remove dash from Eligibility Codes. "RTN","BIPOST",10,0) ;; PATCH 5, v8.5: Add SNOMED Codes to all Contraindications. "RTN","BIPOST",11,0) ;; PATCH 5, v8.5: Restandardize Vaccine Table, with updates from BITN. "RTN","BIPOST",12,0) ;; PATCH 6, v8.5: Restandardize Vaccine Table, with updates from BITN. "RTN","BIPOST",13,0) ;; PATCH 8: Changes to Set Mening C CVX 103 vaccine to Inactive. START+55 "RTN","BIPOST",14,0) ;; PATCH 9: Restandardize Vaccine Table, with updates from BITN. START+49 "RTN","BIPOST",15,0) ;; Changes to force specified vaccines active. START+52 "RTN","BIPOST",16,0) ;; Update Taxonomies. START+142 "RTN","BIPOST",17,0) ;; PATCH 10: Restandardize Vaccine Table, with updates from BITN. START+49 "RTN","BIPOST",18,0) ;; Changes to force specified vaccines active. START+56 "RTN","BIPOST",19,0) ;; Update BI TABLE DATA ELEMENTS File. START+154 "RTN","BIPOST",20,0) ;; PATCH 12: Restandardize Vaccine Table, with updates from BITN. "RTN","BIPOST",21,0) ;; PATCH 13: Restandardize Vaccine Table, with updates from BITN (and BIMAN below). "RTN","BIPOST",22,0) ;; PATCH 14: Make old Rabies CVX 18 inactive. "RTN","BIPOST",23,0) ;; Set High Risk parameter selection = zero/none. "RTN","BIPOST",24,0) ;; PATCH 15: Restandardize Vaccine Table, make CVX 186 Active. START+54 "RTN","BIPOST",25,0) ;; PATCH 16: Add new vaccines & manufacturers, restandardize Vaccine Table, START "RTN","BIPOST",26,0) ;; PATCH 17: Set Short Name for MENING Vaccine Group to "MENACWY". START+46 "RTN","BIPOST",27,0) ;; Add Men-B Vaccine Group. START+49 "RTN","BIPOST",28,0) ;; PATCH 18: ICE changes. "RTN","BIPOST",29,0) ;; PATCH 19: Upload new NDC entries from CDC. "RTN","BIPOST",30,0) ;; PATCH 21: Vaccine Table updates, DTS installation. "RTN","BIPOST",31,0) ;; PATCH 22: COMMENT OUT PREVIOUS TASKS. "RTN","BIPOST",32,0) ;; PATCH 23: Update display comments, remove vaccine table update text "RTN","BIPOST",33,0) ;; PATCH 24: Update display comments "RTN","BIPOST",34,0) ;; PATCH 25: Rebuild BIEXPDD, change BI MAILING ADD-STREET-2 to BI MAILING ADD-STREET 2 in ^BILET and ^BILETS "RTN","BIPOST",35,0) ;; PATCH 26: Remove external dates in V IMMUNIZATION "RTN","BIPOST",36,0) ;; PATCH 27: Remove history section from due letters "RTN","BIPOST",37,0) ;; PATCH 28: ADD SDV FILE 9002084.98 "RTN","BIPOST",38,0) ;; PATCH 29: "RTN","BIPOST",39,0) ; "RTN","BIPOST",40,0) ; "RTN","BIPOST",41,0) ;---------- "RTN","BIPOST",42,0) START ;EP "RTN","BIPOST",43,0) ;---> Update software after KIDS installation. "RTN","BIPOST",44,0) ; "RTN","BIPOST",45,0) D SETVARS^BIUTL5 S BIPOP=0 "RTN","BIPOST",46,0) D VIMM "RTN","BIPOST",47,0) D V85P27 "RTN","BIPOST",48,0) D EXIT "RTN","BIPOST",49,0) Q "RTN","BIPOST",50,0) ;===== "RTN","BIPOST",51,0) Q "RTN","BIPOST",52,0) V85P27 ;VERSION 8.5 PATCH 27 "RTN","BIPOST",53,0) ;NO POST INSTALL FOR P27 "RTN","BIPOST",54,0) Q "RTN","BIPOST",55,0) ;===== "RTN","BIPOST",56,0) OLDBLDS ;OLD BUILD CODE "RTN","BIPOST",57,0) ; "RTN","BIPOST",58,0) ;---> Update "Last Version Fully Installed" Field in BI SITE PARAMETER File. "RTN","BIPOST",59,0) N N S N=0 F S N=$O(^BISITE(N)) Q:'N D "RTN","BIPOST",60,0) .S $P(^BISITE(N,0),"^",15)=$$VER^BILOGO "RTN","BIPOST",61,0) Q "RTN","BIPOST",62,0) ; "RTN","BIPOST",63,0) ;---------- "RTN","BIPOST",64,0) EXIT ;EP "RTN","BIPOST",65,0) D TEXT1 "RTN","BIPOST",66,0) W " v"_$P($T(+2),";",3)_" p"_$P($P($T(+2),";",5),"**",2)_"." "RTN","BIPOST",67,0) D TEXT2,DIRZ^BIUTL3() "RTN","BIPOST",68,0) D KILLALL^BIUTL8(1) "RTN","BIPOST",69,0) Q "RTN","BIPOST",70,0) ; "RTN","BIPOST",71,0) ; "RTN","BIPOST",72,0) ;---------- "RTN","BIPOST",73,0) ;put the following back into TEXT1 if needed "RTN","BIPOST",74,0) ;- This concludes the BI Vaccine Table Update program. - "RTN","BIPOST",75,0) TEXT1 ;EP "RTN","BIPOST",76,0) ;; "RTN","BIPOST",77,0) ;; "RTN","BIPOST",78,0) ;; "RTN","BIPOST",79,0) ;; "RTN","BIPOST",80,0) ;; "RTN","BIPOST",81,0) ;; "RTN","BIPOST",82,0) ;; "RTN","BIPOST",83,0) ;; "RTN","BIPOST",84,0) ;; * CONGRATULATIONS! * "RTN","BIPOST",85,0) ;; "RTN","BIPOST",86,0) ;; You have successfully installed Immunization "RTN","BIPOST",87,0) W @IOF "RTN","BIPOST",88,0) D PRINTX("TEXT1") "RTN","BIPOST",89,0) Q "RTN","BIPOST",90,0) ; "RTN","BIPOST",91,0) ; "RTN","BIPOST",92,0) ;---------- "RTN","BIPOST",93,0) TEXT2 ;EP "RTN","BIPOST",94,0) ;; "RTN","BIPOST",95,0) ;; "RTN","BIPOST",96,0) ;; "RTN","BIPOST",97,0) ;; "RTN","BIPOST",98,0) ;; "RTN","BIPOST",99,0) ;; "RTN","BIPOST",100,0) ;; "RTN","BIPOST",101,0) ;; "RTN","BIPOST",102,0) D PRINTX("TEXT2") "RTN","BIPOST",103,0) Q "RTN","BIPOST",104,0) ; "RTN","BIPOST",105,0) ; "RTN","BIPOST",106,0) ;---------- "RTN","BIPOST",107,0) TEXT3 ;EP "RTN","BIPOST",108,0) ;; "RTN","BIPOST",109,0) ;; "RTN","BIPOST",110,0) ;; "RTN","BIPOST",111,0) ;; "RTN","BIPOST",112,0) ;; "RTN","BIPOST",113,0) ;; * NOTE!!! * "RTN","BIPOST",114,0) ;; "RTN","BIPOST",115,0) ;; NOTE: Be sure to install the ICE Forecaster per the "RTN","BIPOST",116,0) ;; ICE Installation Instructions distributed with this patch. "RTN","BIPOST",117,0) ;; "RTN","BIPOST",118,0) ;; * NOTE!!! * "RTN","BIPOST",119,0) ;; "RTN","BIPOST",120,0) ;; "RTN","BIPOST",121,0) ;; "RTN","BIPOST",122,0) ;; "RTN","BIPOST",123,0) ;; "RTN","BIPOST",124,0) ;; "RTN","BIPOST",125,0) ;; "RTN","BIPOST",126,0) ;; "RTN","BIPOST",127,0) W @IOF "RTN","BIPOST",128,0) D PRINTX("TEXT2") "RTN","BIPOST",129,0) Q "RTN","BIPOST",130,0) ; "RTN","BIPOST",131,0) ; "RTN","BIPOST",132,0) ;---------- "RTN","BIPOST",133,0) PRINTX(BILINL,BITAB) ;EP "RTN","BIPOST",134,0) ;---> Print text at specified line label. "RTN","BIPOST",135,0) ; "RTN","BIPOST",136,0) Q:$G(BILINL)="" "RTN","BIPOST",137,0) N I,T,X S T="" S:'$D(BITAB) BITAB=5 F I=1:1:BITAB S T=T_" " "RTN","BIPOST",138,0) F I=1:1 S X=$T(@BILINL+I) Q:X'[";;" W !,T,$P(X,";;",2) "RTN","BIPOST",139,0) Q "RTN","BIPOST",140,0) ; "RTN","BIPOST",141,0) ; "RTN","BIPOST",142,0) ;---------- "RTN","BIPOST",143,0) IMMPATH ;EP "RTN","BIPOST",144,0) ;---> Update path for new Immserve files. "RTN","BIPOST",145,0) N N,X,Y S Y=$$VERSION^%ZOSV(1) D "RTN","BIPOST",146,0) .I Y["Windows" S X="C:\Program Files\Immserve852\" Q "RTN","BIPOST",147,0) .I Y["UNIX" S X="/usr/local/immserve852/" "RTN","BIPOST",148,0) ; "RTN","BIPOST",149,0) S N=0 "RTN","BIPOST",150,0) F S N=$O(^BISITE(N)) Q:'N D "RTN","BIPOST",151,0) .S $P(^BISITE(N,0),"^",18)=X "RTN","BIPOST",152,0) Q "RTN","BIPOST",153,0) ; "RTN","BIPOST",154,0) ; "RTN","BIPOST",155,0) ;---------- "RTN","BIPOST",156,0) REINDEX ;EP "RTN","BIPOST",157,0) ;---> Not called. Programmer to use if KIDS fails to index these files. "RTN","BIPOST",158,0) ; "RTN","BIPOST",159,0) N DIK "RTN","BIPOST",160,0) ;S DIK="^BISERT(" D IXALL^DIK "RTN","BIPOST",161,0) F DIK="^BINFO(","^BILETS(","^BIVT100(","^BIERR(","^BINFO(","^BIEXPDD(","^BISERT(","^BICONT(" D "RTN","BIPOST",162,0) .D IXALL^DIK "RTN","BIPOST",163,0) Q "RTN","BIPOST",164,0) ; "RTN","BIPOST",165,0) ; "RTN","BIPOST",166,0) KEYS ;EP "RTN","BIPOST",167,0) ;---> Clean up subordinate keys (there should be none). "RTN","BIPOST",168,0) N X,Y "RTN","BIPOST",169,0) F X="BIZ EDIT PATIENTS","BIZ MANAGER","BIZMENU" D "RTN","BIPOST",170,0) .S Y=$O(^DIC(19.1,"B",X,0)) K @("^DIC(19.1,"""_Y_""",3)") "RTN","BIPOST",171,0) Q "RTN","BIPOST",172,0) ; "RTN","BIPOST",173,0) ; "RTN","BIPOST",174,0) REINDLS ;EP "RTN","BIPOST",175,0) ;---> Reindex BI LETTER SAMPLE File. "RTN","BIPOST",176,0) N X,Y "RTN","BIPOST",177,0) S DIK="^BILETS(" "RTN","BIPOST",178,0) D IXALL^DIK "RTN","BIPOST",179,0) S DIK="^BIMAN(" "RTN","BIPOST",180,0) D IXALL^DIK "RTN","BIPOST",181,0) Q "RTN","BIPOST",182,0) ; "RTN","BIPOST",183,0) ; "RTN","BIPOST",184,0) ;********** PATCH 21, v8.5, APR 01,2021, IHS/CMI/MWR "RTN","BIPOST",185,0) DTSPOST ;EP - Post Installation Code "RTN","BIPOST",186,0) ;---> Per Brian Everett, DTS, for p21 DTS Install. "RTN","BIPOST",187,0) ; "RTN","BIPOST",188,0) ;Compile class process "RTN","BIPOST",189,0) ; "RTN","BIPOST",190,0) N TRIEN,EXEC,ERR,CURR,TYP,FREQ,OPTION,OPTN,SDATM,ERROR "RTN","BIPOST",191,0) ; "RTN","BIPOST",192,0) ;For each build, set this to the 9002084.71 file entry to load "RTN","BIPOST",193,0) S TRIEN=1 "RTN","BIPOST",194,0) ; "RTN","BIPOST",195,0) ;Import BI class "RTN","BIPOST",196,0) K ERR "RTN","BIPOST",197,0) I $G(TRIEN)'="" D IMPORT^BICLASS(TRIEN,.ERR) "RTN","BIPOST",198,0) I $G(ERR) Q "RTN","BIPOST",199,0) ; "RTN","BIPOST",200,0) ;Run the task to update the local content "RTN","BIPOST",201,0) D TASK^BIAPIDTS "RTN","BIPOST",202,0) ; "RTN","BIPOST",203,0) ;Schedule the task to run on a daily basis "RTN","BIPOST",204,0) S OPTION="BI DTS UPDATE",FREQ="1D" ; BI DTS UPDATE TASK "RTN","BIPOST",205,0) S OPTN=$$DTSFIND(OPTION) Q:OPTN'>0 "RTN","BIPOST",206,0) I OPTN>0 D "RTN","BIPOST",207,0) . I $O(^DIC(19.2,"B",OPTN,""))'="" Q ; If already scheduled, do not schedule again. "RTN","BIPOST",208,0) . S SDATM=$$FMADD^XLFDT(DT,1)_".23" ; Schedule the task for 2300 hours (11PM). "RTN","BIPOST",209,0) . D RESCH^XUTMOPT(OPTION,SDATM,"",FREQ,"L",.ERROR) "RTN","BIPOST",210,0) Q "RTN","BIPOST",211,0) ; "RTN","BIPOST",212,0) ; "RTN","BIPOST",213,0) ;********** PATCH 21, v8.5, APR 01,2021, IHS/CMI/MWR "RTN","BIPOST",214,0) DTSFIND(X) ;EP Find an Option "RTN","BIPOST",215,0) ;---> Per Brian Everett, DTS, for p21 DTS Install. "RTN","BIPOST",216,0) ;---> Find an option. "RTN","BIPOST",217,0) S X=$O(^DIC(19,"B",X,0)) I X'>0 Q -1 "RTN","BIPOST",218,0) Q X "RTN","BIPOST",219,0) ;********** "RTN","BIPOST",220,0) VIMM ;-- 88884 remove external dates from V IMM 1201 "RTN","BIPOST",221,0) N VDA,VDAT "RTN","BIPOST",222,0) S VDA=0 F S VDA=$O(^AUPNVIMM(VDA)) Q:'VDA D "RTN","BIPOST",223,0) . S VDAT=$P($G(^AUPNVIMM(VDA,12)),U) "RTN","BIPOST",224,0) . I VDAT["/" S $P(^AUPNVIMM(VDA,12),U)="" "RTN","BIPOST",225,0) Q "RTN","BIPOST",226,0) ; "RTN","BIPOST",227,0) V85P28 ;EP; VERSION 8.5 PATCH 28 "RTN","BIPOST",228,0) S X=$$ADD^XPDMENU("BI MENU-MANAGER","BI TABLE SPLIT DOSE VACCINE","SDV",40) "RTN","BIPOST",229,0) Q "RTN","BIPOST",230,0) ;===== "RTN","BIPOST",231,0) ; "RTN","BIPOST",232,0) V85P29 ;EP; VERSION 8.5 PATCH 29 "RTN","BIPOST",233,0) V85P31 ;EP; VERSION 8.5 PATCH 31 "RTN","BIPOST",234,0) S X19="INCLUDE RISK FACTORS^NJ4,0^^0;19^K:(X>99999999999)!(X<0)!(X?.E1"".""1N.N.U) X" "RTN","BIPOST",235,0) S GBL=U_"DD("_"9002084.02,.19,0)" "RTN","BIPOST",236,0) S @GBL=X19 "RTN","BIPOST",237,0) L +^BIVARR:10 E Q -1 "RTN","BIPOST",238,0) S X="" "RTN","BIPOST",239,0) F S X=$O(^BIVARR(X)) Q:X="" K ^BIVARR(X) "RTN","BIPOST",240,0) D VARR^BIUTL3 "RTN","BIPOST",241,0) L -^BIVARR "RTN","BIPOST",242,0) Q "RTN","BIPOST",243,0) ;===== "RTN","BIPOST",244,0) ; "RTN","BIPOST",245,0) V85P30 ;EP; VERSION 8.5 PATCH 30 "RTN","BIPOST",246,0) N X,Y,Z,DA,DIE,DIC "RTN","BIPOST",247,0) S (DA,DA(1))=$O(^DIC(19,"B","BI MENU-MANAGER",0)) "RTN","BIPOST",248,0) Q:'DA "RTN","BIPOST",249,0) S X=+$O(^DIC(19,"B","BI PT WITH 70",0)) "RTN","BIPOST",250,0) Q:$D(^DIC(19,DA,10,"B",X)) "RTN","BIPOST",251,0) S DIC="^DIC(19,"_DA_",10," "RTN","BIPOST",252,0) S DIC(0)="L" "RTN","BIPOST",253,0) S DIC("DR")="2////GR70" "RTN","BIPOST",254,0) D FILE^DICN "RTN","BIPOST",255,0) Q "RTN","BIPOST",256,0) ;===== "RTN","BIPOST",257,0) ; "RTN","BIREPCSV") 0^22^B23090963 "RTN","BIREPCSV",1,0) BIREPCSV ;IHS/CMI/MWR - REPORT, CSV CALL; MAY 10, 2010 "RTN","BIREPCSV",2,0) ;;8.5;IMMUNIZATION;**31**;OCT 24,2011;Build 137 "RTN","BIREPCSV",3,0) ; "RTN","BIREPCSV",4,0) DELIM(BIREPT,BIREPTN,BIREPTS,BIREPTQ) ;EP "RTN","BIREPCSV",5,0) D FULL^VALM1 "RTN","BIREPCSV",6,0) ;---> Main entry point for delmited output of the Two-Yr-Old Rates Report. "RTN","BIREPCSV",7,0) W !!!,"You have selected to create a .csv (comma delimited) file for use in EXCEL." "RTN","BIREPCSV",8,0) W !,"You can have this output file created as a file in your site's export" "RTN","BIREPCSV",9,0) W !,"directory (",$$GETDEDIR(),") OR you can have the delimited output display" "RTN","BIREPCSV",10,0) W !,"on your screen so that you can do a file capture. Keep in mind that if you" "RTN","BIREPCSV",11,0) W !,"choose to do a screen capture you CANNOT Queue your report to run in" "RTN","BIREPCSV",12,0) W !,"the background!!",!! "RTN","BIREPCSV",13,0) DE1 ; "RTN","BIREPCSV",14,0) S DIR(0)="S^S:SCREEN - delimited output will display on screen for capture;F:FILE - delimited output will be written to an output file",DIR("A")="Select output type",DIR("B")="S" KILL DA D ^DIR KILL DIR "RTN","BIREPCSV",15,0) I $D(DIRUT) Q "RTN","BIREPCSV",16,0) S BIDELT=Y "RTN","BIREPCSV",17,0) I BIDELT="S" G DP "RTN","BIREPCSV",18,0) PT1 ; "RTN","BIREPCSV",19,0) S DIR(0)="F^1:40",DIR("A")="Enter a filename for the .csv file (no more than 40 characters)" KILL DA D ^DIR KILL DIR "RTN","BIREPCSV",20,0) I $D(DIRUT) G DE1 "RTN","BIREPCSV",21,0) I Y="" G DE1 "RTN","BIREPCSV",22,0) I Y["/" W !!!,"Your filename cannot contain a '/'." H 2 G PT1 "RTN","BIREPCSV",23,0) S BIDELF=Y "RTN","BIREPCSV",24,0) W !!,"When the report is finished your delimited output can be found in the",!,$$GETDEDIR()," directory." "RTN","BIREPCSV",25,0) S BIDEDIR=$$GETDEDIR() "RTN","BIREPCSV",26,0) W !,"The filename will be ",BIDELF_".csv.",!! S BIDELF=BIDELF_".csv" "RTN","BIREPCSV",27,0) ; "RTN","BIREPCSV",28,0) S DIR(0)="Y",DIR("A")="Do you wish to Queue this to the background",DIR("B")="N" KILL DA D ^DIR KILL DIR "RTN","BIREPCSV",29,0) I $D(DIRUT) G PT1 "RTN","BIREPCSV",30,0) I Y D Q "RTN","BIREPCSV",31,0) .K ZTSAVE S ZTSAVE("BI*")="" "RTN","BIREPCSV",32,0) .S ZTRTN="DP^BIREPCSV",ZTDESC=BIREPTN,ZTIO="",ZTDTH=DT "RTN","BIREPCSV",33,0) .D ^%ZTLOAD "RTN","BIREPCSV",34,0) .D PAUSE,EXIT,RESET(BIREPTS) "RTN","BIREPCSV",35,0) ; "RTN","BIREPCSV",36,0) W !!?10,"This may take some time. Please hold on...",! "RTN","BIREPCSV",37,0) ; "RTN","BIREPCSV",38,0) DP ;---> Prepare report. "RTN","BIREPCSV",39,0) K ^TMP(BIREPT,$J),^TMP("BIDUL",$J) "RTN","BIREPCSV",40,0) N VALM,VALMHDR "RTN","BIREPCSV",41,0) D START(BIREPTS) ;BIQDT,BITAR,BIAGRPS,.BICC,.BIHCF,.BICM,.BIBEN,BISITE,BIUP),HDR(BIREPTS) "RTN","BIREPCSV",42,0) ; "RTN","BIREPCSV",43,0) ;D PRTLST^BIUTL8("BIREPT1"),EXIT "RTN","BIREPCSV",44,0) ;OPEN HOST FILE AND LOOP AND SAVE OFF FILE "RTN","BIREPCSV",45,0) I BIDELT="S" D "RTN","BIREPCSV",46,0) .N N,BITEXT S N=0 "RTN","BIREPCSV",47,0) .F S N=$O(VALMHDR(N)) Q:'N W !,VALMHDR(N) "RTN","BIREPCSV",48,0) .F S N=$O(^TMP(BIREPT,$J,N)) Q:'N D "RTN","BIREPCSV",49,0) ..S BITEXT=^TMP(BIREPT,$J,N,0) "RTN","BIREPCSV",50,0) ..W !,BITEXT "RTN","BIREPCSV",51,0) .W ! "RTN","BIREPCSV",52,0) I BIDELT="F" D "RTN","BIREPCSV",53,0) .S Y=$$OPEN^%ZISH(BIDEDIR,BIDELF,"W") "RTN","BIREPCSV",54,0) .I Y=1 W:'$D(ZTQUEUED) !!,"Cannot open host file to write out CSV data. Notify programmer." Q "RTN","BIREPCSV",55,0) .U IO "RTN","BIREPCSV",56,0) .N N,BITEXT S N=0 "RTN","BIREPCSV",57,0) .F S N=$O(VALMHDR(N)) Q:'N W VALMHDR(N),! "RTN","BIREPCSV",58,0) .F S N=$O(^TMP(BIREPT,$J,N)) Q:'N D "RTN","BIREPCSV",59,0) ..S BITEXT=^TMP(BIREPT,$J,N,0) "RTN","BIREPCSV",60,0) ..W BITEXT,! "RTN","BIREPCSV",61,0) .D ^%ZISC "RTN","BIREPCSV",62,0) .X ^%ZIS("C") "RTN","BIREPCSV",63,0) .D HOME^%ZIS "RTN","BIREPCSV",64,0) .I '$D(ZTQUEUED) W !!,"Your file "_BIDELF_" has been created.",! "RTN","BIREPCSV",65,0) I '$D(ZTQUEUED) D PAUSE,EXIT,RESET(BIREPTS) "RTN","BIREPCSV",66,0) Q "RTN","BIREPCSV",67,0) ; "RTN","BIREPCSV",68,0) GETDEDIR() ;EP - get default directory "RTN","BIREPCSV",69,0) NEW D "RTN","BIREPCSV",70,0) S D="" "RTN","BIREPCSV",71,0) S D=$P($G(^AUTTSITE(1,1)),"^",2) "RTN","BIREPCSV",72,0) I D]"" Q D "RTN","BIREPCSV",73,0) S D=$P($G(^XTV(8989.3,1,"DEV")),"^",1) "RTN","BIREPCSV",74,0) I D]"" Q D "RTN","BIREPCSV",75,0) I $P(^AUTTSITE(1,0),U,21)=1 S D="/usr/spool/uucppublic/" "RTN","BIREPCSV",76,0) Q D "RTN","BIREPCSV",77,0) PAUSE ; "RTN","BIREPCSV",78,0) Q:$D(ZTQUEUED) "RTN","BIREPCSV",79,0) K DIR "RTN","BIREPCSV",80,0) S DIR(0)="E",DIR("A")="Press Enter to continue" D ^DIR KILL DIR "RTN","BIREPCSV",81,0) Q "RTN","BIREPCSV",82,0) ; "RTN","BIREPCSV",83,0) EXIT ;EP "RTN","BIREPCSV",84,0) ;---> Cleanup, EOJ. "RTN","BIREPCSV",85,0) K ^TMP(BIREPT,$J) "RTN","BIREPCSV",86,0) D CLEAR^VALM1 "RTN","BIREPCSV",87,0) D FULL^VALM1 "RTN","BIREPCSV",88,0) Q "RTN","BIREPCSV",89,0) ; "RTN","BIREPCSV",90,0) ; "RTN","BIREPCSV",91,0) HDR(PROG) ;EP "RTN","BIREPCSV",92,0) ;---> Header code "RTN","BIREPCSV",93,0) I PROG="TWO" D HEAD^BIREPT2(BIQDT,BITAR,BIAGRPS,.BICC,.BIHCF,.BICM,.BIBEN,BIUP) "RTN","BIREPCSV",94,0) Q "RTN","BIREPCSV",95,0) ; "RTN","BIREPCSV",96,0) RESET(PROG) ; "RTN","BIREPCSV",97,0) I PROG="TWO" D RESET^BIREPT Q "RTN","BIREPCSV",98,0) I PROG="FLU" D RESET^BIREPF Q "RTN","BIREPCSV",99,0) I PROG="QTR" D RESET^BIREPQ Q "RTN","BIREPCSV",100,0) I PROG="ADO" D RESET^BIREPD Q "RTN","BIREPCSV",101,0) I PROG="ADL" D RESET^BIREPL Q "RTN","BIREPCSV",102,0) Q "RTN","BIREPCSV",103,0) START(PROG) ; "RTN","BIREPCSV",104,0) I PROG="TWO" D START^BIREPT2(BIQDT,BITAR,BIAGRPS,.BICC,.BIHCF,.BICM,.BIBEN,BISITE,BIUP),HEAD^BIREPT2(BIQDT,BITAR,BIAGRPS,.BICC,.BIHCF,.BICM,.BIBEN,BIUP) "RTN","BIREPCSV",105,0) I PROG="FLU" D HEAD^BIREPF2(BIYEAR,.BICC,.BIHCF,.BICM,.BIBEN,BIFH,BIUP),START^BIREPF2(BIYEAR,.BICC,.BIHCF,.BICM,.BIBEN,BIFH,BIUP) "RTN","BIREPCSV",106,0) I PROG="QTR" D HDR^BIREPQ1,START^BIREPQ2(BIQDT,.BICC,.BIHCF,.BICM,.BIBEN,BIHPV,BIUP) "RTN","BIREPCSV",107,0) I PROG="ADO" D START^BIREPD2(BIQDT,BIDAR,BIAGRPS,.BICC,.BIHCF,.BICM,.BIBEN,BISITE,BIUP,.BITOTPTS,.BITOTFPT,.BITOTMPT),HEAD^BIREPD2(BIQDT,BIDAR,BIAGRPS,.BICC,.BIHCF,.BICM,.BIBEN,BIUP) "RTN","BIREPCSV",108,0) I PROG="ADL" D HEAD^BIREPL2(BIQDT,.BICC,.BIHCF,.BIBEN,BICPTI,BIUP),START^BIREPL2(BIQDT,.BICC,.BIHCF,.BIBEN,BICPTI,BIUP) "RTN","BIREPCSV",109,0) Q "RTN","BIREPD1") 0^2^B27182525 "RTN","BIREPD1",1,0) BIREPD1 ;IHS/CMI/MWR - REPORT, ADOLESCENT RATES; MAY 10, 2010 "RTN","BIREPD1",2,0) ;;8.5;IMMUNIZATION;**5,31**;OCT 24,2011;Build 137 "RTN","BIREPD1",3,0) ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS * "RTN","BIREPD1",4,0) ;; VIEW OR PRINT ADOLESCENT IMMUNIZATION RATES REPORT. "RTN","BIREPD1",5,0) ;; PATCH 5: Return Patient Totals for queued reports. PRINT+12, INIT+6, DEQUEUE+5 "RTN","BIREPD1",6,0) ; "RTN","BIREPD1",7,0) ; "RTN","BIREPD1",8,0) ;---------- "RTN","BIREPD1",9,0) START(BIX) ;EP "RTN","BIREPD1",10,0) ;---> Prepare and display or print Adolescent Rates Report. "RTN","BIREPD1",11,0) ;---> Parameters: "RTN","BIREPD1",12,0) ; 1 - BIX (req) If BIX="PRINT", then print Report. "RTN","BIREPD1",13,0) ; If BIX="VIEW", then view Report (default). "RTN","BIREPD1",14,0) ;---> Variables: "RTN","BIREPD1",15,0) ; 1 - BIQDT (req) Quarter Ending Date. "RTN","BIREPD1",16,0) ; 2 - BIDAR (opt) Adolescent Report Age Range: 11-17. "RTN","BIREPD1",17,0) ; 3 - BICC (req) Current Community array. "RTN","BIREPD1",18,0) ; 4 - BIHCF (req) Health Care Facility array. "RTN","BIREPD1",19,0) ; 5 - BICM (req) Case Manager array. "RTN","BIREPD1",20,0) ; 6 - BIBEN (req) Beneficiary Type array. "RTN","BIREPD1",21,0) ; 7 - BIUP (req) User Population/Group "RTN","BIREPD1",22,0) ; (Registered, Imm Reg Active, User 1+, Active 2+). "RTN","BIREPD1",23,0) ; 8 - BIPOP (ret) BIPOP=1 if error. "RTN","BIREPD1",24,0) ; "RTN","BIREPD1",25,0) ;---> Check for required Variables. "RTN","BIREPD1",26,0) I '$G(BIQDT) D ERRCD^BIUTL2(622,,1) D RESET^BIREPD Q "RTN","BIREPD1",27,0) I '$D(BICC) D ERRCD^BIUTL2(614,,1) D RESET^BIREPD Q "RTN","BIREPD1",28,0) I '$D(BIHCF) D ERRCD^BIUTL2(625,,1) D RESET^BIREPD Q "RTN","BIREPD1",29,0) I '$D(BICM) D ERRCD^BIUTL2(615,,1) D RESET^BIREPD Q "RTN","BIREPD1",30,0) I '$D(BIBEN) D ERRCD^BIUTL2(662,,1) D RESET^BIREPD Q "RTN","BIREPD1",31,0) I '$G(BISITE) S BISITE=$G(DUZ(2)) "RTN","BIREPD1",32,0) I '$G(BISITE) D ERRCD^BIUTL2(109,,1) D RESET^BIREPD Q "RTN","BIREPD1",33,0) ; "RTN","BIREPD1",34,0) S:$G(BIUP)="" BIUP="u" "RTN","BIREPD1",35,0) S:'$G(BIDAR) BIDAR="11-17^1" "RTN","BIREPD1",36,0) S BIAGRPS="1112,1313,1317" "RTN","BIREPD1",37,0) ; "RTN","BIREPD1",38,0) ;---> BITOTPTS=Total Patients, used by HDR code after EN. "RTN","BIREPD1",39,0) N BITOTPTS,BITOTFPT,BITOTMPT "RTN","BIREPD1",40,0) ; "RTN","BIREPD1",41,0) D SETVARS^BIUTL5 N VALMCNT "RTN","BIREPD1",42,0) ;IHS/CMI/LAB patch 31 added csv output "RTN","BIREPD1",43,0) S BISPD=BIX "RTN","BIREPD1",44,0) I $G(BIX)="PRINT" D PRINT,RESET^BIREPD Q "RTN","BIREPD1",45,0) I $G(BIX)="CSV" D DELIM^BIREPCSV("BIREPD1","ADOLESCENT IMMUNIZATION RATES REPORT","ADO"),RESET^BIREPD Q ;IHS/LAB patch 31 delimited output "RTN","BIREPD1",46,0) ; "RTN","BIREPD1",47,0) ; "RTN","BIREPD1",48,0) ;---> Set BIAG for Age Range in header of report. "RTN","BIREPD1",49,0) ;---> Set BIRPDT for Report Date ("Quarterly, etc.). "RTN","BIREPD1",50,0) ;---> Set BIRTN in case user runs Patient List then needs to return "RTN","BIREPD1",51,0) ;---> to INIT here. "RTN","BIREPD1",52,0) ;---> Set BITITL for Report Name in Patient List, if called. "RTN","BIREPD1",53,0) N BIRPDT,BIRTN,BITITL "RTN","BIREPD1",54,0) S BIRPDT=BIQDT,BIRTN="BIREPD1",BITITL="ADOLESCENT" "RTN","BIREPD1",55,0) D EN "RTN","BIREPD1",56,0) Q "RTN","BIREPD1",57,0) ; "RTN","BIREPD1",58,0) ; "RTN","BIREPD1",59,0) ;---------- "RTN","BIREPD1",60,0) PRINT ;EP "RTN","BIREPD1",61,0) ;---> Main entry point for printing the Adolescent Rates Report. "RTN","BIREPD1",62,0) D DEVICE(.BIPOP) "RTN","BIREPD1",63,0) Q:$G(BIPOP) "RTN","BIREPD1",64,0) ; "RTN","BIREPD1",65,0) D:$G(IO)'=$G(IO(0)) "RTN","BIREPD1",66,0) .W !!?10,"This may take some time. Please hold on...",! "RTN","BIREPD1",67,0) ; "RTN","BIREPD1",68,0) ;---> Prepare report. "RTN","BIREPD1",69,0) K ^TMP("BIREPD1",$J),^TMP("BIDUL",$J) "RTN","BIREPD1",70,0) N VALM,VALMHDR "RTN","BIREPD1",71,0) ; "RTN","BIREPD1",72,0) ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR "RTN","BIREPD1",73,0) ;---> Return Patient Totals for queued reports. "RTN","BIREPD1",74,0) ;D START^BIREPD2(BIQDT,BIDAR,BIAGRPS,.BICC,.BIHCF,.BICM,.BIBEN,BISITE,BIUP),HDR "RTN","BIREPD1",75,0) D START^BIREPD2(BIQDT,BIDAR,BIAGRPS,.BICC,.BIHCF,.BICM,.BIBEN,BISITE,BIUP,.BITOTPTS,.BITOTFPT,.BITOTMPT) "RTN","BIREPD1",76,0) D HDR "RTN","BIREPD1",77,0) ;********** "RTN","BIREPD1",78,0) ; "RTN","BIREPD1",79,0) D PRTLST^BIUTL8("BIREPD1") "RTN","BIREPD1",80,0) D EXIT,RESET^BIREPD "RTN","BIREPD1",81,0) Q "RTN","BIREPD1",82,0) ; "RTN","BIREPD1",83,0) ; "RTN","BIREPD1",84,0) ;---------- "RTN","BIREPD1",85,0) EN ;EP "RTN","BIREPD1",86,0) ;---> Main entry point for List Template BI REPORT ADOLESCENT RATES1. "RTN","BIREPD1",87,0) D EN^VALM("BI REPORT ADOLESCENT RATES1") "RTN","BIREPD1",88,0) Q "RTN","BIREPD1",89,0) ; "RTN","BIREPD1",90,0) ; "RTN","BIREPD1",91,0) ;---------- "RTN","BIREPD1",92,0) HDR ;EP "RTN","BIREPD1",93,0) ;---> Header code "RTN","BIREPD1",94,0) D HEAD^BIREPD2(BIQDT,BIDAR,BIAGRPS,.BICC,.BIHCF,.BICM,.BIBEN,BIUP) "RTN","BIREPD1",95,0) Q "RTN","BIREPD1",96,0) ; "RTN","BIREPD1",97,0) ; "RTN","BIREPD1",98,0) ;---------- "RTN","BIREPD1",99,0) INIT ;EP "RTN","BIREPD1",100,0) ;---> Initialize variables and list array. "RTN","BIREPD1",101,0) S VALM("TITLE")=$$LMVER^BILOGO "RTN","BIREPD1",102,0) W !!?10,"This may take some time. Please hold on...",! "RTN","BIREPD1",103,0) K ^TMP("BIREPD1",$J),^TMP("BIDUL",$J) "RTN","BIREPD1",104,0) ; "RTN","BIREPD1",105,0) ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR "RTN","BIREPD1",106,0) ;---> Return Patient Totals for queued reports. "RTN","BIREPD1",107,0) ;D START^BIREPD2(BIQDT,BIDAR,BIAGRPS,.BICC,.BIHCF,.BICM,.BIBEN,BISITE,BIUP) "RTN","BIREPD1",108,0) D START^BIREPD2(BIQDT,BIDAR,BIAGRPS,.BICC,.BIHCF,.BICM,.BIBEN,BISITE,BIUP,.BITOTPTS,.BITOTFPT,.BITOTMPT) "RTN","BIREPD1",109,0) ;********** "RTN","BIREPD1",110,0) ; "RTN","BIREPD1",111,0) ;---> Set up ZTSAVE in case user Queues from PL in List. "RTN","BIREPD1",112,0) D ZSAVES^BIUTL3 "RTN","BIREPD1",113,0) Q "RTN","BIREPD1",114,0) ; "RTN","BIREPD1",115,0) ; "RTN","BIREPD1",116,0) ;---------- "RTN","BIREPD1",117,0) RESET ;EP "RTN","BIREPD1",118,0) ;---> Update partition for return to Listmanager. "RTN","BIREPD1",119,0) I $D(VALMQUIT) S VALMBCK="Q" Q "RTN","BIREPD1",120,0) D TERM^VALM0 S VALMBCK="R" "RTN","BIREPD1",121,0) D INIT,HDR Q "RTN","BIREPD1",122,0) ; "RTN","BIREPD1",123,0) ; "RTN","BIREPD1",124,0) ;---------- "RTN","BIREPD1",125,0) HELP ;EP "RTN","BIREPD1",126,0) N BIX S BIX=X "RTN","BIREPD1",127,0) D FULL^VALM1 N BIPOP "RTN","BIREPD1",128,0) D TITLE^BIUTL5("VIEW ADOLESCENT REPORT - HELP") "RTN","BIREPD1",129,0) D TEXT1,DIRZ^BIUTL3() "RTN","BIREPD1",130,0) D:BIX'="??" RE^VALM4 "RTN","BIREPD1",131,0) Q "RTN","BIREPD1",132,0) ; "RTN","BIREPD1",133,0) ; "RTN","BIREPD1",134,0) ;---------- "RTN","BIREPD1",135,0) TEXT1 ;EP "RTN","BIREPD1",136,0) ;;You have chosen to View the Adolescent Report rather than Print it. "RTN","BIREPD1",137,0) ;;(You may print the report from here as well by entering "PL".) "RTN","BIREPD1",138,0) ;; "RTN","BIREPD1",139,0) ;;Also, you may: "RTN","BIREPD1",140,0) ;; "RTN","BIREPD1",141,0) ;;Enter "N" to view the list of Patients who were NOT Current "RTN","BIREPD1",142,0) ;; or "NOT up-to-date" with their immunizations, according "RTN","BIREPD1",143,0) ;; to recommendeded guidelines for their age. "RTN","BIREPD1",144,0) ;; "RTN","BIREPD1",145,0) ;;Enter "C" to view the list of Patients who were CURRENT or "RTN","BIREPD1",146,0) ;; "up-to-date" with their immunizations, according to "RTN","BIREPD1",147,0) ;; recommendeded guidelines for their age. "RTN","BIREPD1",148,0) ;; "RTN","BIREPD1",149,0) ;;Enter "B" to view a list of both groups of patients combined. "RTN","BIREPD1",150,0) ;; "RTN","BIREPD1",151,0) ;; "RTN","BIREPD1",152,0) D PRINTX("TEXT1") "RTN","BIREPD1",153,0) Q "RTN","BIREPD1",154,0) ; "RTN","BIREPD1",155,0) ; "RTN","BIREPD1",156,0) ;---------- "RTN","BIREPD1",157,0) EXIT ;EP "RTN","BIREPD1",158,0) ;---> Cleanup, EOJ. "RTN","BIREPD1",159,0) K ^TMP("BIREPD1",$J) "RTN","BIREPD1",160,0) D CLEAR^VALM1 "RTN","BIREPD1",161,0) D FULL^VALM1 "RTN","BIREPD1",162,0) Q "RTN","BIREPD1",163,0) ; "RTN","BIREPD1",164,0) ; "RTN","BIREPD1",165,0) ;---------- "RTN","BIREPD1",166,0) DEVICE(BIPOP) ;EP "RTN","BIREPD1",167,0) ;---> Get Device and possibly queue to Taskman. "RTN","BIREPD1",168,0) ;---> Parameters: "RTN","BIREPD1",169,0) ; 1 - BIPOP (ret) If error or Queue, BIPOP=1 "RTN","BIREPD1",170,0) ; "RTN","BIREPD1",171,0) K %ZIS,IOP S BIPOP=0 "RTN","BIREPD1",172,0) S ZTRTN="DEQUEUE^BIREPD1" "RTN","BIREPD1",173,0) D ZSAVES^BIUTL3 "RTN","BIREPD1",174,0) D ZIS^BIUTL2(.BIPOP,1) "RTN","BIREPD1",175,0) Q "RTN","BIREPD1",176,0) ; "RTN","BIREPD1",177,0) ; "RTN","BIREPD1",178,0) ;---------- "RTN","BIREPD1",179,0) DEQUEUE ;EP "RTN","BIREPD1",180,0) ; "RTN","BIREPD1",181,0) ;---> Prepare and print Two-Year-Old Report. "RTN","BIREPD1",182,0) K VALMHDR,^TMP("BIREPD1",$J) "RTN","BIREPD1",183,0) ; "RTN","BIREPD1",184,0) ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR "RTN","BIREPD1",185,0) ;---> Return Patient Totals for queued reports and headings. "RTN","BIREPD1",186,0) ;D HDR^BIREPD1 "RTN","BIREPD1",187,0) ;D START^BIREPD2(BIQDT,BIDAR,BIAGRPS,.BICC,.BIHCF,.BICM,.BIBEN,BISITE,BIUP) "RTN","BIREPD1",188,0) D START^BIREPD2(BIQDT,BIDAR,BIAGRPS,.BICC,.BIHCF,.BICM,.BIBEN,BISITE,BIUP,.BITOTPTS,.BITOTFPT,.BITOTMPT) "RTN","BIREPD1",189,0) D HDR^BIREPD1 "RTN","BIREPD1",190,0) ;********** "RTN","BIREPD1",191,0) ; "RTN","BIREPD1",192,0) D PRTLST^BIUTL8("BIREPD1"),EXIT "RTN","BIREPD1",193,0) Q "RTN","BIREPD1",194,0) ; "RTN","BIREPD1",195,0) ; "RTN","BIREPD1",196,0) ;---------- "RTN","BIREPD1",197,0) PRINTX(BILINL,BITAB) ;EP "RTN","BIREPD1",198,0) Q:$G(BILINL)="" "RTN","BIREPD1",199,0) N I,T,X S T="" S:'$D(BITAB) BITAB=5 F I=1:1:BITAB S T=T_" " "RTN","BIREPD1",200,0) F I=1:1 S X=$T(@BILINL+I) Q:X'[";;" W !,T,$P(X,";;",2) "RTN","BIREPD1",201,0) Q "RTN","BIREPD2") 0^3^B114912591 "RTN","BIREPD2",1,0) BIREPD2 ;IHS/CMI/MWR - REPORT, ADOLESCENT RATES; DEC 15, 2011 "RTN","BIREPD2",2,0) ;;8.5;IMMUNIZATION;**17,31**;OCT 24,2011;Build 137 "RTN","BIREPD2",3,0) ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS * "RTN","BIREPD2",4,0) ;; VIEW ADOLESCENT IMMUNIZATION RATES REPORT, GATHER DATA. "RTN","BIREPD2",5,0) ; PATCH 1: Clarify Report explanation. START+121 "RTN","BIREPD2",6,0) ;; PATCH 3: Include new "1-Td 1-Men 3-HPV" lines. START+69 "RTN","BIREPD2",7,0) ;; PATCH 5: Return Patient Totals for queued reports. START+0 "RTN","BIREPD2",8,0) ;; PATCH 17: Extensive changes to enhance Adol HPV & Tdap Reporting. START+60 "RTN","BIREPD2",9,0) ; "RTN","BIREPD2",10,0) ; "RTN","BIREPD2",11,0) ;---------- "RTN","BIREPD2",12,0) HEAD(BIQDT,BIDAR,BIAGRPS,BICC,BIHCF,BICM,BIBEN,BIUP) ;EP - Header for Adolescent Report. "RTN","BIREPD2",13,0) ;---> Produce Header array for Adolescent Report. "RTN","BIREPD2",14,0) ;---> Parameters: "RTN","BIREPD2",15,0) ; 1 - BIQDT (req) Quarter Ending Date. "RTN","BIREPD2",16,0) ; 2 - BIDAR (req) Adolescent Report Age Range: "11-18^1" (years). "RTN","BIREPD2",17,0) ; 3 - BIAGRPS (req) String of Age Groups ("1112,1313,1317"). "RTN","BIREPD2",18,0) ; 4 - BICC (req) Current Community array. "RTN","BIREPD2",19,0) ; 5 - BIHCF (req) Health Care Facility array. "RTN","BIREPD2",20,0) ; 6 - BICM (req) Case Manager array. "RTN","BIREPD2",21,0) ; 7 - BIBEN (req) Beneficiary Type array. "RTN","BIREPD2",22,0) ; 8 - BIUP (req) User Population/Group (Registered, Imm, User, Active). "RTN","BIREPD2",23,0) ; "RTN","BIREPD2",24,0) ;---> Check for required Variables. "RTN","BIREPD2",25,0) Q:'$G(BIQDT) "RTN","BIREPD2",26,0) Q:'$D(BICC) "RTN","BIREPD2",27,0) Q:'$D(BIHCF) "RTN","BIREPD2",28,0) Q:'$D(BICM) "RTN","BIREPD2",29,0) Q:'$D(BIBEN) "RTN","BIREPD2",30,0) Q:'$D(BIDAR) "RTN","BIREPD2",31,0) Q:'$G(BIAGRPS) "RTN","BIREPD2",32,0) Q:'$D(BIUP) "RTN","BIREPD2",33,0) ; "RTN","BIREPD2",34,0) K VALMHDR "RTN","BIREPD2",35,0) N BILINE,X,Y S BILINE=0 "RTN","BIREPD2",36,0) ; "RTN","BIREPD2",37,0) S X="" "RTN","BIREPD2",38,0) ;---> If Header array is NOT being for Listmananger include version. "RTN","BIREPD2",39,0) S:'$D(VALM("BM")) X=$$LMVER^BILOGO() "RTN","BIREPD2",40,0) ; "RTN","BIREPD2",41,0) I BISPD'="CSV" D WH^BIW(.BILINE,X) "RTN","BIREPD2",42,0) S X=$$REPHDR^BIUTL6(DUZ(2)) I BISPD'="CSV" D CENTERT^BIUTL5(.X) "RTN","BIREPD2",43,0) D WH^BIW(.BILINE,X) "RTN","BIREPD2",44,0) ; "RTN","BIREPD2",45,0) S X="* Adolescent Immunization Report (11-17 yrs) *" I BISPD'="CSV" D CENTERT^BIUTL5(.X) "RTN","BIREPD2",46,0) D WH^BIW(.BILINE,X) "RTN","BIREPD2",47,0) ; "RTN","BIREPD2",48,0) S:BISPD'="CSV" X=$$SP^BIUTL5(27)_"Report Date: "_$$SLDT1^BIUTL5(DT) S:BISPD="CSV" X="Report Date: "_$$SLDT1^BIUTL5(DT) "RTN","BIREPD2",49,0) D WH^BIW(.BILINE,X,$S(BISPD="CSV":"",1:1)) "RTN","BIREPD2",50,0) ; "RTN","BIREPD2",51,0) S:BISPD'="CSV" X=$$SP^BIUTL5(30)_"End Date: "_$$SLDT1^BIUTL5(BIQDT) S:BISPD="CSV" X="End Date: "_$$SLDT1^BIUTL5(BIQDT) "RTN","BIREPD2",52,0) D WH^BIW(.BILINE,X,$S(BISPD="CSV":"",1:1)) "RTN","BIREPD2",53,0) ; "RTN","BIREPD2",54,0) S X=" "_$$BIUPTX^BIUTL6(BIUP) "RTN","BIREPD2",55,0) I BIUP="i" S X=" "_$$BIUPTX^BIUTL6(BIUP,1)_" (Active)" "RTN","BIREPD2",56,0) I BISPD'="CSV" S X=$$PAD^BIUTL5(X,34) "RTN","BIREPD2",57,0) ; "RTN","BIREPD2",58,0) I BISPD'="CSV" D "RTN","BIREPD2",59,0) .S Y="Total Patients: "_$G(BITOTPTS)_" (F:"_$G(BITOTFPT)_" M:"_$G(BITOTMPT)_")" "RTN","BIREPD2",60,0) .S X=X_$J(Y,45) "RTN","BIREPD2",61,0) I BISPD="CSV" D "RTN","BIREPD2",62,0) .D WH^BIW(.BILINE,X) "RTN","BIREPD2",63,0) .S X="Total Patients: "_$G(BITOTPTS) D WH^BIW(.BILINE,X) "RTN","BIREPD2",64,0) .S X="Females: "_$G(BITOTFPT) D WH^BIW(.BILINE,X) "RTN","BIREPD2",65,0) .S X="Males: "_$G(BITOTMPT) "RTN","BIREPD2",66,0) D WH^BIW(.BILINE,X) "RTN","BIREPD2",67,0) I BISPD'="CSV" S X=$$SP^BIUTL5(79,"-") D WH^BIW(.BILINE,X) "RTN","BIREPD2",68,0) ; "RTN","BIREPD2",69,0) D "RTN","BIREPD2",70,0) .;---> If specific Communities were selected (not ALL), then print "RTN","BIREPD2",71,0) .;---> the Communities in a subheader at the top of the report. "RTN","BIREPD2",72,0) .D SUBH^BIOUTPT5("BICC","Community",,"^AUTTCOM(",.BILINE,.BIERR,,12) "RTN","BIREPD2",73,0) .I $G(BIERR) D ERRCD^BIUTL2(BIERR,.X) D WH^BIW(.BILINE,X) Q "RTN","BIREPD2",74,0) .; "RTN","BIREPD2",75,0) .;---> If specific Health Care Facilities, print subheader. "RTN","BIREPD2",76,0) .D SUBH^BIOUTPT5("BIHCF","Facility",,"^DIC(4,",.BILINE,.BIERR,,12) "RTN","BIREPD2",77,0) .I $G(BIERR) D ERRCD^BIUTL2(BIERR,.X) D WH^BIW(.BILINE,X) Q "RTN","BIREPD2",78,0) .; "RTN","BIREPD2",79,0) .;---> If specific Case Managers, print Case Manager subheader. "RTN","BIREPD2",80,0) .D SUBH^BIOUTPT5("BICM","Case Manager",,"^VA(200,",.BILINE,.BIERR,,12) "RTN","BIREPD2",81,0) .I $G(BIERR) D ERRCD^BIUTL2(BIERR,.X) D WH^BIW(.BILINE,X) Q "RTN","BIREPD2",82,0) .; "RTN","BIREPD2",83,0) .;---> If specific Beneficiary Types, print Beneficiary Type subheader. "RTN","BIREPD2",84,0) .D SUBH^BIOUTPT5("BIBEN","Beneficiary Type",,"^AUTTBEN(",.BILINE,.BIERR,,12) "RTN","BIREPD2",85,0) .I $G(BIERR) D ERRCD^BIUTL2(BIERR,.X) D WH^BIW(.BILINE,X) Q "RTN","BIREPD2",86,0) .;;---> Write Denominators subhead. "RTN","BIREPD2",87,0) .N I F I=1,3 D WH^BIW(.BILINE,$$HEAD2(I)) "RTN","BIREPD2",88,0) ; "RTN","BIREPD2",89,0) ;---> If Header array is being built for Listmananger, "RTN","BIREPD2",90,0) ;---> reset display window margins for Communities, etc. "RTN","BIREPD2",91,0) D:$D(VALM("BM")) "RTN","BIREPD2",92,0) .S VALM("TM")=BILINE+3 "RTN","BIREPD2",93,0) .S VALM("LINES")=VALM("BM")-VALM("TM")+1 "RTN","BIREPD2",94,0) .;---> Safeguard to prevent divide/0 error. "RTN","BIREPD2",95,0) .S:VALM("LINES")<1 VALM("LINES")=1 "RTN","BIREPD2",96,0) Q "RTN","BIREPD2",97,0) ; "RTN","BIREPD2",98,0) ; "RTN","BIREPD2",99,0) HEAD2(L) ;EP "RTN","BIREPD2",100,0) ;---> Set text and totals for Age Group Denominators subheader. "RTN","BIREPD2",101,0) ;---> Parameters: "RTN","BIREPD2",102,0) ; 1 - L (req) Line number below to return. "RTN","BIREPD2",103,0) I BISPD="CSV" G HEAD2CSV "RTN","BIREPD2",104,0) Q:(L=1) " Age Group | 11-12yrs 13yrs 13-17yrs" "RTN","BIREPD2",105,0) Q:(L=2) " Female + Male | 11-12yrs 13yrs 13-17yrs" "RTN","BIREPD2",106,0) Q:(L'=3) "MISSING HEADER." "RTN","BIREPD2",107,0) N X S X=" Denominators | "_$J($G(BITOTPTS(1112)),7)_" " "RTN","BIREPD2",108,0) S X=X_$J($G(BITOTPTS(1313)),7)_" "_$J($G(BITOTPTS(1317)),7) "RTN","BIREPD2",109,0) Q X "RTN","BIREPD2",110,0) ; "RTN","BIREPD2",111,0) HEAD2CSV ; "RTN","BIREPD2",112,0) Q:(L=1) ",11-12yrs,13yrs,13-17yrs" "RTN","BIREPD2",113,0) Q:(L=2) "Female + Male Denominators,11-12yrs,13yrs,13-17yrs" "RTN","BIREPD2",114,0) Q:(L'=3) "MISSING HEADER." "RTN","BIREPD2",115,0) N X S X="Age Group Denominators,"_+$G(BITOTPTS(1112))_","_+$G(BITOTPTS(1313))_","_+$G(BITOTPTS(1317)) "RTN","BIREPD2",116,0) Q X "RTN","BIREPD2",117,0) ;---------- "RTN","BIREPD2",118,0) START(BIQDT,BIDAR,BIAGRPS,BICC,BIHCF,BICM,BIBEN,BISITE,BIUP,BITOTPTS,BITOTFPT,BITOTMPT) ;EP "RTN","BIREPD2",119,0) ;---> Produce array for Report. "RTN","BIREPD2",120,0) ;---> Parameters: "RTN","BIREPD2",121,0) ; 1 - BIQDT (req) Quarter Ending Date. "RTN","BIREPD2",122,0) ; 2 - BIDAR (opt) Adolescent Report Age Range: "11-18^1" (years). "RTN","BIREPD2",123,0) ; 3 - BIAGRPS (req) String of Age Groups ("1112,1313,1317"). "RTN","BIREPD2",124,0) ; 4 - BICC (req) Current Community array. "RTN","BIREPD2",125,0) ; 5 - BIHCF (req) Health Care Facility array. "RTN","BIREPD2",126,0) ; 6 - BICM (req) Case Manager array. "RTN","BIREPD2",127,0) ; 7 - BIBEN (req) Beneficiary Type array. "RTN","BIREPD2",128,0) ; 8 - BISITE (req) Site IEN. "RTN","BIREPD2",129,0) ; 9 - BIUP (req) User Population/Group (All, Imm, User, Active). "RTN","BIREPD2",130,0) ; 10 - BITOTPTS (ret) Total Patients. "RTN","BIREPD2",131,0) ; 11 - BITOTFPT (ret) Total Female Patients. "RTN","BIREPD2",132,0) ; 12 - BITOTMPT (ret) Total Male Patients. "RTN","BIREPD2",133,0) ; "RTN","BIREPD2",134,0) K ^TMP("BIREPD1",$J) "RTN","BIREPD2",135,0) N BILINE,BITMP,X S BILINE=0 "RTN","BIREPD2",136,0) ; "RTN","BIREPD2",137,0) ;---> Check for required Variables. "RTN","BIREPD2",138,0) I '$G(BIQDT) D ERRCD^BIUTL2(623,.X) D WRITE^BIREPD3(.BILINE,X) Q "RTN","BIREPD2",139,0) I '$D(BIDAR) D ERRCD^BIUTL2(613,.X) D WRITE^BIREPD3(.BILINE,X) Q "RTN","BIREPD2",140,0) I '$G(BIAGRPS) D ERRCD^BIUTL2(677,.X) D WRITE^BIREPD3(.BILINE,X) Q "RTN","BIREPD2",141,0) I '$D(BICC) D ERRCD^BIUTL2(614,.X) D WRITE^BIREPD3(.BILINE,X) Q "RTN","BIREPD2",142,0) I '$D(BIHCF) D ERRCD^BIUTL2(625,.X) D WRITE^BIREPD3(.BILINE,X) Q "RTN","BIREPD2",143,0) I '$D(BICM) D ERRCD^BIUTL2(615,.X) D WRITE^BIREPD3(.BILINE,X) Q "RTN","BIREPD2",144,0) I '$D(BIBEN) D ERRCD^BIUTL2(662,.X) D WRITE^BIREPD3(.BILINE,X) Q "RTN","BIREPD2",145,0) I '$G(BISITE) S BISITE=$G(DUZ(2)) "RTN","BIREPD2",146,0) I '$G(BISITE) D ERRCD^BIUTL2(109,.X) D WRITE^BIREPD3(.BILINE,X) Q "RTN","BIREPD2",147,0) S:$G(BIUP)="" BIUP="u" "RTN","BIREPD2",148,0) ; "RTN","BIREPD2",149,0) ;---> Gather data. "RTN","BIREPD2",150,0) D GETDATA^BIREPD3(.BICC,.BIHCF,.BICM,.BIBEN,BIQDT,BIDAR,BIAGRPS,BISITE,BIUP,.BITMP,.BIERR) "RTN","BIREPD2",151,0) I $G(BIERR)]"" D WRITE^BIREPD3(.BILINE,BIERR) Q "RTN","BIREPD2",152,0) ; "RTN","BIREPD2",153,0) ; "RTN","BIREPD2",154,0) ;---> BITOTPTS variables (total patients) not newed here because they are "RTN","BIREPD2",155,0) ;---> also used in the Report Header. "RTN","BIREPD2",156,0) ;---> Total. "RTN","BIREPD2",157,0) S BITOTPTS=+$G(BITMP("STATS","TOTLPTS")) "RTN","BIREPD2",158,0) S BITOTPTS(1112)=+$G(BITMP("STATS","TOTLPTS",1112)) "RTN","BIREPD2",159,0) S BITOTPTS(1313)=+$G(BITMP("STATS","TOTLPTS",1313)) "RTN","BIREPD2",160,0) S BITOTPTS(1317)=+$G(BITMP("STATS","TOTLPTS",1317)) "RTN","BIREPD2",161,0) ;---> Females. "RTN","BIREPD2",162,0) S BITOTFPT=+$G(BITMP("STATS","TOTLFPTS")) "RTN","BIREPD2",163,0) S BITOTFPT(1112)=+$G(BITMP("STATS","TOTLFPTS",1112)) "RTN","BIREPD2",164,0) S BITOTFPT(1313)=+$G(BITMP("STATS","TOTLFPTS",1313)) "RTN","BIREPD2",165,0) S BITOTFPT(1317)=+$G(BITMP("STATS","TOTLFPTS",1317)) "RTN","BIREPD2",166,0) ;---> Males. "RTN","BIREPD2",167,0) S BITOTMPT=+$G(BITMP("STATS","TOTLMPTS")) "RTN","BIREPD2",168,0) S BITOTMPT(1112)=+$G(BITMP("STATS","TOTLMPTS",1112)) "RTN","BIREPD2",169,0) S BITOTMPT(1313)=+$G(BITMP("STATS","TOTLMPTS",1313)) "RTN","BIREPD2",170,0) S BITOTMPT(1317)=+$G(BITMP("STATS","TOTLMPTS",1317)) "RTN","BIREPD2",171,0) ; "RTN","BIREPD2",172,0) ; "RTN","BIREPD2",173,0) ;---> VACCINE GROUPS "RTN","BIREPD2",174,0) ;---> Write Statistics lines for each Vaccine Group (BIVGRP). "RTN","BIREPD2",175,0) ;---> NOTE: 132 is specific for Var-Hx of Chickenpox. "RTN","BIREPD2",176,0) ;---> 221 is for the specific vaccine Tdap. "RTN","BIREPD2",177,0) ; "RTN","BIREPD2",178,0) ;********** PATCH 17, v8.5, MAR 01,2019, IHS/CMI/MWR "RTN","BIREPD2",179,0) ;---> Don't write special Tdap line; all Td's filtered for Tdap only. "RTN","BIREPD2",180,0) ;F BIVGRP=4,6,7,132,221,8,9,16,10 D VGRP^BIREPD3(.BILINE,BIVGRP,BIAGRPS,.BITMP,,.BIERR) "RTN","BIREPD2",181,0) F BIVGRP=4,6,7,132,8,9,16,10 D VGRP^BIREPD3(.BILINE,BIVGRP,BIAGRPS,.BITMP,,.BIERR) "RTN","BIREPD2",182,0) I $G(BIERR)]"" D WRITE^BIREPD3(.BILINE,BIERR) Q "RTN","BIREPD2",183,0) ; "RTN","BIREPD2",184,0) ; "RTN","BIREPD2",185,0) ;---> VACCINE COMBINATIONS "RTN","BIREPD2",186,0) ;---> Write Statistics lines for each Vaccine Combinations. "RTN","BIREPD2",187,0) ;---> NOTE: These Combo strings are also used to set BITMP("STATS" "RTN","BIREPD2",188,0) ;---> nodes beginning at +130^BIREPD4. "RTN","BIREPD2",189,0) ; "RTN","BIREPD2",190,0) D VCOMB^BIREPD3(.BILINE,"8|1^4|3^6|2^7|1",BIAGRPS,.BITMP,,.BIERR) "RTN","BIREPD2",191,0) D VCOMB^BIREPD3(.BILINE,"8|1^4|3^6|2^16|1^7|2",BIAGRPS,.BITMP,,.BIERR) "RTN","BIREPD2",192,0) D VCOMB^BIREPD3(.BILINE,"8|1^16|1",BIAGRPS,.BITMP,,.BIERR) "RTN","BIREPD2",193,0) ; "RTN","BIREPD2",194,0) ;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR "RTN","BIREPD2",195,0) ;---> Include new "1-Td 1-Men 3-HPV" line for both sexes. "RTN","BIREPD2",196,0) D VCOMB^BIREPD3(.BILINE,"8|1^16|1^17|3",BIAGRPS,.BITMP,"B",.BIERR) "RTN","BIREPD2",197,0) ;********** "RTN","BIREPD2",198,0) ; "RTN","BIREPD2",199,0) ; "RTN","BIREPD2",200,0) ;********** PATCH 17, v8.5, MAR 01,2019, IHS/CMI/MWR "RTN","BIREPD2",201,0) ;---> Extensive changes below and in BIREPD3 and BIREPD4 in order to write "RTN","BIREPD2",202,0) ;---> Female and Male HPV stats for Fully Vac'd with 2 doses, 3 doses and combined. "RTN","BIREPD2",203,0) ; "RTN","BIREPD2",204,0) ;---> * * * Now HPV stats. * * * "RTN","BIREPD2",205,0) ; "RTN","BIREPD2",206,0) ;---> FEMALES * * * "RTN","BIREPD2",207,0) ;---> Break to write FEMALE Denominators subheader. "RTN","BIREPD2",208,0) D DENOMS(.BILINE,.BITOTFPT,1) "RTN","BIREPD2",209,0) ; "RTN","BIREPD2",210,0) ;---> Write Female Statistics lines for HPV Vaccine Group (BIVGRP=17-HPV). "RTN","BIREPD2",211,0) D VGRP^BIREPD3(.BILINE,17,BIAGRPS,.BITMP,"F",.BIERR) "RTN","BIREPD2",212,0) I $G(BIERR)]"" D WRITE^BIREPD3(.BILINE,BIERR) Q "RTN","BIREPD2",213,0) ; "RTN","BIREPD2",214,0) ;---> Next write Fully Vac'd lines. "RTN","BIREPD2",215,0) D "RTN","BIREPD2",216,0) .N BII F BII="F2","F3","F5" Q:($G(BIERR)]"") D "RTN","BIREPD2",217,0) ..D VGRP^BIREPD3(.BILINE,17,BIAGRPS,.BITMP,BII,.BIERR) "RTN","BIREPD2",218,0) I $G(BIERR)]"" D WRITE^BIREPD3(.BILINE,BIERR) Q "RTN","BIREPD2",219,0) ; "RTN","BIREPD2",220,0) ;---> Now write FEMALE combos. "RTN","BIREPD2",221,0) ; "RTN","BIREPD2",222,0) ;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR "RTN","BIREPD2",223,0) ;---> Add "1-Td 1-Men 3-HPV" combo line for females. "RTN","BIREPD2",224,0) D VCOMB^BIREPD3(.BILINE,"8|1^16|1^17|3",BIAGRPS,.BITMP,"F",.BIERR) "RTN","BIREPD2",225,0) D VCOMB^BIREPD3(.BILINE,"8|1^4|3^6|2^16|1^7|2^17|3",BIAGRPS,.BITMP,"F",.BIERR) "RTN","BIREPD2",226,0) ; "RTN","BIREPD2",227,0) ; "RTN","BIREPD2",228,0) ;---> MALES * * * "RTN","BIREPD2",229,0) ;---> Break to write MALE Denominators subheader. "RTN","BIREPD2",230,0) D DENOMS(.BILINE,.BITOTMPT,0) "RTN","BIREPD2",231,0) ; "RTN","BIREPD2",232,0) ;---> Write Male Statistics lines for HPV Vaccine Group (BIVGRP=17-HPV). "RTN","BIREPD2",233,0) D VGRP^BIREPD3(.BILINE,17,BIAGRPS,.BITMP,"M",.BIERR) "RTN","BIREPD2",234,0) I $G(BIERR)]"" D WRITE^BIREPD3(.BILINE,BIERR) Q "RTN","BIREPD2",235,0) ;---> Next write Fully Vac'd lines. "RTN","BIREPD2",236,0) D "RTN","BIREPD2",237,0) .N BII F BII="M2","M3","M5" Q:($G(BIERR)]"") D "RTN","BIREPD2",238,0) ..D VGRP^BIREPD3(.BILINE,17,BIAGRPS,.BITMP,BII,.BIERR) "RTN","BIREPD2",239,0) I $G(BIERR)]"" D WRITE^BIREPD3(.BILINE,BIERR) Q "RTN","BIREPD2",240,0) ; "RTN","BIREPD2",241,0) ;---> Now write MALE combos. "RTN","BIREPD2",242,0) ; "RTN","BIREPD2",243,0) ;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR "RTN","BIREPD2",244,0) ;---> Add "1-Td 1-Men 3-HPV" combo line for males. "RTN","BIREPD2",245,0) D VCOMB^BIREPD3(.BILINE,"8|1^16|1^17|3",BIAGRPS,.BITMP,"M",.BIERR) "RTN","BIREPD2",246,0) D VCOMB^BIREPD3(.BILINE,"8|1^4|3^6|2^16|1^7|2^17|3",BIAGRPS,.BITMP,"M",.BIERR) "RTN","BIREPD2",247,0) ;******* "RTN","BIREPD2",248,0) ; "RTN","BIREPD2",249,0) ;---> BOTH FEMALES + MALES * * * "RTN","BIREPD2",250,0) ;---> Now write HPV Fully Vac'd Totals for Female + Male combined. "RTN","BIREPD2",251,0) ;---> Rewrite the denominators for both Female + Male. "RTN","BIREPD2",252,0) I BISPD="CSV" S X=" " D WRITE^BIREPD3(.BILINE,X) D WRITE^BIREPD3(.BILINE,X) "RTN","BIREPD2",253,0) N I F I=2,3 D WRITE^BIREPD3(.BILINE,$$HEAD2(I)) "RTN","BIREPD2",254,0) I BISPD'="CSV" D WRITE^BIREPD3(.BILINE," "_$$SP^BIUTL5(63,"-")) "RTN","BIREPD2",255,0) ; "RTN","BIREPD2",256,0) ; "RTN","BIREPD2",257,0) ;---> Write Female + Male Statistics lines for HPV Vaccine Group by dose. "RTN","BIREPD2",258,0) D VGRP^BIREPD3(.BILINE,17,BIAGRPS,.BITMP,"S",.BIERR) "RTN","BIREPD2",259,0) I $G(BIERR)]"" D WRITE^BIREPD3(.BILINE,BIERR) Q "RTN","BIREPD2",260,0) ; "RTN","BIREPD2",261,0) ; "RTN","BIREPD2",262,0) ;---> Next write Fully Vac'd lines for both Females + Males. "RTN","BIREPD2",263,0) D "RTN","BIREPD2",264,0) .N BII F BII="B2","B3","B5" Q:($G(BIERR)]"") D "RTN","BIREPD2",265,0) ..D VGRP^BIREPD3(.BILINE,17,BIAGRPS,.BITMP,BII,.BIERR) "RTN","BIREPD2",266,0) ; "RTN","BIREPD2",267,0) ; "RTN","BIREPD2",268,0) I $G(BIERR)]"" D WRITE^BIREPD3(.BILINE,BIERR) Q "RTN","BIREPD2",269,0) ; "RTN","BIREPD2",270,0) ;---> Finish off report with totals lines at the bottom. "RTN","BIREPD2",271,0) I BISPD="CSV" D "RTN","BIREPD2",272,0) .S X=" " D WRITE^BIREPD3(.BILINE,X) "RTN","BIREPD2",273,0) .S X="Total Patients reviewed: ,"_BITOTPTS D WRITE^BIREPD3(.BILINE,X) "RTN","BIREPD2",274,0) .S X="Females: ,"_BITOTFPT D WRITE^BIREPD3(.BILINE,X) "RTN","BIREPD2",275,0) .S X="Males: ,"_BITOTMPT D WRITE^BIREPD3(.BILINE,X) "RTN","BIREPD2",276,0) I BISPD'="CSV" D "RTN","BIREPD2",277,0) .S X=" Total Patients reviewed: "_BITOTPTS "RTN","BIREPD2",278,0) .S X=X_" Females: "_BITOTFPT_" Males: "_BITOTMPT "RTN","BIREPD2",279,0) .D WRITE^BIREPD3(.BILINE,X) "RTN","BIREPD2",280,0) ; "RTN","BIREPD2",281,0) ;---> Now write total patients considered who had refusals. "RTN","BIREPD2",282,0) N M,N S (M,N)=0 F S M=$O(BITMP("REFUSALS",M)) Q:'M S N=N+1 "RTN","BIREPD2",283,0) I BISPD'="CSV" S X=" Total Patients reviewed who had Refusals on record: "_N "RTN","BIREPD2",284,0) I BISPD="CSV" S X="Total Patients reviewed who had Refusals on record: ,"_N "RTN","BIREPD2",285,0) D WRITE^BIREPD3(.BILINE,X) I BISPD'="CSV" D WRITE^BIREPD3(.BILINE,$$SP^BIUTL5(79,"-")) "RTN","BIREPD2",286,0) ; "RTN","BIREPD2",287,0) D "RTN","BIREPD2",288,0) .I BIUP="r" S X="all Registered Patients who have an active health record." Q "RTN","BIREPD2",289,0) .I BIUP="i" S X="Immunization Register Patients with a status of Active." Q "RTN","BIREPD2",290,0) .I BIUP="u" S X="the User Population patients: 1 visit in the past 3 years." Q "RTN","BIREPD2",291,0) .I BIUP="a" S X="Active Clinical Users: 2 clinical visits in the past 3 years." Q "RTN","BIREPD2",292,0) ; "RTN","BIREPD2",293,0) S X=" *Denominators are "_X "RTN","BIREPD2",294,0) D WRITE^BIREPD3(.BILINE,X) "RTN","BIREPD2",295,0) ; "RTN","BIREPD2",296,0) ;********** PATCH 1, v8.5, JAN 03,2012, IHS/CMI/MWR "RTN","BIREPD2",297,0) ;---> Change text of explanation. "RTN","BIREPD2",298,0) ;S X=" *All patients (11-17yrs) with 1-Tdap_TD and 1-Mening are considered ""Current.""" "RTN","BIREPD2",299,0) ;D WRITE^BIREPD3(.BILINE,X) "RTN","BIREPD2",300,0) ;S X=" *Patients 11-12yrs without 1-Tdap_TD and 1-Mening are listed as ""Not Current""" "RTN","BIREPD2",301,0) ;S X=" in order to support patient recall." "RTN","BIREPD2",302,0) ; "RTN","BIREPD2",303,0) Q:BISPD="CSV" "RTN","BIREPD2",304,0) ;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR "RTN","BIREPD2",305,0) ;---> Update "Current" explanation to include 3-HPV. "RTN","BIREPD2",306,0) ;S X=" *All patients (11-17yrs) with 1-Tdap_TD and 1-Mening are considered ""Current"";" "RTN","BIREPD2",307,0) S X=" *All patients (11-17yrs) with 1-Tdap, 1-MEN, 3/2-HPV are considered ""Current"";" "RTN","BIREPD2",308,0) ;********** "RTN","BIREPD2",309,0) ; "RTN","BIREPD2",310,0) D WRITE^BIREPD3(.BILINE,X) "RTN","BIREPD2",311,0) S X=" otherwise they are listed as ""Not Current"" in order to support patient recall." "RTN","BIREPD2",312,0) ; "RTN","BIREPD2",313,0) D WRITE^BIREPD3(.BILINE,X) "RTN","BIREPD2",314,0) D WRITE^BIREPD3(.BILINE,$$SP^BIUTL5(79,"-")) "RTN","BIREPD2",315,0) ; "RTN","BIREPD2",316,0) ;---> Set final VALMCNT (Listman line count). "RTN","BIREPD2",317,0) S VALMCNT=BILINE "RTN","BIREPD2",318,0) Q "RTN","BIREPD2",319,0) ; "RTN","BIREPD2",320,0) ; "RTN","BIREPD2",321,0) ;---------- "RTN","BIREPD2",322,0) DENOMS(BILINE,BITOTSPT,Z) ;EP "RTN","BIREPD2",323,0) ;---> Produce Female and Male Denominators subheader. "RTN","BIREPD2",324,0) ;---> Parameters: "RTN","BIREPD2",325,0) ; 1 - BILINE (req) Line number in ^TMP Listman array. "RTN","BIREPD2",326,0) ; 2 - BITOTSPT (req) By Sex Total Patients-Age Group-Stats array. "RTN","BIREPD2",327,0) ; 3 - Z (req) If Z=1, then female; Z=0, then male. "RTN","BIREPD2",328,0) ; "RTN","BIREPD2",329,0) ;---> Break to write Female or Male Denominators subheader. "RTN","BIREPD2",330,0) I BISPD'="CSV" S X=$S(Z:" Female",1:" Male ") S X=X_" | 11-12yrs 13yrs 13-17yrs" "RTN","BIREPD2",331,0) I BISPD="CSV" S X=" " D WRITE^BIREPD3(.BILINE,X),WRITE^BIREPD3(.BILINE,X) S X=",11-12yrs,13yrs,13-17yrs" "RTN","BIREPD2",332,0) D WRITE^BIREPD3(.BILINE,X) "RTN","BIREPD2",333,0) I BISPD'="CSV" S X=" Denominators | "_$J($G(BITOTSPT(1112)),7)_" " S X=X_$J($G(BITOTSPT(1313)),7)_" "_$J($G(BITOTSPT(1317)),7) "RTN","BIREPD2",334,0) I BISPD="CSV" S X=$S(Z:"Female Denominators,",1:"Male Denominators,")_+$G(BITOTSPT(1112))_","_+$G(BITOTSPT(1313))_","_+$G(BITOTSPT(1317)) "RTN","BIREPD2",335,0) D WRITE^BIREPD3(.BILINE,X) "RTN","BIREPD2",336,0) I BISPD'="CSV" D WRITE^BIREPD3(.BILINE," "_$$SP^BIUTL5(63,"-")) "RTN","BIREPD2",337,0) Q "RTN","BIREPD3") 0^4^B85439571 "RTN","BIREPD3",1,0) BIREPD3 ;IHS/CMI/MWR - REPORT, ADOLESCENT RATES; MAY 10, 2010 "RTN","BIREPD3",2,0) ;;8.5;IMMUNIZATION;**17,31**;OCT 24,2011;Build 137 "RTN","BIREPD3",3,0) ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS * "RTN","BIREPD3",4,0) ;; VIEW ADOLESCENT IMMUNIZATION RATES REPORT. "RTN","BIREPD3",5,0) ;; PATCH 3: Include new "1-Td 1-Men 3-HPV" lines. VCOMB+14 "RTN","BIREPD3",6,0) ;; PATCH 5: Correct Male HPV percentage denominator. VGRP+60 "RTN","BIREPD3",7,0) ;; PATCH 17: Extensive changes to enhance Adol HPV & Tdap Reporting. VGRP+29 "RTN","BIREPD3",8,0) ; "RTN","BIREPD3",9,0) ; "RTN","BIREPD3",10,0) ;---------- "RTN","BIREPD3",11,0) GETDATA(BICC,BIHCF,BICM,BIBEN,BIQDT,BIDAR,BIAGRPS,BISITE,BIUP,BITMP,BIERR) ;EP "RTN","BIREPD3",12,0) ;---> Gather Immunization History data on selected patients. "RTN","BIREPD3",13,0) ;---> Parameters: "RTN","BIREPD3",14,0) ; 1 - BICC (req) Current Community array. "RTN","BIREPD3",15,0) ; 2 - BIHCF (req) Health Care Facility array. "RTN","BIREPD3",16,0) ; 3 - BICM (req) Case Manager array. "RTN","BIREPD3",17,0) ; 4 - BIBEN (req) Beneficiary Type array. "RTN","BIREPD3",18,0) ; 5 - BIQDT (req) Quarter Ending Date. "RTN","BIREPD3",19,0) ; 6 - BIDAR (opt) Adolescent Age Range: "11-18^1" (years). "RTN","BIREPD3",20,0) ; 7 - BIAGRPS (req) String of Age Groups ("1112,1313,1317"). "RTN","BIREPD3",21,0) ; 8 - BISITE (req) Site IEN. "RTN","BIREPD3",22,0) ; 9 - BIUP (req) User Population/Group (All, Imm, User, Active). "RTN","BIREPD3",23,0) ; 10 - BITMP (ret) Stores Patient Totals by Age Group and Sex. "RTN","BIREPD3",24,0) ; 11 - BIERR (ret) Error. "RTN","BIREPD3",25,0) ; "RTN","BIREPD3",26,0) S:'$G(BISITE) BISITE=$G(DUZ(2)) I '$G(BISITE) S BIERR=109 Q "RTN","BIREPD3",27,0) S:'$G(BIQDT) BIQDT=DT "RTN","BIREPD3",28,0) S:'$D(BIDAR) BIDAR="11-18^1" "RTN","BIREPD3",29,0) S:$G(BIUP)="" BIUP="u" "RTN","BIREPD3",30,0) ; "RTN","BIREPD3",31,0) ;---> Get Begin and End Dates (DOB's). "RTN","BIREPD3",32,0) D AGEDATE^BIAGE(BIDAR,BIQDT,.BIBEGDT,.BIENDDT,.BIERR) "RTN","BIREPD3",33,0) Q:$G(BIERR)]"" "RTN","BIREPD3",34,0) ; "RTN","BIREPD3",35,0) ;---> Gather and sort patients. "RTN","BIREPD3",36,0) D GETPATS^BIREPD4(BIBEGDT,BIENDDT,.BICC,.BIHCF,.BICM,.BIBEN,BIQDT,BIAGRPS,BISITE,BIUP,.BITMP) "RTN","BIREPD3",37,0) Q "RTN","BIREPD3",38,0) ; "RTN","BIREPD3",39,0) ; Call from BIREPD2: F BIVGRP=4,6,7,8,9,16,10,17 D VGRP^BIREPD3(.BILINE,BIVGRP,BIAGRPS,BISEX,.BIERR) "RTN","BIREPD3",40,0) ; "RTN","BIREPD3",41,0) ;---------- "RTN","BIREPD3",42,0) VGRP(BILINE,BIVGRP,BIAGRPS,BITMP,BISEX,BIERR) ;EP "RTN","BIREPD3",43,0) ;---> Write Stats lines for each Vaccine Group. "RTN","BIREPD3",44,0) ;---> Parameters: "RTN","BIREPD3",45,0) ; 1 - BILINE (req) Line number in ^TMP Listman array. "RTN","BIREPD3",46,0) ; 2 - BIVGRP (req) IEN of Vaccine Group. "RTN","BIREPD3",47,0) ; 3 - BIAGRPS (req) String of Age Groups ("1112,1313,1317"). "RTN","BIREPD3",48,0) ; 4 - BITMP (req) Stores Patient Totals by Age Group and Sex. "RTN","BIREPD3",49,0) ; 5 - BISEX (opt) F or M for HPV. "RTN","BIREPD3",50,0) ; 6 - BIERR (ret) Error. "RTN","BIREPD3",51,0) ; "RTN","BIREPD3",52,0) I '$G(BIVGRP) D ERRCD^BIUTL2(510,.BIERR) Q "RTN","BIREPD3",53,0) I '$G(BIAGRPS) D ERRCD^BIUTL2(677,.BIERR) Q "RTN","BIREPD3",54,0) ; "RTN","BIREPD3",55,0) ;---> Write two lines for each Dose of this Vaccine Group. "RTN","BIREPD3",56,0) N BIDOSE,BIMAXD S BIMAXD=$$VGROUP^BIUTL2(BIVGRP,7) "RTN","BIREPD3",57,0) ; "RTN","BIREPD3",58,0) ;---> Include exception here for Tdap. "RTN","BIREPD3",59,0) I ((BIVGRP=132)!(BIVGRP=221)) S BIMAXD=1 "RTN","BIREPD3",60,0) ; "RTN","BIREPD3",61,0) F BIDOSE=1:1:BIMAXD D "RTN","BIREPD3",62,0) .;---> BIX=text of the line to write. "RTN","BIREPD3",63,0) .;---> For all Sex Tally lines (e.g., "F2") write on one line. "RTN","BIREPD3",64,0) .I $E($G(BISEX),2) Q:BIDOSE'=1 "RTN","BIREPD3",65,0) .; "RTN","BIREPD3",66,0) .;---> First, write the Dose#-Vaccine Group in left margin. "RTN","BIREPD3",67,0) .N BIX D "RTN","BIREPD3",68,0) ..;---> Include exception here for Tdap. "RTN","BIREPD3",69,0) ..I BIVGRP=132 S BIX=$S(BISPD'="CSV":" Hx of Chickenpox",1:"Hx of Chickenpox (Immune) #") Q "RTN","BIREPD3",70,0) ..; "RTN","BIREPD3",71,0) ..;********** PATCH 17, v8.5, MAR 01,2019, IHS/CMI/MWR "RTN","BIREPD3",72,0) ..;---> All Tentanus Volume Group=8 have been filtered for only Tdap CVX=221. "RTN","BIREPD3",73,0) ..;I BIVGRP=221 S BIX=" 1-Tdap" Q "RTN","BIREPD3",74,0) ..;I BIVGRP=8 S BIX=" 1-Tdap/Td" Q "RTN","BIREPD3",75,0) ..I BIVGRP=8 S BIX=$S(BISPD'="CSV":" 1-Tdap",1:"1-Tdap #") Q "RTN","BIREPD3",76,0) ..; "RTN","BIREPD3",77,0) ..I $E($G(BISEX),2),BISPD'="CSV" S BIX=" Fully Vac'd" D Q "RTN","BIREPD3",78,0) ...;I $E($G(BISEX))="B" S BIX="F+M"_$E(BIX,4,15) Q "RTN","BIREPD3",79,0) ..I BISPD'="CSV" S BIX=" "_BIDOSE_"-"_$$VGROUP^BIUTL2(BIVGRP,5) "RTN","BIREPD3",80,0) ..I $E($G(BISEX),2),BISPD="CSV" D Q "RTN","BIREPD3",81,0) ...I $E($G(BISEX),2)=2 S BIX="Fully Vac'd HPV 2 Doses #" Q "RTN","BIREPD3",82,0) ...I $E($G(BISEX),2)=3 S BIX="Fully Vac'd HPV 3 Doses %" Q "RTN","BIREPD3",83,0) ...I $E($G(BISEX),2)=5 S BIX="Fully Vac'd 2&3 combined %" Q ;S BIX="Fully Vac'd "_BIDOSE_"-"_$$VGROUP^BIUTL2(BIVGRP,5)_" #" Q "RTN","BIREPD3",84,0) ..I BISPD="CSV",'$E($G(BISEX),2) S BIX=BIDOSE_"-"_$$VGROUP^BIUTL2(BIVGRP,5)_" #" "RTN","BIREPD3",85,0) .; "RTN","BIREPD3",86,0) .I BISPD'="CSV" S BIX=$$PAD^BIUTL5(BIX,17)_"|" "RTN","BIREPD3",87,0) .I BISPD="CSV" S BIX=BIX_"," "RTN","BIREPD3",88,0) .; "RTN","BIREPD3",89,0) .;---> Write actual totals line for this dose for each Age Group "RTN","BIREPD3",90,0) .;---> (loop through the age groups, concating the totals horizontally). "RTN","BIREPD3",91,0) .N BIAGRP,K "RTN","BIREPD3",92,0) .F K=1:1 S BIAGRP=$P(BIAGRPS,",",K) Q:'BIAGRP D "RTN","BIREPD3",93,0) ..N Y D "RTN","BIREPD3",94,0) ...;---> If HPV (17), append sex to age group to retrieve HPV stats. "RTN","BIREPD3",95,0) ...I BIVGRP=17 D Q "RTN","BIREPD3",96,0) ....N N S N=$E($G(BISEX),2) "RTN","BIREPD3",97,0) ....I N S Y=+$G(BITMP("STATS",BIVGRP,N,BIAGRP_BISEX)) Q "RTN","BIREPD3",98,0) ....S Y=+$G(BITMP("STATS",BIVGRP,BIDOSE,BIAGRP_BISEX)) Q "RTN","BIREPD3",99,0) ...; "RTN","BIREPD3",100,0) ...S Y=+$G(BITMP("STATS",BIVGRP,BIDOSE,BIAGRP)) "RTN","BIREPD3",101,0) ..; "RTN","BIREPD3",102,0) ..I BISPD'="CSV" S BIX=BIX_$J(Y,12)_" " "RTN","BIREPD3",103,0) ..I BISPD="CSV" S BIX=BIX_+Y_"," "RTN","BIREPD3",104,0) .D WRITE(.BILINE,BIX) "RTN","BIREPD3",105,0) .D MARK^BIW(BILINE,3,"BIREPD1") "RTN","BIREPD3",106,0) .; "RTN","BIREPD3",107,0) .; "RTN","BIREPD3",108,0) .;---> Now write PERCENTAGES line for each Age Group (under the actual totals). "RTN","BIREPD3",109,0) .;---> Write custom row label if necessary. "RTN","BIREPD3",110,0) .D "RTN","BIREPD3",111,0) ..S BIX="" I BIVGRP=132,BISPD'="CSV" S BIX=" (Immune)" Q "RTN","BIREPD3",112,0) ..I $E($G(BISEX),2)=2 S BIX=$S(BISPD'="CSV":" HPV 2 Doses",1:"Fully Vac'd HPV 2 Doses %,") Q "RTN","BIREPD3",113,0) ..I $E($G(BISEX),2)=3 S BIX=$S(BISPD'="CSV":" HPV 3 Doses",1:"Fully Vac'd HPV 3 Doses %,") Q "RTN","BIREPD3",114,0) ..I $E($G(BISEX),2)=5 S BIX=$S(BISPD'="CSV":" 2 & 3 combined",1:"Fully Vac'd 2&3 combined %,") Q "RTN","BIREPD3",115,0) .; "RTN","BIREPD3",116,0) .I BISPD'="CSV" S BIX=$$PAD^BIUTL5(BIX,17)_"|" "RTN","BIREPD3",117,0) .I BISPD="CSV" D "RTN","BIREPD3",118,0) ..I BIVGRP=132 S BIX="Hx of Chickenpox (Immune) %," Q "RTN","BIREPD3",119,0) ..I BIVGRP=8 S BIX="1-Tdap %," Q "RTN","BIREPD3",120,0) ..I BIX="" S BIX=BIDOSE_"-"_$$VGROUP^BIUTL2(BIVGRP,5)_" %," "RTN","BIREPD3",121,0) .F K=1:1 S BIAGRP=$P(BIAGRPS,",",K) Q:'BIAGRP D "RTN","BIREPD3",122,0) ..;N Y S Y=$G(BITMP("STATS",BIVGRP,BIDOSE,BIAGRP)) "RTN","BIREPD3",123,0) ..N Y D "RTN","BIREPD3",124,0) ...;---> If HPV (17), append sex to age group to retrieve HPV stats. "RTN","BIREPD3",125,0) ...I BIVGRP=17 D Q "RTN","BIREPD3",126,0) ....N N S N=$E($G(BISEX),2) "RTN","BIREPD3",127,0) ....I N S Y=+$G(BITMP("STATS",BIVGRP,N,BIAGRP_BISEX)) Q "RTN","BIREPD3",128,0) ....S Y=+$G(BITMP("STATS",BIVGRP,BIDOSE,BIAGRP_BISEX)) Q "RTN","BIREPD3",129,0) ...; "RTN","BIREPD3",130,0) ...S Y=+$G(BITMP("STATS",BIVGRP,BIDOSE,BIAGRP)) "RTN","BIREPD3",131,0) ..; "RTN","BIREPD3",132,0) ..I 'Y S:BISPD'="CSV" BIX=BIX_$J("",12)_" " S:BISPD="CSV" BIX=BIX_"0," Q "RTN","BIREPD3",133,0) ..; "RTN","BIREPD3",134,0) ..;---> If Vaccine Group is HPV-17, use female and male denominators. "RTN","BIREPD3",135,0) ..N BIDENOM D "RTN","BIREPD3",136,0) ...I (BIVGRP=17)&($G(BISEX)["F") S BIDENOM="TOTLFPTS" Q "RTN","BIREPD3",137,0) ...I (BIVGRP=17)&($G(BISEX)["M") S BIDENOM="TOTLMPTS" Q "RTN","BIREPD3",138,0) ...S BIDENOM="TOTLPTS" Q "RTN","BIREPD3",139,0) ..N Z S Z=$G(BITMP("STATS",BIDENOM,BIAGRP)) "RTN","BIREPD3",140,0) ..; "RTN","BIREPD3",141,0) ..;---> To avoid bomb if Z=0/null. "RTN","BIREPD3",142,0) ..S:'Z Y=0,Z=1 S Y=(Y*100)/Z "RTN","BIREPD3",143,0) ..I BISPD'="CSV" S BIX=BIX_$J(Y,12,0)_"%" "RTN","BIREPD3",144,0) ..I BISPD="CSV" S BIX=BIX_$$STRIP^XLFSTR($J(Y,12,0)," ")_"," "RTN","BIREPD3",145,0) .D WRITE(.BILINE,BIX) "RTN","BIREPD3",146,0) .; "RTN","BIREPD3",147,0) .;---> Write a dashed line to close off this Dose. "RTN","BIREPD3",148,0) .Q:BIDOSE=BIMAXD "RTN","BIREPD3",149,0) .Q:($E($G(BISEX),2)=5) "RTN","BIREPD3",150,0) .I BISPD'="CSV" S BIX=$$SP^BIUTL5(17)_"|"_$$SP^BIUTL5(61,"-") D WRITE(.BILINE,BIX) "RTN","BIREPD3",151,0) ; "RTN","BIREPD3",152,0) ;---> Write a final dashed line to close off this Vaccine Group (unless Tdap). "RTN","BIREPD3",153,0) Q:(($E($G(BISEX),2)=2)!($E($G(BISEX),2)=3)) "RTN","BIREPD3",154,0) ; "RTN","BIREPD3",155,0) ;---> Write intermediate dashed HPV line, when sex is F5 or M5. "RTN","BIREPD3",156,0) I BIVGRP=17,$E($G(BISEX),2)'=5,BISPD'="CSV" D Q "RTN","BIREPD3",157,0) .D WRITE(.BILINE," "_$$SP^BIUTL5(75,"-")) "RTN","BIREPD3",158,0) ; "RTN","BIREPD3",159,0) D "RTN","BIREPD3",160,0) .;---> Write Post-Tdap dashed line. "RTN","BIREPD3",161,0) .I BIVGRP=221,BISPD'="CSV" S BIX=$$SP^BIUTL5(17)_"|"_$$SP^BIUTL5(61,"-") Q "RTN","BIREPD3",162,0) .; "RTN","BIREPD3",163,0) .;---> Write dashed line full full width of screen. "RTN","BIREPD3",164,0) .I BISPD'="CSV" S BIX=$$SP^BIUTL5(79,"-") "RTN","BIREPD3",165,0) I BISPD'="CSV" D WRITE(.BILINE,BIX) "RTN","BIREPD3",166,0) Q "RTN","BIREPD3",167,0) ; "RTN","BIREPD3",168,0) ; "RTN","BIREPD3",169,0) ;---------- "RTN","BIREPD3",170,0) VCOMB(BILINE,BICOMB,BIAGRPS,BITMP,BISEX,BIERR) ;EP "RTN","BIREPD3",171,0) ;---> Write Stats lines for each Vaccine Combination. "RTN","BIREPD3",172,0) ;---> Parameters: "RTN","BIREPD3",173,0) ; 1 - BILINE (req) Line number in ^TMP Listman array. "RTN","BIREPD3",174,0) ; 2 - BICOMB (req) Numeric code of Vaccine Combination. "RTN","BIREPD3",175,0) ; 3 - BIAGRPS (req) String of Age Groups ("1112,1313,1317"). "RTN","BIREPD3",176,0) ; 4 - BITMP (ret) Stores Patient Totals by Age Group and Sex. "RTN","BIREPD3",177,0) ; 5 - BISEX (opt) F or M for HPV, or B (for "both"). "RTN","BIREPD3",178,0) ; 6 - BIERR (ret) Error. "RTN","BIREPD3",179,0) ; "RTN","BIREPD3",180,0) I '$G(BIAGRPS) D ERRCD^BIUTL2(677,.BIERR) Q "RTN","BIREPD3",181,0) ; "RTN","BIREPD3",182,0) ;---> Build the left-most cell that lists the vaccines for this combo. "RTN","BIREPD3",183,0) ; "RTN","BIREPD3",184,0) ;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR "RTN","BIREPD3",185,0) ;---> Include new "1-Td 1-Men 3-HPV" lines for both sexes combined. "RTN","BIREPD3",186,0) N BIX,I,Q,X S Q=0 S:$G(BISEX)="" BISEX="" "RTN","BIREPD3",187,0) F I=1:1:4 S BIX(I)="" "RTN","BIREPD3",188,0) F I=1:1 S X=$P(BICOMB,U,I) Q:Q D "RTN","BIREPD3",189,0) .;I ((X="")&(BICOMB'[17)) S Q=1 Q "RTN","BIREPD3",190,0) .I ((X="")&((BICOMB'[17)!(BISEX="B"))) S Q=1 Q "RTN","BIREPD3",191,0) .;********** "RTN","BIREPD3",192,0) .S:(X="") X=$S(BISEX="F":"(females)",BISEX="M":"(males)",1:"???"),Q=1 "RTN","BIREPD3",193,0) .S:'Q X=$P(X,"|",2)_"-"_$$VGROUP^BIUTL2($P(X,"|"),5) "RTN","BIREPD3",194,0) .; "RTN","BIREPD3",195,0) .;********** PATCH 17, v8.5, MAR 01,2019, IHS/CMI/MWR "RTN","BIREPD3",196,0) .;---> Change to reflect HPV Fully Vac'd (can be either 2 or 3 dose). "RTN","BIREPD3",197,0) .S:(X="3-HPV") X="HPV-fv" "RTN","BIREPD3",198,0) .;---> Change to reflect Tdap instead of Td Vaccine Group. "RTN","BIREPD3",199,0) .S:(X="1-TD_B") X="1-Tdap" "RTN","BIREPD3",200,0) .; "RTN","BIREPD3",201,0) .I BISPD="CSV" S BIX(1)=BIX(1)_" "_X Q "RTN","BIREPD3",202,0) .I I<3 S BIX(1)=BIX(1)_" "_X Q "RTN","BIREPD3",203,0) .I I<5 S BIX(2)=BIX(2)_" "_X Q "RTN","BIREPD3",204,0) .I I<7 S BIX(3)=BIX(3)_" "_X Q "RTN","BIREPD3",205,0) .S BIX(4)=BIX(4)_" "_X "RTN","BIREPD3",206,0) ; "RTN","BIREPD3",207,0) ; add # to end of csv lable "RTN","BIREPD3",208,0) I BISPD="CSV" S BIX(1)=BIX(1)_" #," "RTN","BIREPD3",209,0) ;---> Write actual totals line for this Combo for each Age Group "RTN","BIREPD3",210,0) ;---> (loop through the Age Groups. "RTN","BIREPD3",211,0) S BIX=BIX(1) I BISPD'="CSV" S BIX=$$PAD^BIUTL5(BIX,17)_"|" "RTN","BIREPD3",212,0) N BIAGRP,K "RTN","BIREPD3",213,0) F K=1:1 S BIAGRP=$P(BIAGRPS,",",K) Q:'BIAGRP D "RTN","BIREPD3",214,0) .N Y D "RTN","BIREPD3",215,0) ..;---> If HPV (17), append sex to age group to retrieve HPV stats. "RTN","BIREPD3",216,0) ..I $G(BISEX)="F" S Y=+$G(BITMP("STATS",BICOMB,BIAGRP_"F")) Q "RTN","BIREPD3",217,0) ..I $G(BISEX)="M" S Y=+$G(BITMP("STATS",BICOMB,BIAGRP_"M")) Q "RTN","BIREPD3",218,0) ..S Y=+$G(BITMP("STATS",BICOMB,BIAGRP)) "RTN","BIREPD3",219,0) .; "RTN","BIREPD3",220,0) .I BISPD'="CSV" S BIX=BIX_$J(Y,12)_" " "RTN","BIREPD3",221,0) .I BISPD="CSV" S BIX=BIX_+Y_"," "RTN","BIREPD3",222,0) D WRITE(.BILINE,BIX) "RTN","BIREPD3",223,0) S I=3 S:BIX(3)]"" I=4 S:BIX(4)]"" I=5 "RTN","BIREPD3",224,0) D MARK^BIW(BILINE,I,"BIREPD1") "RTN","BIREPD3",225,0) ; "RTN","BIREPD3",226,0) ;---> Now write percentages line. "RTN","BIREPD3",227,0) I BISPD'="CSV" S BIX=BIX(2),BIX=$$PAD^BIUTL5(BIX,17)_"|" "RTN","BIREPD3",228,0) I BISPD="CSV" S BIX=$P(BIX(1),"#")_"%," "RTN","BIREPD3",229,0) F K=1:1 S BIAGRP=$P(BIAGRPS,",",K) Q:'BIAGRP D "RTN","BIREPD3",230,0) .N Y D "RTN","BIREPD3",231,0) ..;---> If HPV (17), append sex to age group to retrieve HPV stats. "RTN","BIREPD3",232,0) ..I $G(BISEX)="F" S Y=$G(BITMP("STATS",BICOMB,BIAGRP_"F")) Q "RTN","BIREPD3",233,0) ..I $G(BISEX)="M" S Y=$G(BITMP("STATS",BICOMB,BIAGRP_"M")) Q "RTN","BIREPD3",234,0) ..S Y=$G(BITMP("STATS",BICOMB,BIAGRP)) "RTN","BIREPD3",235,0) .; "RTN","BIREPD3",236,0) .I BISPD'="CSV" I 'Y S BIX=BIX_$J("",12)_" " Q "RTN","BIREPD3",237,0) .I BISPD="CSV" I 'Y S BIX=BIX_"0," Q "RTN","BIREPD3",238,0) .I '$G(BITMP("STATS","TOTLPTS")) S BIX=BIX_$J(Y,7)_" " Q "RTN","BIREPD3",239,0) .; "RTN","BIREPD3",240,0) .;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR "RTN","BIREPD3",241,0) .;---> Use denominators for Both, Female, and Male. "RTN","BIREPD3",242,0) .;N Z S Z=$G(BITMP("STATS",$S(BICOMB[17:"TOTLFPTS",1:"TOTLPTS"),BIAGRP)) "RTN","BIREPD3",243,0) .N Z D "RTN","BIREPD3",244,0) ..;---> If HPV (17), append sex to age group to retrieve denominator. "RTN","BIREPD3",245,0) ..I $G(BISEX)="F" S Z=$G(BITMP("STATS","TOTLFPTS",BIAGRP)) Q "RTN","BIREPD3",246,0) ..I $G(BISEX)="M" S Z=$G(BITMP("STATS","TOTLMPTS",BIAGRP)) Q "RTN","BIREPD3",247,0) ..S Z=$G(BITMP("STATS","TOTLPTS",BIAGRP)) "RTN","BIREPD3",248,0) .;********** "RTN","BIREPD3",249,0) .; "RTN","BIREPD3",250,0) .;---> To avoid bomb if Z=0/null. "RTN","BIREPD3",251,0) .S:'Z Y=0,Z=1 S Y=(Y*100)/Z "RTN","BIREPD3",252,0) .I BISPD'="CSV" S BIX=BIX_$J(Y,12,0)_"%" "RTN","BIREPD3",253,0) .I BISPD="CSV" S BIX=BIX_$$STRIP^XLFSTR($J(Y,12,0)," ")_"," "RTN","BIREPD3",254,0) .;S BIX=BIX_$J(Y,$S(K=1:9,1:12),0)_"%" "RTN","BIREPD3",255,0) D WRITE(.BILINE,BIX) "RTN","BIREPD3",256,0) ; "RTN","BIREPD3",257,0) F I=3,4 D:BIX(I)]"" "RTN","BIREPD3",258,0) .S BIX=BIX(I),BIX=$$PAD^BIUTL5(BIX,17)_"|" "RTN","BIREPD3",259,0) .D WRITE(.BILINE,BIX) "RTN","BIREPD3",260,0) ; "RTN","BIREPD3",261,0) I BISPD'="CSV" D WRITE(.BILINE,$$SP^BIUTL5(79,"-")) "RTN","BIREPD3",262,0) Q "RTN","BIREPD3",263,0) ; "RTN","BIREPD3",264,0) ; "RTN","BIREPD3",265,0) ;---------- "RTN","BIREPD3",266,0) WRITE(BILINE,BIVAL,BIBLNK) ;EP "RTN","BIREPD3",267,0) ;---> Write lines to ^TMP (see documentation in ^BIW). "RTN","BIREPD3",268,0) ;---> Parameters: "RTN","BIREPD3",269,0) ; 1 - BILINE (ret) Last line# written. "RTN","BIREPD3",270,0) ; 2 - BIVAL (opt) Value/text of line (Null=blank line). "RTN","BIREPD3",271,0) ; "RTN","BIREPD3",272,0) Q:'$D(BILINE) "RTN","BIREPD3",273,0) D WL^BIW(.BILINE,"BIREPD1",$G(BIVAL),$G(BIBLNK)) "RTN","BIREPD3",274,0) ; "RTN","BIREPD3",275,0) ;--->Set VALMCNT (Listman line count) for errors calls above. "RTN","BIREPD3",276,0) S VALMCNT=BILINE "RTN","BIREPD3",277,0) Q "RTN","BIREPF1") 0^7^B26160157 "RTN","BIREPF1",1,0) BIREPF1 ;IHS/CMI/MWR - REPORT, FLU IMM; AUG 10,2010 "RTN","BIREPF1",2,0) ;;8.5;IMMUNIZATION;**31**;OCT 24,2011;Build 137 "RTN","BIREPF1",3,0) ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS * "RTN","BIREPF1",4,0) ;; VIEW OR PRINT INFLUENZA IMMUNIZATION REPORT. "RTN","BIREPF1",5,0) ;; PATCH 1: Include Flu/H1N1 parameter for body of report when queued. "RTN","BIREPF1",6,0) ;; DEQUEUE+6 "RTN","BIREPF1",7,0) ; "RTN","BIREPF1",8,0) ;---------- "RTN","BIREPF1",9,0) START(BIX) ;EP "RTN","BIREPF1",10,0) ;---> VIEW Influenza Report. "RTN","BIREPF1",11,0) ;---> Prepare and display Influenza Report. "RTN","BIREPF1",12,0) ;---> Parameters: "RTN","BIREPF1",13,0) ; 1 - BIX (req) If BIX="PRINT", then print Qtr Report. "RTN","BIREPF1",14,0) ; If BIX="VIEW", then view Qtr Report (default). "RTN","BIREPF1",15,0) ;---> Variables: "RTN","BIREPF1",16,0) ; 1 - BIYEAR (req) Report Year^m (if 2nd pc="m", then End Date=March 31 of "RTN","BIREPF1",17,0) ; the report year; otherwise End Date=Dec 31 of BIYEAR) "RTN","BIREPF1",18,0) ; 2 - BICC (req) Current Community array. "RTN","BIREPF1",19,0) ; 3 - BIHCF (req) Health Care Facility array. "RTN","BIREPF1",20,0) ; 4 - BICM (req) Case Manager array. "RTN","BIREPF1",21,0) ; 5 - BIBEN (req) Beneficiary Type array. "RTN","BIREPF1",22,0) ; 6 - BIFH (opt) F=report on Flu Vaccine Group (default), H=H1N1 group. "RTN","BIREPF1",23,0) ; 7 - BIPOP (ret) BIPOP=1 if error. "RTN","BIREPF1",24,0) ; "RTN","BIREPF1",25,0) ;---> Check for required Variables. "RTN","BIREPF1",26,0) I '$G(BIYEAR) D ERROR(679) D RESET^BIREPF Q "RTN","BIREPF1",27,0) I '$D(BICC) D ERROR(614) D RESET^BIREPF Q "RTN","BIREPF1",28,0) I '$D(BIHCF) D ERROR(625) D RESET^BIREPF Q "RTN","BIREPF1",29,0) I '$D(BICM) D ERROR(615) D RESET^BIREPF Q "RTN","BIREPF1",30,0) I '$D(BIBEN) D ERROR(662) D RESET^BIREPF Q "RTN","BIREPF1",31,0) S:($G(BIFH)="") BIFH="F" "RTN","BIREPF1",32,0) S:$G(BIUP)="" BIUP="u" "RTN","BIREPF1",33,0) ; "RTN","BIREPF1",34,0) D SETVARS^BIUTL5 N VALMCNT "RTN","BIREPF1",35,0) ;IHS/LAB patch 31 delimited save print type for later use "RTN","BIREPF1",36,0) S BISPD=BIX "RTN","BIREPF1",37,0) I $G(BIX)="PRINT" D PRINT,RESET^BIREPF Q "RTN","BIREPF1",38,0) I $G(BIX)="CSV" D DELIM^BIREPCSV("BIREPF1","FLU REPORT","FLU"),RESET^BIREPF Q ;IHS/LAB patch 31 delimited output "RTN","BIREPF1",39,0) ; "RTN","BIREPF1",40,0) ; "RTN","BIREPF1",41,0) ;---> Set BIAG for Age Range in header of report. "RTN","BIREPF1",42,0) ;---> Set BIRPDT for Report Date ("Quarterly, etc.). "RTN","BIREPF1",43,0) ;---> Set BIRTN in case user runs Patient List then needs to return "RTN","BIREPF1",44,0) ;---> to INIT here. "RTN","BIREPF1",45,0) ;---> Set BITITL for Report Name in Patient List, if called. vvv83 "RTN","BIREPF1",46,0) N BIAG,BIRPDT,BIRTN,BITITL "RTN","BIREPF1",47,0) S BIAG="ALL",BIRPDT=$G(DT),BIRTN="BIREPF1",BITITL="INFLUENZA" "RTN","BIREPF1",48,0) D EN "RTN","BIREPF1",49,0) D RESET^BIREPF "RTN","BIREPF1",50,0) Q "RTN","BIREPF1",51,0) ; "RTN","BIREPF1",52,0) ; "RTN","BIREPF1",53,0) ;---------- "RTN","BIREPF1",54,0) PRINT ;EP "RTN","BIREPF1",55,0) ;---> Main entry point for printing the Quarterly Immunization Report. "RTN","BIREPF1",56,0) D DEVICE(.BIPOP) "RTN","BIREPF1",57,0) Q:$G(BIPOP) "RTN","BIREPF1",58,0) ; "RTN","BIREPF1",59,0) D:$G(IO)'=$G(IO(0)) "RTN","BIREPF1",60,0) .W !!?10,"This may take some time. Please hold on...",! "RTN","BIREPF1",61,0) ; "RTN","BIREPF1",62,0) ;---> Prepare report. "RTN","BIREPF1",63,0) K ^TMP("BIREPF1",$J),^TMP("BIDUL",$J) "RTN","BIREPF1",64,0) N VALM,VALMHDR "RTN","BIREPF1",65,0) D HDR,START^BIREPF2(BIYEAR,.BICC,.BIHCF,.BICM,.BIBEN,BIFH,BIUP) "RTN","BIREPF1",66,0) ; "RTN","BIREPF1",67,0) D PRTLST^BIUTL8("BIREPF1") "RTN","BIREPF1",68,0) D EXIT,RESET^BIREPF "RTN","BIREPF1",69,0) Q "RTN","BIREPF1",70,0) ; "RTN","BIREPF1",71,0) ; "RTN","BIREPF1",72,0) ;---------- "RTN","BIREPF1",73,0) EN ;EP "RTN","BIREPF1",74,0) ;---> Main entry point for List Template BI REPORT QUARTERLY IMM1. "RTN","BIREPF1",75,0) D EN^VALM("BI REPORT FLU IMM1") "RTN","BIREPF1",76,0) Q "RTN","BIREPF1",77,0) ; "RTN","BIREPF1",78,0) ; "RTN","BIREPF1",79,0) ;---------- "RTN","BIREPF1",80,0) HDR ;EP "RTN","BIREPF1",81,0) ;---> Header code "RTN","BIREPF1",82,0) D HEAD^BIREPF2(BIYEAR,.BICC,.BIHCF,.BICM,.BIBEN,BIFH,BIUP) "RTN","BIREPF1",83,0) Q "RTN","BIREPF1",84,0) ; "RTN","BIREPF1",85,0) ; "RTN","BIREPF1",86,0) ;---------- "RTN","BIREPF1",87,0) INIT ;EP "RTN","BIREPF1",88,0) ;---> Initialize variables and list array. "RTN","BIREPF1",89,0) K ^TMP("BIREPF1",$J),^TMP("BIDUL",$J) "RTN","BIREPF1",90,0) S VALM("TITLE")=$$LMVER^BILOGO "RTN","BIREPF1",91,0) S VALMSG="To view patient rosters, select a group below:" "RTN","BIREPF1",92,0) W !!?10,"This may take some time. Please hold on...",! "RTN","BIREPF1",93,0) D START^BIREPF2(BIYEAR,.BICC,.BIHCF,.BICM,.BIBEN,BIFH,BIUP) "RTN","BIREPF1",94,0) ;---> Set up ZTSAVE in case user Queues from PL in List. "RTN","BIREPF1",95,0) D ZSAVES^BIUTL3 "RTN","BIREPF1",96,0) Q "RTN","BIREPF1",97,0) ; "RTN","BIREPF1",98,0) ; "RTN","BIREPF1",99,0) ;---------- "RTN","BIREPF1",100,0) RESET ;EP "RTN","BIREPF1",101,0) ;---> Update partition for return to Listmanager. "RTN","BIREPF1",102,0) I $D(VALMQUIT) S VALMBCK="Q" Q "RTN","BIREPF1",103,0) D TERM^VALM0 S VALMBCK="R" "RTN","BIREPF1",104,0) D INIT,HDR "RTN","BIREPF1",105,0) Q "RTN","BIREPF1",106,0) ; "RTN","BIREPF1",107,0) ; "RTN","BIREPF1",108,0) ;---------- "RTN","BIREPF1",109,0) RESET1 ;EP "RTN","BIREPF1",110,0) ;---> Update partition for return to Listmanager. "RTN","BIREPF1",111,0) I $D(VALMQUIT) S VALMBCK="Q" Q "RTN","BIREPF1",112,0) D TERM^VALM0 S VALMBCK="R" "RTN","BIREPF1",113,0) S VALM("TITLE")=$$LMVER^BILOGO "RTN","BIREPF1",114,0) S VALMSG="To view patient lists, select a group below:" "RTN","BIREPF1",115,0) D HDR "RTN","BIREPF1",116,0) Q "RTN","BIREPF1",117,0) ; "RTN","BIREPF1",118,0) ; "RTN","BIREPF1",119,0) ;---------- "RTN","BIREPF1",120,0) HELP ;EP "RTN","BIREPF1",121,0) N BIX S BIX=X "RTN","BIREPF1",122,0) D FULL^VALM1 N BIPOP "RTN","BIREPF1",123,0) D TITLE^BIUTL5("INFLUENZA REPORT - HELP, page 1 of 1") "RTN","BIREPF1",124,0) D TEXT1,DIRZ^BIUTL3() "RTN","BIREPF1",125,0) D:BIX'="??" RE^VALM4 "RTN","BIREPF1",126,0) Q "RTN","BIREPF1",127,0) ; "RTN","BIREPF1",128,0) ; "RTN","BIREPF1",129,0) ;---------- "RTN","BIREPF1",130,0) TEXT1 ;EP "RTN","BIREPF1",131,0) ;;You have chosen to View the Influenza Report rather than Print it. "RTN","BIREPF1",132,0) ;;(You may print the report from here as well by entering "PL".) "RTN","BIREPF1",133,0) ;; "RTN","BIREPF1",134,0) ;;Also, you may: "RTN","BIREPF1",135,0) ;; "RTN","BIREPF1",136,0) ;;Enter "N" to view the list of Patients who were NOT Current "RTN","BIREPF1",137,0) ;; or "NOT up-to-date" with their immunizations, according "RTN","BIREPF1",138,0) ;; to recommendeded guidelines for their age. "RTN","BIREPF1",139,0) ;; "RTN","BIREPF1",140,0) ;;Enter "C" to view the list of Patients who were CURRENT or "RTN","BIREPF1",141,0) ;; "up-to-date" with their immunizations, according to "RTN","BIREPF1",142,0) ;; recommendeded guidelines for their age. "RTN","BIREPF1",143,0) ;; "RTN","BIREPF1",144,0) ;;Enter "B" to view a list of both groups of patients combined. "RTN","BIREPF1",145,0) ;; "RTN","BIREPF1",146,0) ;; "RTN","BIREPF1",147,0) D PRINTX("TEXT1") "RTN","BIREPF1",148,0) Q "RTN","BIREPF1",149,0) ; "RTN","BIREPF1",150,0) ; "RTN","BIREPF1",151,0) ;---------- "RTN","BIREPF1",152,0) EXIT ;EP "RTN","BIREPF1",153,0) ;---> Cleanup, EOJ. "RTN","BIREPF1",154,0) K ^TMP("BIREPF1",$J),^TMP("BIDUL",$J) "RTN","BIREPF1",155,0) D CLEAR^VALM1 "RTN","BIREPF1",156,0) D FULL^VALM1 "RTN","BIREPF1",157,0) Q "RTN","BIREPF1",158,0) ; "RTN","BIREPF1",159,0) ; "RTN","BIREPF1",160,0) ;---------- "RTN","BIREPF1",161,0) DEVICE(BIPOP) ;EP "RTN","BIREPF1",162,0) ;---> Get Device and possibly queue to Taskman. "RTN","BIREPF1",163,0) ;---> Parameters: "RTN","BIREPF1",164,0) ; 1 - BIPOP (ret) If error or Queue, BIPOP=1 "RTN","BIREPF1",165,0) ; "RTN","BIREPF1",166,0) K %ZIS,IOP S BIPOP=0 "RTN","BIREPF1",167,0) S ZTRTN="DEQUEUE^BIREPF1" "RTN","BIREPF1",168,0) D ZSAVES^BIUTL3 "RTN","BIREPF1",169,0) D ZIS^BIUTL2(.BIPOP,1) "RTN","BIREPF1",170,0) Q "RTN","BIREPF1",171,0) ; "RTN","BIREPF1",172,0) ; "RTN","BIREPF1",173,0) ;---------- "RTN","BIREPF1",174,0) DEQUEUE ;EP "RTN","BIREPF1",175,0) ; "RTN","BIREPF1",176,0) ;---> Prepare and print Quarterly Report. "RTN","BIREPF1",177,0) K VALMHDR,^TMP("BIREPF1",$J) "RTN","BIREPF1",178,0) ; "RTN","BIREPF1",179,0) ;********** PATCH 1, v8.4, AUG 01,2010, IHS/CMI/MWR "RTN","BIREPF1",180,0) ;---> Include Flu/H1N1 parameter for body of report when queued. "RTN","BIREPF1",181,0) ;D HDR^BIREPF1,START^BIREPF2(BIYEAR,.BICC,.BIHCF,.BICM,.BIBEN) "RTN","BIREPF1",182,0) D HDR^BIREPF1,START^BIREPF2(BIYEAR,.BICC,.BIHCF,.BICM,.BIBEN,BIFH,BIUP) "RTN","BIREPF1",183,0) ;********** "RTN","BIREPF1",184,0) ; "RTN","BIREPF1",185,0) D PRTLST^BIUTL8("BIREPF1"),EXIT "RTN","BIREPF1",186,0) Q "RTN","BIREPF1",187,0) ; "RTN","BIREPF1",188,0) ; "RTN","BIREPF1",189,0) ;---------- "RTN","BIREPF1",190,0) PRINTX(BILINL,BITAB) ;EP "RTN","BIREPF1",191,0) Q:$G(BILINL)="" "RTN","BIREPF1",192,0) N I,T,X S T="" S:'$D(BITAB) BITAB=5 F I=1:1:BITAB S T=T_" " "RTN","BIREPF1",193,0) F I=1:1 S X=$T(@BILINL+I) Q:X'[";;" W !,T,$P(X,";;",2) "RTN","BIREPF1",194,0) Q "RTN","BIREPF1",195,0) ; "RTN","BIREPF1",196,0) ; "RTN","BIREPF1",197,0) ;---------- "RTN","BIREPF1",198,0) ERROR(BIERR) ;EP "RTN","BIREPF1",199,0) ;---> Report error, either to screen or print. "RTN","BIREPF1",200,0) ;---> Parameters: "RTN","BIREPF1",201,0) ; 1 - BIERR (ret) Text of Error Code if any, otherwise null. "RTN","BIREPF1",202,0) ; "RTN","BIREPF1",203,0) D ERRCD^BIUTL2($G(BIERR),,1) S BIPOP=1 "RTN","BIREPF1",204,0) Q "RTN","BIREPF2") 0^8^B40474505 "RTN","BIREPF2",1,0) BIREPF2 ;IHS/CMI/MWR - REPORT, FLU IMM; AUG 10,2010 "RTN","BIREPF2",2,0) ;;8.5;IMMUNIZATION;**5,31**;OCT 24,2011;Build 137 "RTN","BIREPF2",3,0) ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS * "RTN","BIREPF2",4,0) ;; VIEW INFLUENZA IMMUNIZATION REPORT, GATHER DATA. "RTN","BIREPF2",5,0) ;; PATCH 1: Add "Dose#" header to Doses column. HEAD+86 "RTN","BIREPF2",6,0) ;; PATCH 5: Display new beginning date as July 1. HEAD+38 "RTN","BIREPF2",7,0) ; "RTN","BIREPF2",8,0) ; "RTN","BIREPF2",9,0) ;---------- "RTN","BIREPF2",10,0) HEAD(BIYEAR,BICC,BIHCF,BICM,BIBEN,BIFH,BIUP) ;EP "RTN","BIREPF2",11,0) ;---> Produce Header array for Quarterly Immunization Report. "RTN","BIREPF2",12,0) ;---> Parameters: "RTN","BIREPF2",13,0) ; 1 - BIYEAR (req) Report Year. "RTN","BIREPF2",14,0) ; 2 - BICC (req) Current Community array. "RTN","BIREPF2",15,0) ; 3 - BIHCF (req) Health Care Facility array. "RTN","BIREPF2",16,0) ; 4 - BICM (req) Case Manager array. "RTN","BIREPF2",17,0) ; 5 - BIBEN (req) Beneficiary Type array. "RTN","BIREPF2",18,0) ; 6 - BIFH (opt) F=report on Flu Vaccine Group (default), H=H1N1 group. "RTN","BIREPF2",19,0) ; 7 - BIUP (req) User Population/Group (Registered, Imm, User, Active). "RTN","BIREPF2",20,0) ; "RTN","BIREPF2",21,0) ;---> Check for required Variables. "RTN","BIREPF2",22,0) Q:'$G(BIYEAR) "RTN","BIREPF2",23,0) Q:'$D(BICC) "RTN","BIREPF2",24,0) Q:'$D(BIHCF) "RTN","BIREPF2",25,0) Q:'$D(BICM) "RTN","BIREPF2",26,0) Q:'$D(BIBEN) "RTN","BIREPF2",27,0) S:($G(BIFH)="") BIFH="F" "RTN","BIREPF2",28,0) Q:'$D(BIUP) "RTN","BIREPF2",29,0) ; "RTN","BIREPF2",30,0) K VALMHDR "RTN","BIREPF2",31,0) N BILINE,X S BILINE=0 "RTN","BIREPF2",32,0) ; "RTN","BIREPF2",33,0) N X S X="" "RTN","BIREPF2",34,0) ;---> If Header array is NOT being for Listmananger include version. vvv83 "RTN","BIREPF2",35,0) S:'$D(VALM("BM")) X=$$LMVER^BILOGO() "RTN","BIREPF2",36,0) ; "RTN","BIREPF2",37,0) I BISPD'="CSV" D WH^BIW(.BILINE,X) "RTN","BIREPF2",38,0) S X=$$REPHDR^BIUTL6(DUZ(2)) I BISPD'="CSV" D CENTERT^BIUTL5(.X) "RTN","BIREPF2",39,0) D WH^BIW(.BILINE,X) "RTN","BIREPF2",40,0) ; "RTN","BIREPF2",41,0) S X="* "_$S($G(BIFH)="H":"H1N1",1:"Standard Flu")_" Immunization Report *" "RTN","BIREPF2",42,0) I BISPD'="CSV" D CENTERT^BIUTL5(.X) "RTN","BIREPF2",43,0) D WH^BIW(.BILINE,X) "RTN","BIREPF2",44,0) ; "RTN","BIREPF2",45,0) S:BISPD'="CSV" X=$$SP^BIUTL5(27)_"Report Date: "_$$SLDT1^BIUTL5(DT) S:BISPD="CSV" X="Report Date: "_$$SLDT1^BIUTL5(DT) "RTN","BIREPF2",46,0) D WH^BIW(.BILINE,X) "RTN","BIREPF2",47,0) ; "RTN","BIREPF2",48,0) ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR "RTN","BIREPF2",49,0) ;---> Display new beginning date as July 1. "RTN","BIREPF2",50,0) ;N BIBEG,BIEND S BIBEG="09/15/"_$P(BIYEAR,U) "RTN","BIREPF2",51,0) N BIBEG,BIEND S BIBEG="07/01/"_$P(BIYEAR,U) "RTN","BIREPF2",52,0) ;********** "RTN","BIREPF2",53,0) D "RTN","BIREPF2",54,0) .I $P(BIYEAR,U,2)="m" S BIEND="03/31/"_($P(BIYEAR,U)+1) Q "RTN","BIREPF2",55,0) .S BIEND="12/31/"_$P(BIYEAR,U) "RTN","BIREPF2",56,0) S:BISPD'="CSV" X=$$SP^BIUTL5(28)_"Date Range: "_BIBEG_" - "_BIEND S:BISPD="CSV" X="Date Range: "_BIBEG_" - "_BIEND "RTN","BIREPF2",57,0) D WH^BIW(.BILINE,X,1) "RTN","BIREPF2",58,0) ; "RTN","BIREPF2",59,0) S X=" "_$$BIUPTX^BIUTL6(BIUP),X=$$PAD^BIUTL5(X,48) "RTN","BIREPF2",60,0) D WH^BIW(.BILINE,X) "RTN","BIREPF2",61,0) ; "RTN","BIREPF2",62,0) I BISPD'="CSV" D WH^BIW(.BILINE,$$SP^BIUTL5(79,"-")) "RTN","BIREPF2",63,0) ; "RTN","BIREPF2",64,0) D "RTN","BIREPF2",65,0) .;---> If specific Communities were selected (not ALL), then print "RTN","BIREPF2",66,0) .;---> the Communities in a subheader at the top of the report. "RTN","BIREPF2",67,0) .D SUBH^BIOUTPT5("BICC","Community",,"^AUTTCOM(",.BILINE,.BIERR,,12) "RTN","BIREPF2",68,0) .I $G(BIERR) D ERRCD^BIUTL2(BIERR,.X) D WH^BIW(.BILINE,X) Q "RTN","BIREPF2",69,0) .; "RTN","BIREPF2",70,0) .;---> If specific Health Care Facilities, print subheader. "RTN","BIREPF2",71,0) .D SUBH^BIOUTPT5("BIHCF","Facility",,"^DIC(4,",.BILINE,.BIERR,,12) "RTN","BIREPF2",72,0) .I $G(BIERR) D ERRCD^BIUTL2(BIERR,.X) D WH^BIW(.BILINE,X) Q "RTN","BIREPF2",73,0) .; "RTN","BIREPF2",74,0) .;---> If specific Case Managers, print Case Manager subheader. "RTN","BIREPF2",75,0) .D SUBH^BIOUTPT5("BICM","Case Manager",,"^VA(200,",.BILINE,.BIERR,,12) "RTN","BIREPF2",76,0) .I $G(BIERR) D ERRCD^BIUTL2(BIERR,.X) D WH^BIW(.BILINE,X) Q "RTN","BIREPF2",77,0) .; "RTN","BIREPF2",78,0) .;---> If specific Beneficiary Types, print Beneficiary Type subheader. "RTN","BIREPF2",79,0) .D SUBH^BIOUTPT5("BIBEN","Beneficiary Type",,"^AUTTBEN(",.BILINE,.BIERR,,12) "RTN","BIREPF2",80,0) .I $G(BIERR) D ERRCD^BIUTL2(BIERR,.X) D WH^BIW(.BILINE,X) Q "RTN","BIREPF2",81,0) .; "RTN","BIREPF2",82,0) .I BISPD'="CSV" D "RTN","BIREPF2",83,0) ..S X=$$SP^BIUTL5(13)_"|"_$$SP^BIUTL5(4)_" Age in months/years on " "RTN","BIREPF2",84,0) ..S X=X_$$SLDT2^BIUTL5((BIYEAR-1700)_1231)_$$SP^BIUTL5(12)_"|" "RTN","BIREPF2",85,0) .D WH^BIW(.BILINE,X) "RTN","BIREPF2",86,0) .; "RTN","BIREPF2",87,0) .;********** PATCH 1, v8.4, AUG 01,2010, IHS/CMI/MWR "RTN","BIREPF2",88,0) .;---> Add "Dose#" header to Doses column. "RTN","BIREPF2",89,0) .;S X=$$SP^BIUTL5(13)_"|"_$$SP^BIUTL5(55,"-")_"| Totals" "RTN","BIREPF2",90,0) .;for csv output only "RTN","BIREPF2",91,0) .I BISPD="CSV" D "RTN","BIREPF2",92,0) ..S X="*NOTE: The 18-49hr column tallies patients who are High Risk in that Age Group." D WH^BIW(.BILINE,X) "RTN","BIREPF2",93,0) ..S X="They are not included in the normal 18-49y column." D WH^BIW(.BILINE,X) S X=" " D WH^BIW(.BILINE,X) "RTN","BIREPF2",94,0) .I BISPD'="CSV" S X=" Dose# |"_$$SP^BIUTL5(55,"-")_"| Totals" "RTN","BIREPF2",95,0) .I BISPD="CSV" S X="Dose #" "RTN","BIREPF2",96,0) .;********** "RTN","BIREPF2",97,0) .; "RTN","BIREPF2",98,0) .D WH^BIW(.BILINE,X) "RTN","BIREPF2",99,0) .I BISPD'="CSV" D "RTN","BIREPF2",100,0) ..S X=" | 10-23m 2-4y 5-17y 18-49y *18-49hr 50-64y 65+yrs" "RTN","BIREPF2",101,0) ..S X=$$PAD^BIUTL5(X,69)_"|" "RTN","BIREPF2",102,0) .I BISPD="CSV" S X="Age in months/years on "_$$SLDT2^BIUTL5((BIYEAR-1700)_1231)_",10-23m,2-4y,5-17y,18-49y,*18-49hr,50-64y,65+yrs,Totals" "RTN","BIREPF2",103,0) .D WH^BIW(.BILINE,X) "RTN","BIREPF2",104,0) ; "RTN","BIREPF2",105,0) ;---> If Header array is being built for Listmananger, "RTN","BIREPF2",106,0) ;---> reset display window margins for Communities, etc. "RTN","BIREPF2",107,0) D:$D(VALM("BM")) "RTN","BIREPF2",108,0) .S VALM("TM")=BILINE+3 "RTN","BIREPF2",109,0) .S VALM("LINES")=VALM("BM")-VALM("TM")+1 "RTN","BIREPF2",110,0) .;---> Safeguard to prevent divide/0 error. "RTN","BIREPF2",111,0) .S:VALM("LINES")<1 VALM("LINES")=1 "RTN","BIREPF2",112,0) Q "RTN","BIREPF2",113,0) ; "RTN","BIREPF2",114,0) ; "RTN","BIREPF2",115,0) ;---------- "RTN","BIREPF2",116,0) START(BIYEAR,BICC,BIHCF,BICM,BIBEN,BIFH,BIUP) ;EP "RTN","BIREPF2",117,0) ;---> Produce array for Quarterly Immunization Report. "RTN","BIREPF2",118,0) ;---> Parameters: "RTN","BIREPF2",119,0) ; 1 - BIYEAR (req) Report Year^m (if 2nd pc="m", then End Date=March 31 of "RTN","BIREPF2",120,0) ; the report year; otherwise End Date=Dec 31 of BIYEAR) "RTN","BIREPF2",121,0) ; 2 - BICC (req) Current Community array. "RTN","BIREPF2",122,0) ; 3 - BIHCF (req) Health Care Facility array. "RTN","BIREPF2",123,0) ; 4 - BICM (req) Case Manager array. "RTN","BIREPF2",124,0) ; 5 - BIBEN (req) Beneficiary Type array. "RTN","BIREPF2",125,0) ; 6 - BIFH (opt) F=report on Flu Vaccine Group (default), H=H1N1 group. "RTN","BIREPF2",126,0) ; 7 - BIUP (req) User Population/Group (Registered, Imm, User, Active). "RTN","BIREPF2",127,0) ; "RTN","BIREPF2",128,0) K ^TMP("BIREPF1",$J) "RTN","BIREPF2",129,0) N BILINE,BITMP,X S BILINE=0,BIPOP=0 "RTN","BIREPF2",130,0) ; "RTN","BIREPF2",131,0) ;---> Check for required Variables. "RTN","BIREPF2",132,0) ; "RTN","BIREPF2",133,0) I '$G(BIYEAR) D ERRCD^BIUTL2(679,.X) D WRITERR(BILINE,X) Q "RTN","BIREPF2",134,0) I '$D(BICC) D ERRCD^BIUTL2(614,.X) D WRITERR(BILINE,X) Q "RTN","BIREPF2",135,0) I '$D(BIHCF) D ERRCD^BIUTL2(625,.X) D WRITERR(BILINE,X) Q "RTN","BIREPF2",136,0) I '$D(BICM) D ERRCD^BIUTL2(615,.X) D WRITERR(BILINE,X) Q "RTN","BIREPF2",137,0) I '$D(BIBEN) D ERRCD^BIUTL2(662,.X) D WRITERR(BILINE,X) Q "RTN","BIREPF2",138,0) S:($G(BIFH)="") BIFH="F" "RTN","BIREPF2",139,0) S:$G(BIUP)="" BIUP="u" "RTN","BIREPF2",140,0) ; "RTN","BIREPF2",141,0) ;---> Write Age Totals line. "RTN","BIREPF2",142,0) D AGETOT^BIREPF3(.BILINE,.BICC,.BIHCF,.BICM,.BIBEN,BIYEAR,.BIPOP,BIFH,BIUP) "RTN","BIREPF2",143,0) Q:BIPOP "RTN","BIREPF2",144,0) ; "RTN","BIREPF2",145,0) ;---> Write Approp for Age and Vaccine Group lines. "RTN","BIREPF2",146,0) ;D APPROP^BIREPF3(.BILINE) "RTN","BIREPF2",147,0) ; "RTN","BIREPF2",148,0) ;---> Write Statistics lines for each Vaccine Group (BIVGRP). "RTN","BIREPF2",149,0) ;F BIVGRP=1,2,6,3,4,7,9,11,15 D VGRP^BIREPF3(.BILINE,BIVGRP) "RTN","BIREPF2",150,0) ;---> If report is for H1N1, then display vaccine group 18; otherwise Flu (10). "RTN","BIREPF2",151,0) S BIVGRP=$S(BIFH="H":18,1:10) "RTN","BIREPF2",152,0) D VGRP^BIREPF3(.BILINE,BIVGRP,BIYEAR) "RTN","BIREPF2",153,0) ; "RTN","BIREPF2",154,0) ;---> For Flu Report (not H1N1) write Approp for Age and Vaccine Group lines. "RTN","BIREPF2",155,0) D:BIVGRP=10 APPROP^BIREPF3(.BILINE) "RTN","BIREPF2",156,0) ; "RTN","BIREPF2",157,0) ;---> Now write total patients considered who had refusals. "RTN","BIREPF2",158,0) N M,N S (M,N)=0 F S M=$O(BITMP("REFUSALS",M)) Q:'M S N=N+1 "RTN","BIREPF2",159,0) I BISPD'="CSV" S X=" Total Patients included who had Influenza Refusals on record"_$J(N,15) "RTN","BIREPF2",160,0) I BISPD="CSV" S X="Total Patients included who had Influenza Refusals on record,"_N D WRITE^BIREPF3(.BILINE," "),WRITE^BIREPF3(.BILINE," ") "RTN","BIREPF2",161,0) D WRITE^BIREPF3(.BILINE,X) I BISPD'="CSV" D WRITE^BIREPF3(.BILINE,$$SP^BIUTL5(79,"-")) "RTN","BIREPF2",162,0) ; "RTN","BIREPF2",163,0) I BISPD'="CSV" D "RTN","BIREPF2",164,0) .S X=" *NOTE: The 18-49hr column tallies patients who are High Risk in that" "RTN","BIREPF2",165,0) .D WRITE^BIREPF3(.BILINE,X) "RTN","BIREPF2",166,0) .S X=" Age Group. They are not included in the normal 18-49y column." "RTN","BIREPF2",167,0) .D WRITE^BIREPF3(.BILINE,X),WRITE^BIREPF3(.BILINE,$$SP^BIUTL5(79,"-")) "RTN","BIREPF2",168,0) ; "RTN","BIREPF2",169,0) S VALMCNT=BILINE "RTN","BIREPF2",170,0) Q "RTN","BIREPF2",171,0) ; "RTN","BIREPF2",172,0) ; "RTN","BIREPF2",173,0) ;---------- "RTN","BIREPF2",174,0) WRITERR(BILINE,X) ;EP "RTN","BIREPF2",175,0) ;---> Write error line to report. "RTN","BIREPF2",176,0) ;---> Parameters: "RTN","BIREPF2",177,0) ; 1 - BILINE (ret) Last line# written. "RTN","BIREPF2",178,0) ; 2 - BIVAL (req) Error text. "RTN","BIREPF2",179,0) ; "RTN","BIREPF2",180,0) S:'$D(X) X="No error text." "RTN","BIREPF2",181,0) S:'$D(BILINE) BILINE=1 "RTN","BIREPF2",182,0) D WRITE^BIREPF3(.BILINE,X) S VALMCNT=BILINE "RTN","BIREPF2",183,0) Q "RTN","BIREPF3") 0^9^B40713205 "RTN","BIREPF3",1,0) BIREPF3 ;IHS/CMI/MWR - REPORT, FLU IMM; MAY 10, 2010 "RTN","BIREPF3",2,0) ;;8.5;IMMUNIZATION;**31**;OCT 24,2011;Build 137 "RTN","BIREPF3",3,0) ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS * "RTN","BIREPF3",4,0) ;; VIEW INFLUENZA IMMUNIZATION REPORT. "RTN","BIREPF3",5,0) ; "RTN","BIREPF3",6,0) ; "RTN","BIREPF3",7,0) ;---------- "RTN","BIREPF3",8,0) AGETOT(BILINE,BICC,BIHCF,BICM,BIBEN,BIYEAR,BIPOP,BIFH,BIUP) ;EP "RTN","BIREPF3",9,0) ;---> Write Age Total line. "RTN","BIREPF3",10,0) ;---> Parameters: "RTN","BIREPF3",11,0) ; 1 - BILINE (req) Line number in ^TMP Listman array. "RTN","BIREPF3",12,0) ; 2 - BICC (req) Current Community array. "RTN","BIREPF3",13,0) ; 3 - BIHCF (req) Health Care Facility array. "RTN","BIREPF3",14,0) ; 4 - BICM (req) Case Manager array. "RTN","BIREPF3",15,0) ; 5 - BIBEN (req) Beneficiary Type array. "RTN","BIREPF3",16,0) ; 6 - BIYEAR (req) Report Year^m (if 2nd pc="m", then End Date=March 31 of "RTN","BIREPF3",17,0) ; the report year; otherwise End Date=Dec 31 of BIYEAR) "RTN","BIREPF3",18,0) ; 7 - BIPOP (ret) BIPOP=1 if error. "RTN","BIREPF3",19,0) ; 8 - BIFH (opt) F=report on Flu Vaccine Group (default), H=H1N1 group. "RTN","BIREPF3",20,0) ; 9 - BIUP (req) User Population/Group (Registered, Imm, User, Active). "RTN","BIREPF3",21,0) ; "RTN","BIREPF3",22,0) S BIPOP=0 "RTN","BIREPF3",23,0) S:($G(BIFH)="") BIFH="F" "RTN","BIREPF3",24,0) S:$G(BIUP)="" BIUP="u" "RTN","BIREPF3",25,0) ;---> Check for required Variables. "RTN","BIREPF3",26,0) I '$G(BIYEAR) D ERRCD^BIUTL2(679,.X) D WRITERR^BIREPF2(BILINE,X) S BIPOP=1 Q "RTN","BIREPF3",27,0) N BIQDT S BIQDT=(BIYEAR-1700)_1231 "RTN","BIREPF3",28,0) ; "RTN","BIREPF3",29,0) ;---> Gather and sort patients. "RTN","BIREPF3",30,0) N N S N=0 "RTN","BIREPF3",31,0) F I="10-23","24-59","60-215","216-599","600-779","780-1500" D "RTN","BIREPF3",32,0) .;---> For each age range, get Begin and End Dates (DOB's). "RTN","BIREPF3",33,0) .D AGEDATE^BIAGE(I,BIQDT,.BIBEGDT,.BIENDDT) "RTN","BIREPF3",34,0) .;---> Leave an Age Group=5 for High Risk (subset of Group 4 "RTN","BIREPF3",35,0) .S N=N+1 S:(N=5) N=6 "RTN","BIREPF3",36,0) .D GETPATS^BIREPF4(BIBEGDT,BIENDDT,N,.BICC,.BIHCF,.BICM,.BIBEN,BIQDT,BIFH,BIYEAR,BIUP) "RTN","BIREPF3",37,0) ; "RTN","BIREPF3",38,0) ;---> Count patients. "RTN","BIREPF3",39,0) N BIAGRP,BITOT S BITOT=0 "RTN","BIREPF3",40,0) F I=1:1:7 D "RTN","BIREPF3",41,0) .N M,N S M=0,N=0,BIAGRP(I)=0 "RTN","BIREPF3",42,0) .F S N=$O(^TMP("BIREPF1",$J,"PATS",I,N)) Q:'N D "RTN","BIREPF3",43,0) ..;---> Yes, now include Age Group 5 (18-49 High Risk) in Totals. "RTN","BIREPF3",44,0) ..;S BIAGRP(I)=BIAGRP(I)+1 S:(I'=5) BITOT=BITOT+1 "RTN","BIREPF3",45,0) ..S BIAGRP(I)=BIAGRP(I)+1 S BITOT=BITOT+1 "RTN","BIREPF3",46,0) .S BITMP("STATS","TOTAL",I)=BIAGRP(I) "RTN","BIREPF3",47,0) S BITMP("STATS","TOTAL","ALL")=BITOT "RTN","BIREPF3",48,0) ; "RTN","BIREPF3",49,0) ;---> Write Age Totals line. "RTN","BIREPF3",50,0) ;N X S X=" # in Age |" "RTN","BIREPF3",51,0) N X S:BISPD'="CSV" X=" Denominator |" S:BISPD="CSV" X="Denominator," "RTN","BIREPF3",52,0) ;X ^O "RTN","BIREPF3",53,0) I BISPD'="CSV" D "RTN","BIREPF3",54,0) .F I=1:1:7 S X=X_$J($G(BIAGRP(I)),6)_" " "RTN","BIREPF3",55,0) .S X=$E(X,1,$L(X)-2)_" |"_$J(BITOT,7) "RTN","BIREPF3",56,0) I BISPD="CSV" D "RTN","BIREPF3",57,0) .F I=1:1:7 S X=X_+$G(BIAGRP(I))_"," "RTN","BIREPF3",58,0) .S X=X_+BITOT_"," "RTN","BIREPF3",59,0) D WRITE(.BILINE,X) "RTN","BIREPF3",60,0) I BISPD'="CSV" D WRITE(.BILINE,$$SP^BIUTL5(79,"-")) "RTN","BIREPF3",61,0) Q "RTN","BIREPF3",62,0) ; "RTN","BIREPF3",63,0) ; "RTN","BIREPF3",64,0) ;---------- "RTN","BIREPF3",65,0) VGRP(BILINE,BIVGRP,BIYEAR) ;EP "RTN","BIREPF3",66,0) ;---> Write Stats lines for each Vaccine Group. "RTN","BIREPF3",67,0) ;---> Parameters: "RTN","BIREPF3",68,0) ; 1 - BILINE (req) Line number in ^TMP Listman array. "RTN","BIREPF3",69,0) ; 2 - BIVGRP (req) IEN of Vaccine Group. "RTN","BIREPF3",70,0) ; 3 - BIYEAR (req) Report Year. "RTN","BIREPF3",71,0) ; "RTN","BIREPF3",72,0) ;---> Write a line for each Dose of this Vaccine Group. "RTN","BIREPF3",73,0) ;N BIDOSE,BIMAXD S BIMAXD=$$VGROUP^BIUTL2(BIVGRP,6) "RTN","BIREPF3",74,0) N BIDOSE,BIMAXD S BIMAXD=1 "RTN","BIREPF3",75,0) ;---> For H1N1 Report display 2 doses. "RTN","BIREPF3",76,0) S:BIVGRP=18 BIMAXD=2 "RTN","BIREPF3",77,0) F BIDOSE=1:1:BIMAXD D "RTN","BIREPF3",78,0) .; "RTN","BIREPF3",79,0) .;---> *** WRITE DOSE 1 LINE: "RTN","BIREPF3",80,0) .;---> BIX=text of the line to write. "RTN","BIREPF3",81,0) .;---> Write the Dose#-Vaccine Group in left margin. "RTN","BIREPF3",82,0) .N BIX "RTN","BIREPF3",83,0) .I BISPD'="CSV" S BIX=" "_BIDOSE_"-"_$$VGROUP^BIUTL2(BIVGRP,5) S BIX=$$PAD^BIUTL5(BIX,13)_"|" "RTN","BIREPF3",84,0) .I BISPD="CSV" S:'$G(BIYEAR) BIYEAR="YYYY" S BIX=BIDOSE_"-"_$$VGROUP^BIUTL2(BIVGRP,5)_" "_+BIYEAR_" Season #"_"," "RTN","BIREPF3",85,0) .; "RTN","BIREPF3",86,0) .;---> Now loop through the Age Groups, concating subtotals. "RTN","BIREPF3",87,0) .N BIAGRP,BISUBT S BISUBT=0 "RTN","BIREPF3",88,0) .F BIAGRP=1:1:7 D "RTN","BIREPF3",89,0) ..;---> BITMP(Vaccine Grp, CURRENT Season, Dose, Age Grp) "RTN","BIREPF3",90,0) ..N Y S Y=+$G(BITMP("STATS",BIVGRP,1,BIDOSE,BIAGRP)) "RTN","BIREPF3",91,0) ..;---> Write stats for each Age Group, but don't include 5 in total. "RTN","BIREPF3",92,0) ..;S BIX=BIX_$J(Y,6)_" " S:(BIAGRP'=5) BISUBT=BISUBT+Y "RTN","BIREPF3",93,0) ..;---> Yes, now include Age Group 5 (18-49 High Risk) in Totals. "RTN","BIREPF3",94,0) ..S BIX=$S(BISPD'="CSV":BIX_$J(Y,6)_" ",1:BIX_+Y_",") S BISUBT=BISUBT+Y "RTN","BIREPF3",95,0) .; "RTN","BIREPF3",96,0) .S BIX=$S(BISPD'="CSV":$E(BIX,1,$L(BIX)-2)_" |"_$J(BISUBT,7),1:BIX_+BISUBT_",") "RTN","BIREPF3",97,0) .D WRITE(.BILINE,BIX) "RTN","BIREPF3",98,0) .I BIDOSE=1 D MARK^BIW(BILINE,BIMAXD+2,"BIREPF1") "RTN","BIREPF3",99,0) .; "RTN","BIREPF3",100,0) .;---> *** NOW WRITE PERCENTAGES LINE: "RTN","BIREPF3",101,0) .;---> BIX=text of the line to write. "RTN","BIREPF3",102,0) .;---> Write "YYYY Season" in left margin. "RTN","BIREPF3",103,0) .S:'$G(BIYEAR) BIYEAR="YYYY" "RTN","BIREPF3",104,0) .K BIX N BIX "RTN","BIREPF3",105,0) .I BISPD'="CSV" S BIX=" "_+BIYEAR_" Season " S BIX=$$PAD^BIUTL5(BIX,13)_"|" "RTN","BIREPF3",106,0) .I BISPD="CSV" S BIX=BIDOSE_"-"_$$VGROUP^BIUTL2(BIVGRP,5)_" "_+BIYEAR_" Season %"_"," "RTN","BIREPF3",107,0) .; "RTN","BIREPF3",108,0) .;---> Now loop through the Age Groups, writing percentages. "RTN","BIREPF3",109,0) .F BIAGRP=1:1:7 D "RTN","BIREPF3",110,0) ..;---> BITMP(Vaccine Grp, CURRENT Season, Dose, Age Grp) "RTN","BIREPF3",111,0) ..N Y S Y=$G(BITMP("STATS",BIVGRP,1,BIDOSE,BIAGRP)) S:Y="" Y=0 "RTN","BIREPF3",112,0) ..N Z S Z=$G(BITMP("STATS","TOTAL",BIAGRP)) S:'Z Y=0,Z=1 "RTN","BIREPF3",113,0) ..I BISPD'="CSV" S BIX=BIX_" "_$J((100*Y/Z),3,0)_"% " "RTN","BIREPF3",114,0) ..I BISPD="CSV" S BIX=BIX_$$STRIP^XLFSTR($J((100*Y/Z),3,0)," ")_"," "RTN","BIREPF3",115,0) .; "RTN","BIREPF3",116,0) .;---> Now write total percentage. "RTN","BIREPF3",117,0) .N Y S Y=BISUBT S:Y="" Y=0 "RTN","BIREPF3",118,0) .N Z S Z=$G(BITMP("STATS","TOTAL","ALL")) S:'Z Y=0,Z=1 "RTN","BIREPF3",119,0) .I BISPD'="CSV" S BIX=$$PAD^BIUTL5(BIX,69)_"| "_$J((100*Y/Z),3,0)_"%" "RTN","BIREPF3",120,0) .I BISPD="CSV" S BIX=BIX_$$STRIP^XLFSTR($J((100*Y/Z),3,0)," ")_"," "RTN","BIREPF3",121,0) .D WRITE(.BILINE,BIX) "RTN","BIREPF3",122,0) .;---> If H1N1, write final line (since we won't write a "Fully Immunized" row). "RTN","BIREPF3",123,0) .I BISPD'="CSV" D:BIVGRP=18 WRITE(.BILINE,$$SP^BIUTL5(79,"-")) "RTN","BIREPF3",124,0) ; "RTN","BIREPF3",125,0) ;---> Do not write for H1N1 (since we won't write a "Fully Immunized" row). "RTN","BIREPF3",126,0) I BISPD'="CSV" D:BIVGRP'=18 WRITE(.BILINE,$$SP^BIUTL5(79,"-")) "RTN","BIREPF3",127,0) Q "RTN","BIREPF3",128,0) ; "RTN","BIREPF3",129,0) ; "RTN","BIREPF3",130,0) ;---------- "RTN","BIREPF3",131,0) APPROP(BILINE) ;EP "RTN","BIREPF3",132,0) ;---> Write Appropriate for Age lines. "RTN","BIREPF3",133,0) ;---> Parameters: "RTN","BIREPF3",134,0) ; 1 - BILINE (req) Line number in ^TMP Listman array. "RTN","BIREPF3",135,0) ; "RTN","BIREPF3",136,0) ;---> Numbers of appropriate line. "RTN","BIREPF3",137,0) ;N BITOT,X S BITOT=0,X=" Appropriate |" "RTN","BIREPF3",138,0) N BITOT,X "RTN","BIREPF3",139,0) I BISPD'="CSV" S BITOT=0,X=" Fully |" "RTN","BIREPF3",140,0) I BISPD="CSV" S BITOT=0,X="Fully Immunized #," "RTN","BIREPF3",141,0) F BIAGRP=1:1:7 D "RTN","BIREPF3",142,0) .N Y S Y=$G(BITMP("STATS","APPRO",BIAGRP)) S:Y="" Y=0 "RTN","BIREPF3",143,0) .;---> Yes, now include Age Group 5 (18-49 High Risk) in Totals. "RTN","BIREPF3",144,0) .;S X=X_$J(Y,6)_" " S:(BIAGRP'=5) BITOT=BITOT+Y "RTN","BIREPF3",145,0) .I BISPD'="CSV" S X=X_$J(Y,6)_" " "RTN","BIREPF3",146,0) .I BISPD="CSV" S X=X_+Y_"," "RTN","BIREPF3",147,0) .S BITOT=BITOT+Y "RTN","BIREPF3",148,0) ; "RTN","BIREPF3",149,0) I BISPD'="CSV" S X=$E(X,1,$L(X)-2) S X=$$PAD^BIUTL5(X,69)_"|"_$J(BITOT,7) "RTN","BIREPF3",150,0) I BISPD="CSV" S X=X_BITOT_"," "RTN","BIREPF3",151,0) D WRITE(.BILINE,X) "RTN","BIREPF3",152,0) D MARK^BIW(BILINE,3,"BIREPF1") "RTN","BIREPF3",153,0) ; "RTN","BIREPF3",154,0) ;---> Percentage of appropriate line. "RTN","BIREPF3",155,0) ;S X=" for Age |",BITOT=0 "RTN","BIREPF3",156,0) S X=$S(BISPD'="CSV":" Immunized |",1:"Fully Immunized %,"),BITOT=0 "RTN","BIREPF3",157,0) F BIAGRP=1:1:7 D "RTN","BIREPF3",158,0) .N Y S Y=$G(BITMP("STATS","APPRO",BIAGRP)) S:Y="" Y=0 "RTN","BIREPF3",159,0) .N Z S Z=$G(BITMP("STATS","TOTAL",BIAGRP)) S:'Z Y=0,Z=1 "RTN","BIREPF3",160,0) .N BIPERC "RTN","BIREPF3",161,0) .I BISPD'="CSV" S BIPERC=" "_$J((100*Y/Z),3,0)_"%" S X=X_BIPERC_" " "RTN","BIREPF3",162,0) .S:(BIAGRP'=5) BITOT=BITOT+Y "RTN","BIREPF3",163,0) .I BISPD="CSV" S X=X_$$STRIP^XLFSTR($J((100*Y/Z),3,0)," ")_"," "RTN","BIREPF3",164,0) ; "RTN","BIREPF3",165,0) N Y S Y=BITOT S:Y="" Y=0 "RTN","BIREPF3",166,0) N Z S Z=$G(BITMP("STATS","TOTAL","ALL")) S:'Z Y=0,Z=1 "RTN","BIREPF3",167,0) ;S X=$E(X,1,$L(X)-2)_"| "_$J((100*Y/Z),3,0)_"%" "RTN","BIREPF3",168,0) I BISPD'="CSV" S X=$E(X,1,$L(X)-1) S X=$$PAD^BIUTL5(X,69)_"| "_$J((100*Y/Z),3,0)_"%" "RTN","BIREPF3",169,0) I BISPD="CSV" S X=X_$$STRIP^XLFSTR($J((100*Y/Z),3,0)," ")_"," "RTN","BIREPF3",170,0) D WRITE(.BILINE,X) "RTN","BIREPF3",171,0) I BISPD'="CSV" D WRITE(.BILINE,$$SP^BIUTL5(79,"-")) "RTN","BIREPF3",172,0) Q "RTN","BIREPF3",173,0) ; "RTN","BIREPF3",174,0) ; "RTN","BIREPF3",175,0) ;---------- "RTN","BIREPF3",176,0) WRITE(BILINE,BIVAL,BIBLNK) ;EP "RTN","BIREPF3",177,0) ;---> Write lines to ^TMP (see documentation in ^BIW). "RTN","BIREPF3",178,0) ;---> Parameters: "RTN","BIREPF3",179,0) ; 1 - BILINE (ret) Last line# written. "RTN","BIREPF3",180,0) ; 2 - BIVAL (opt) Value/text of line (Null=blank line). "RTN","BIREPF3",181,0) ; "RTN","BIREPF3",182,0) Q:'$D(BILINE) "RTN","BIREPF3",183,0) D WL^BIW(.BILINE,"BIREPF1",$G(BIVAL),$G(BIBLNK)) "RTN","BIREPF3",184,0) Q "RTN","BIREPL") 0^23^B17722802 "RTN","BIREPL",1,0) BIREPL ;IHS/CMI/MWR - REPORT, ADULT IMM; MAY 10, 2010 "RTN","BIREPL",2,0) ;;8.5;IMMUNIZATION;**26,31**;OCT 24,2011;Build 137 "RTN","BIREPL",3,0) ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS * "RTN","BIREPL",4,0) ;; VIEW ADULT IMMUNIZATION REPORT: PARAMETERS VIEW MENU "RTN","BIREPL",5,0) ; "RTN","BIREPL",6,0) ; "RTN","BIREPL",7,0) ;---------- "RTN","BIREPL",8,0) START ;EP "RTN","BIREPL",9,0) ;---> Listman Screen for printing Immunization Due Letters. "RTN","BIREPL",10,0) D SETVARS^BIUTL5 N BIRTN "RTN","BIREPL",11,0) ; "RTN","BIREPL",12,0) ;---> If Vaccine Table is not standard, display Error Text and quit. "RTN","BIREPL",13,0) I $D(^BISITE(-1)) D ERRCD^BIUTL2(503,,1) Q "RTN","BIREPL",14,0) ; "RTN","BIREPL",15,0) D EN "RTN","BIREPL",16,0) D EXIT "RTN","BIREPL",17,0) Q "RTN","BIREPL",18,0) ; "RTN","BIREPL",19,0) ; "RTN","BIREPL",20,0) ;---------- "RTN","BIREPL",21,0) EN ;EP "RTN","BIREPL",22,0) ;---> Main entry point for BI LETTER PRINT DU "RTN","BIREPL",23,0) D EN^VALM("BI REPORT ADULT IMM") "RTN","BIREPL",24,0) Q "RTN","BIREPL",25,0) ; "RTN","BIREPL",26,0) ; "RTN","BIREPL",27,0) ;---------- "RTN","BIREPL",28,0) INIT ;EP "RTN","BIREPL",29,0) ;---> Initialize variables and list array. "RTN","BIREPL",30,0) S VALM("TITLE")=$$LMVER^BILOGO "RTN","BIREPL",31,0) S VALMSG="Select a left column number to change an item." "RTN","BIREPL",32,0) N BILINE,X S BILINE=0 "RTN","BIREPL",33,0) D WRITE(.BILINE) "RTN","BIREPL",34,0) S X=IOUON_"ADULT IMMUNIZATION REPORT" D CENTERT^BIUTL5(.X,42) "RTN","BIREPL",35,0) D WRITE(.BILINE,X_IOINORM) "RTN","BIREPL",36,0) K X "RTN","BIREPL",37,0) ; "RTN","BIREPL",38,0) ;---> Date. "RTN","BIREPL",39,0) D WRITE(.BILINE) "RTN","BIREPL",40,0) S:'$G(BIQDT) BIQDT=$G(DT) "RTN","BIREPL",41,0) D DATE^BIREP(.BILINE,"BIREPL",1,BIQDT,"Quarter Ending Date",,,,1) "RTN","BIREPL",42,0) ; "RTN","BIREPL",43,0) ;---> Current Community. "RTN","BIREPL",44,0) D DISP^BIREP(.BILINE,"BIREPL",.BICC,"Community",2,1) "RTN","BIREPL",45,0) ; "RTN","BIREPL",46,0) ;---> Health Care Facility. "RTN","BIREPL",47,0) N A,B S A="Health Care Facility",B="Facilities" "RTN","BIREPL",48,0) D DISP^BIREP(.BILINE,"BIREPL",.BIHCF,A,3,2,,,,B) K A,B "RTN","BIREPL",49,0) ; "RTN","BIREPL",50,0) ;---> Beneficiary Type. "RTN","BIREPL",51,0) S:$O(BIBEN(0))="" BIBEN(1)="" ;vvv83 "RTN","BIREPL",52,0) D DISP^BIREP(.BILINE,"BIREPL",.BIBEN,"Beneficiary Type",4,4) "RTN","BIREPL",53,0) ; "RTN","BIREPL",54,0) ;---> Include CPT Coded Visits. "RTN","BIREPL",55,0) S:'$D(BICPTI) BICPTI=0 "RTN","BIREPL",56,0) S X=" 5 - Include CPT Coded Visits...: " "RTN","BIREPL",57,0) S X=X_$S($G(BICPTI):"YES",1:"NO") "RTN","BIREPL",58,0) D WRITE(.BILINE,X,1) "RTN","BIREPL",59,0) K X "RTN","BIREPL",60,0) ; "RTN","BIREPL",61,0) ;---> User Population. "RTN","BIREPL",62,0) D:($G(BIUP)="") "RTN","BIREPL",63,0) .I $$GPRAIEN^BIUTL6 S BIUP="a" Q "RTN","BIREPL",64,0) .S BIUP="u" "RTN","BIREPL",65,0) ; "RTN","BIREPL",66,0) S X=" 6 - Patient Population Group...: " "RTN","BIREPL",67,0) D "RTN","BIREPL",68,0) .I BIUP="r" S X=X_"Registered Patients (All)" Q "RTN","BIREPL",69,0) .I BIUP="i" S X=X_"Immunization Register Patients (Active)" Q "RTN","BIREPL",70,0) .I BIUP="u" S X=X_"User Population (1 visit, 3 yrs)" Q "RTN","BIREPL",71,0) .I BIUP="a" S X=X_"Active Users (2+ visits, 3 yrs)" Q "RTN","BIREPL",72,0) D WRITE(.BILINE,X,1) "RTN","BIREPL",73,0) K X "RTN","BIREPL",74,0) ; "RTN","BIREPL",75,0) ;---> Finish up Listmanager List Count. "RTN","BIREPL",76,0) S VALMCNT=BILINE "RTN","BIREPL",77,0) S BIRTN="BIREPL" "RTN","BIREPL",78,0) Q "RTN","BIREPL",79,0) ; "RTN","BIREPL",80,0) ; "RTN","BIREPL",81,0) ;---------- "RTN","BIREPL",82,0) WRITE(BILINE,BIVAL,BIBLNK) ;EP "RTN","BIREPL",83,0) ;---> Write lines to ^TMP (see documentation in ^BIW). "RTN","BIREPL",84,0) ;---> Parameters: "RTN","BIREPL",85,0) ; 1 - BILINE (ret) Last line# written. "RTN","BIREPL",86,0) ; 2 - BIVAL (opt) Value/text of line (Null=blank line). "RTN","BIREPL",87,0) ; 3 - BIBLNK (opt) Number of blank lines to add after line sent. "RTN","BIREPL",88,0) ; "RTN","BIREPL",89,0) Q:'$D(BILINE) "RTN","BIREPL",90,0) D WL^BIW(.BILINE,"BIREPL",$G(BIVAL),$G(BIBLNK)) "RTN","BIREPL",91,0) Q "RTN","BIREPL",92,0) ; "RTN","BIREPL",93,0) ; "RTN","BIREPL",94,0) ;---------- "RTN","BIREPL",95,0) RESET ;EP "RTN","BIREPL",96,0) ;---> Update partition for return to Listmanager. "RTN","BIREPL",97,0) I $D(VALMQUIT) S VALMBCK="Q" Q "RTN","BIREPL",98,0) D TERM^VALM0 S VALMBCK="R" "RTN","BIREPL",99,0) D INIT Q "RTN","BIREPL",100,0) ; "RTN","BIREPL",101,0) ; "RTN","BIREPL",102,0) ;---------- "RTN","BIREPL",103,0) HELP ;EP "RTN","BIREPL",104,0) ;---> Help code. "RTN","BIREPL",105,0) N BIX S BIX=X "RTN","BIREPL",106,0) D FULL^VALM1 "RTN","BIREPL",107,0) W !!?5,"Enter ""V"" to view this report on screen, ""P"" to print it," "RTN","BIREPL",108,0) W !?5,"or ""H"" to view the Help Text for this report and its parameters." "RTN","BIREPL",109,0) D DIRZ^BIUTL3(""," Press ENTER/RETURN to continue") "RTN","BIREPL",110,0) D:BIX'="??" RE^VALM4 "RTN","BIREPL",111,0) Q "RTN","BIREPL",112,0) ; "RTN","BIREPL",113,0) ; "RTN","BIREPL",114,0) ;---------- "RTN","BIREPL",115,0) HELP1 ;EP "RTN","BIREPL",116,0) ;----> Explanation of this report. "RTN","BIREPL",117,0) N BITEXT D TEXT1(.BITEXT) "RTN","BIREPL",118,0) D START^BIHELP("ADULT IMMUNIZATION REPORT - HELP",.BITEXT) "RTN","BIREPL",119,0) Q "RTN","BIREPL",120,0) ; "RTN","BIREPL",121,0) ; "RTN","BIREPL",122,0) ;---------- "RTN","BIREPL",123,0) TEXT1(BITEXT) ;EP "RTN","BIREPL",124,0) ;; "RTN","BIREPL",125,0) ;; "RTN","BIREPL",126,0) D LOADTX("ADULT REPORT",,.BITEXT) "RTN","BIREPL",127,0) Q "RTN","BIREPL",128,0) ; "RTN","BIREPL",129,0) ; "RTN","BIREPL",130,0) ;---------- "RTN","BIREPL",131,0) LOADTX(BILINL,BITAB,BITEXT) ;EP "RTN","BIREPL",132,0) Q:$G(BILINL)="" "RTN","BIREPL",133,0) ;N I,T,X S T="" S:'$D(BITAB) BITAB=5 F I=1:1:BITAB S T=T_" " "RTN","BIREPL",134,0) ;F I=1:1 S X=$T(@BILINL+I) Q:X'[";;" S BITEXT(I)=T_$P(X,";;",2) "RTN","BIREPL",135,0) NEW I,T,X,DIWR,Z,J,BIZ,BII,BIR "RTN","BIREPL",136,0) S T="" S:'$D(BITAB) BITAB=5 "RTN","BIREPL",137,0) S BII=$O(^BIRPHTXT("B",BILINL,0)) "RTN","BIREPL",138,0) I 'BII S BITEXT(1)="Help text not available, notify IT." Q "RTN","BIREPL",139,0) S BIR=80 "RTN","BIREPL",140,0) I BITAB S R=BITAB-1 "RTN","BIREPL",141,0) F J=1:1:BITAB S T=T_" " "RTN","BIREPL",142,0) K ^UTILITY($J,"W") "RTN","BIREPL",143,0) S BIZ=0 F S BIZ=$O(^BIRPHTXT(BII,11,BIZ)) Q:BIZ'=+BIZ S X=T_^BIRPHTXT(BII,11,BIZ,0) D "RTN","BIREPL",144,0) .S DIWL=0,DIWR=BIR D ^DIWP "RTN","BIREPL",145,0) S J=0 S X=0 F S X=$O(^UTILITY($J,"W",0,X)) Q:X'=+X S J=J+1,BITEXT(J)=^UTILITY($J,"W",0,X,0) "RTN","BIREPL",146,0) K ^UTILITY($J,"W") "RTN","BIREPL",147,0) Q "RTN","BIREPL",148,0) ; "RTN","BIREPL",149,0) ; "RTN","BIREPL",150,0) ;---------- "RTN","BIREPL",151,0) EXIT ;EP "RTN","BIREPL",152,0) ;---> End of job cleanup. "RTN","BIREPL",153,0) D KILLALL^BIUTL8(1) "RTN","BIREPL",154,0) K ^TMP("BIREPL",$J) "RTN","BIREPL",155,0) D CLEAR^VALM1 "RTN","BIREPL",156,0) D FULL^VALM1 "RTN","BIREPL",157,0) Q "RTN","BIREPL",158,0) ; "RTN","BIREPL1") 0^5^B54336137 "RTN","BIREPL1",1,0) BIREPL1 ;IHS/CMI/MWR - REPORT, ADULT IMM; MAY 10, 2010 "RTN","BIREPL1",2,0) ;;8.5;IMMUNIZATION;**26,31**;OCT 24,2011;Build 137 "RTN","BIREPL1",3,0) ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS * "RTN","BIREPL1",4,0) ;; VIEW OR PRINT ADULT IMMUNIZATION REPORT. "RTN","BIREPL1",5,0) ; "RTN","BIREPL1",6,0) ; "RTN","BIREPL1",7,0) ;---------- "RTN","BIREPL1",8,0) START(BIX) ;EP "RTN","BIREPL1",9,0) ;---> VIEW ADULT Report. "RTN","BIREPL1",10,0) ;---> Prepare and display Adult Immunization Report. "RTN","BIREPL1",11,0) ;---> Parameters: "RTN","BIREPL1",12,0) ; 1 - BIX (req) If BIX="PRINT", then print Adult Report. "RTN","BIREPL1",13,0) ; If BIX="VIEW", then view Adult Report (default). "RTN","BIREPL1",14,0) ;---> Variables: "RTN","BIREPL1",15,0) ; 1 - BIQDT (req) Quarter Ending Date. "RTN","BIREPL1",16,0) ; 2 - BICC (req) Current Community array. "RTN","BIREPL1",17,0) ; 3 - BIHCF (req) Health Care Facility array. "RTN","BIREPL1",18,0) ; 4 - BIBEN (req) Beneficiary Type array. "RTN","BIREPL1",19,0) ; 5 - BICPTI (opt) 1=Include CPT Coded Visits, 0=Ignore CPT (default). "RTN","BIREPL1",20,0) ; 6 - BIUP (req) User Population/Group "RTN","BIREPL1",21,0) ; (Registered, Imm Reg Active, User 1+, Active 2+). "RTN","BIREPL1",22,0) ; "RTN","BIREPL1",23,0) ;---> Check for required Variables. "RTN","BIREPL1",24,0) I '$G(BIQDT) D ERROR(622) D RESET^BIREPL Q "RTN","BIREPL1",25,0) I '$D(BICC) D ERROR(614) D RESET^BIREPL Q "RTN","BIREPL1",26,0) I '$D(BIHCF) D ERROR(625) D RESET^BIREPL Q "RTN","BIREPL1",27,0) I '$D(BIBEN) D ERROR(662) D RESET^BIREPL Q "RTN","BIREPL1",28,0) I '$D(BICPTI) S BICPTI=0 "RTN","BIREPL1",29,0) S:$G(BIUP)="" BIUP="u" "RTN","BIREPL1",30,0) ; "RTN","BIREPL1",31,0) D SETVARS^BIUTL5 N VALMCNT "RTN","BIREPL1",32,0) S BISPD=BIX "RTN","BIREPL1",33,0) I $G(BIX)="PRINT" D PRINT,RESET^BIREPL Q "RTN","BIREPL1",34,0) I $G(BIX)="CSV" D DELIM^BIREPCSV("BIREPL1","ADULT IMMUNIZATION REPORT","ADL"),RESET^BIREPL Q ;IHS/LAB patch 31 delimited output "RTN","BIREPL1",35,0) ; "RTN","BIREPL1",36,0) ;---> Set BIRTN in case user runs Patient List then needs to return "RTN","BIREPL1",37,0) ;---> to INIT here. "RTN","BIREPL1",38,0) ;---> Set BITITL for Report Name in Patient List, if called. "RTN","BIREPL1",39,0) ;---> Set BIAG for Age Range in header of report. "RTN","BIREPL1",40,0) N BIAG,BIRTN,BITITL S BIRTN="BIREPL1",BITITL="ADULT",BIAG="19+^1" "RTN","BIREPL1",41,0) D EN "RTN","BIREPL1",42,0) D RESET^BIREPL "RTN","BIREPL1",43,0) Q "RTN","BIREPL1",44,0) ; "RTN","BIREPL1",45,0) ; "RTN","BIREPL1",46,0) ;---------- "RTN","BIREPL1",47,0) PRINT ;EP "RTN","BIREPL1",48,0) ;---> Main entry point for printing the ADULT Immunization Report. "RTN","BIREPL1",49,0) D DEVICE(.BIPOP) "RTN","BIREPL1",50,0) Q:$G(BIPOP) "RTN","BIREPL1",51,0) ; "RTN","BIREPL1",52,0) D:$G(IO)'=$G(IO(0)) "RTN","BIREPL1",53,0) .W !!?10,"This may take some time. Please hold on...",! "RTN","BIREPL1",54,0) ; "RTN","BIREPL1",55,0) ;---> Prepare report. "RTN","BIREPL1",56,0) K ^TMP("BIREPL1",$J),^TMP("BIDUL",$J) "RTN","BIREPL1",57,0) N VALM,VALMHDR "RTN","BIREPL1",58,0) D HDR,START^BIREPL2(BIQDT,.BICC,.BIHCF,.BIBEN,BICPTI,BIUP) "RTN","BIREPL1",59,0) ; "RTN","BIREPL1",60,0) D PRTLST^BIUTL8("BIREPL1") "RTN","BIREPL1",61,0) D EXIT,RESET^BIREPL "RTN","BIREPL1",62,0) Q "RTN","BIREPL1",63,0) ; "RTN","BIREPL1",64,0) ; "RTN","BIREPL1",65,0) ;---------- "RTN","BIREPL1",66,0) EN ;EP "RTN","BIREPL1",67,0) ;---> Main entry point for List Template BI REPORT ADULT IMM1. "RTN","BIREPL1",68,0) D EN^VALM("BI REPORT ADULT IMM1") "RTN","BIREPL1",69,0) Q "RTN","BIREPL1",70,0) ; "RTN","BIREPL1",71,0) ; "RTN","BIREPL1",72,0) ;---------- "RTN","BIREPL1",73,0) HDR ;EP "RTN","BIREPL1",74,0) ;---> Header code "RTN","BIREPL1",75,0) D HEAD^BIREPL2(BIQDT,.BICC,.BIHCF,.BIBEN,BICPTI,BIUP) "RTN","BIREPL1",76,0) Q "RTN","BIREPL1",77,0) ; "RTN","BIREPL1",78,0) ; "RTN","BIREPL1",79,0) ;---------- "RTN","BIREPL1",80,0) INIT ;EP "RTN","BIREPL1",81,0) ;---> Initialize variables and list array. "RTN","BIREPL1",82,0) K ^TMP("BIREPL1",$J),^TMP("BIDUL",$J) "RTN","BIREPL1",83,0) S VALM("TITLE")=$$LMVER^BILOGO "RTN","BIREPL1",84,0) S VALMSG="To view patient rosters, select a group below:" "RTN","BIREPL1",85,0) W !!?10,"This may take some time. Please hold on...",! "RTN","BIREPL1",86,0) D START^BIREPL2(BIQDT,.BICC,.BIHCF,.BIBEN,BICPTI,BIUP) "RTN","BIREPL1",87,0) ;---> Set up ZTSAVE in case user Queues from PL in List. "RTN","BIREPL1",88,0) D ZSAVES^BIUTL3 "RTN","BIREPL1",89,0) Q "RTN","BIREPL1",90,0) ; "RTN","BIREPL1",91,0) ; "RTN","BIREPL1",92,0) ;---------- "RTN","BIREPL1",93,0) RESET ;EP "RTN","BIREPL1",94,0) ;---> Update partition for return to Listmanager. "RTN","BIREPL1",95,0) I $D(VALMQUIT) S VALMBCK="Q" Q "RTN","BIREPL1",96,0) D TERM^VALM0 S VALMBCK="R" "RTN","BIREPL1",97,0) D INIT,HDR "RTN","BIREPL1",98,0) Q "RTN","BIREPL1",99,0) ; "RTN","BIREPL1",100,0) ; "RTN","BIREPL1",101,0) ;---------- "RTN","BIREPL1",102,0) RESET1 ;EP "RTN","BIREPL1",103,0) ;---> Update partition for return to Listmanager. "RTN","BIREPL1",104,0) I $D(VALMQUIT) S VALMBCK="Q" Q "RTN","BIREPL1",105,0) D TERM^VALM0 S VALMBCK="R" "RTN","BIREPL1",106,0) S VALM("TITLE")=$$LMVER^BILOGO "RTN","BIREPL1",107,0) S VALMSG="To view patient lists, select a group below:" "RTN","BIREPL1",108,0) D HDR "RTN","BIREPL1",109,0) Q "RTN","BIREPL1",110,0) ; "RTN","BIREPL1",111,0) ; "RTN","BIREPL1",112,0) ;---------- "RTN","BIREPL1",113,0) HELP ;EP "RTN","BIREPL1",114,0) N BIX S BIX=X "RTN","BIREPL1",115,0) D FULL^VALM1 N BIPOP "RTN","BIREPL1",116,0) D TITLE^BIUTL5("VIEW ADULT REPORT - HELP") "RTN","BIREPL1",117,0) D TEXT1,DIRZ^BIUTL3() "RTN","BIREPL1",118,0) D:BIX'="??" RE^VALM4 "RTN","BIREPL1",119,0) Q "RTN","BIREPL1",120,0) ; "RTN","BIREPL1",121,0) ; "RTN","BIREPL1",122,0) ;---------- "RTN","BIREPL1",123,0) TEXT1 ;EP "RTN","BIREPL1",124,0) ;;You have chosen to View the Adult Report rather than Print it. "RTN","BIREPL1",125,0) ;;(You may print the report from here as well by entering "PL".) "RTN","BIREPL1",126,0) ;; "RTN","BIREPL1",127,0) ;;Also, you may: "RTN","BIREPL1",128,0) ;; "RTN","BIREPL1",129,0) ;;Enter "N" to view the list of Patients who were NOT Current "RTN","BIREPL1",130,0) ;; or "NOT up-to-date" with their immunizations, according "RTN","BIREPL1",131,0) ;; to recommendeded guidelines for their age. "RTN","BIREPL1",132,0) ;; "RTN","BIREPL1",133,0) ;;Enter "C" to view the list of Patients who were CURRENT or "RTN","BIREPL1",134,0) ;; "up-to-date" with their immunizations, according to "RTN","BIREPL1",135,0) ;; recommendeded guidelines for their age. "RTN","BIREPL1",136,0) ;; "RTN","BIREPL1",137,0) ;;Enter "B" to view a list of both groups of patients combined. "RTN","BIREPL1",138,0) ;; "RTN","BIREPL1",139,0) ;; "RTN","BIREPL1",140,0) D PRINTX("TEXT1") "RTN","BIREPL1",141,0) Q "RTN","BIREPL1",142,0) ; "RTN","BIREPL1",143,0) ; "RTN","BIREPL1",144,0) ;---------- "RTN","BIREPL1",145,0) EXIT ;EP "RTN","BIREPL1",146,0) ;---> Cleanup, EOJ. "RTN","BIREPL1",147,0) K ^TMP("BIREPL1",$J),^TMP("BIDUL",$J) "RTN","BIREPL1",148,0) D CLEAR^VALM1 "RTN","BIREPL1",149,0) D FULL^VALM1 "RTN","BIREPL1",150,0) Q "RTN","BIREPL1",151,0) ; "RTN","BIREPL1",152,0) ; "RTN","BIREPL1",153,0) ;---------- "RTN","BIREPL1",154,0) DEVICE(BIPOP) ;EP "RTN","BIREPL1",155,0) ;---> Get Device and possibly queue to Taskman. "RTN","BIREPL1",156,0) ;---> Parameters: "RTN","BIREPL1",157,0) ; 1 - BIPOP (ret) If error or Queue, BIPOP=1 "RTN","BIREPL1",158,0) ; "RTN","BIREPL1",159,0) K %ZIS,IOP S BIPOP=0 "RTN","BIREPL1",160,0) S ZTRTN="DEQUEUE^BIREPL1" "RTN","BIREPL1",161,0) D ZSAVES^BIUTL3 "RTN","BIREPL1",162,0) D ZIS^BIUTL2(.BIPOP,1) "RTN","BIREPL1",163,0) Q "RTN","BIREPL1",164,0) ; "RTN","BIREPL1",165,0) ; "RTN","BIREPL1",166,0) ;---------- "RTN","BIREPL1",167,0) DEQUEUE ;EP "RTN","BIREPL1",168,0) ; "RTN","BIREPL1",169,0) ;---> Prepare and print ADULT Report. "RTN","BIREPL1",170,0) K VALMHDR,^TMP("BIREPL1",$J) "RTN","BIREPL1",171,0) D HDR^BIREPL1,START^BIREPL2(BIQDT,.BICC,.BIHCF,.BIBEN,BICPTI,BIUP) "RTN","BIREPL1",172,0) D PRTLST^BIUTL8("BIREPL1"),EXIT "RTN","BIREPL1",173,0) Q "RTN","BIREPL1",174,0) ; "RTN","BIREPL1",175,0) ; "RTN","BIREPL1",176,0) ;---------- "RTN","BIREPL1",177,0) PRINTX(BILINL,BITAB) ;EP "RTN","BIREPL1",178,0) Q:$G(BILINL)="" "RTN","BIREPL1",179,0) N I,T,X S T="" S:'$D(BITAB) BITAB=5 F I=1:1:BITAB S T=T_" " "RTN","BIREPL1",180,0) F I=1:1 S X=$T(@BILINL+I) Q:X'[";;" W !,T,$P(X,";;",2) "RTN","BIREPL1",181,0) Q "RTN","BIREPL1",182,0) ; "RTN","BIREPL1",183,0) ; "RTN","BIREPL1",184,0) ;---------- "RTN","BIREPL1",185,0) ERROR(BIERR) ;EP "RTN","BIREPL1",186,0) ;---> Report error, either to screen or print. "RTN","BIREPL1",187,0) ;---> Parameters: "RTN","BIREPL1",188,0) ; 1 - BIERR (ret) Text of Error Code if any, otherwise null. "RTN","BIREPL1",189,0) ; "RTN","BIREPL1",190,0) D ERRCD^BIUTL2($G(BIERR),,1) S BIPOP=1 "RTN","BIREPL1",191,0) Q "RTN","BIREPL1",192,0) PCV13(BIDFN,BICPTI,BIQDT) ;EP "RTN","BIREPL1",193,0) ;---> Return number of HPV's patient received, concat "RTN","BIREPL1",194,0) ;---> Parameters: "RTN","BIREPL1",195,0) ; 1 - BIDFN (req) Patient DFN "RTN","BIREPL1",196,0) ; 2 - BICPTI (opt) 1=Include CPT Coded Visits, 0=Ignore CPT. "RTN","BIREPL1",197,0) ; 3 - BIQDT (opt) Quarter Ending Date (ignore Visits after this date). "RTN","BIREPL1",198,0) ; "RTN","BIREPL1",199,0) ;---> Check V Imms for PCV13's. "RTN","BIREPL1",200,0) N BICVXS,BIDATE,BIDOSES,I,J,BIABD,T,D,BD,ED,G,V,X "RTN","BIREPL1",201,0) S BIDATE=0,BIDOSES=0,J=0 "RTN","BIREPL1",202,0) S:('$G(BIQDT)) BIQDT=$G(DT) "RTN","BIREPL1",203,0) S BICVXS="100,133,152" "RTN","BIREPL1",204,0) S BIDATE=$$LASTIMM^BIUTL11(BIDFN,BICVXS,BIQDT) "RTN","BIREPL1",205,0) ;set up array by date "RTN","BIREPL1",206,0) F I=1:1 S J=$P(BIDATE,",",I) Q:J="" S BIABD(J)="" "RTN","BIREPL1",207,0) ; "RTN","BIREPL1",208,0) ;---> Check (if requested) V CPTs for HPV's. "RTN","BIREPL1",209,0) D:$G(BICPTI) "RTN","BIREPL1",210,0) .N BICPTS,J S J=0 "RTN","BIREPL1",211,0) .S BICPTS="90669,90670" "RTN","BIREPL1",212,0) .S BIDATE=$$LASTCPT^BIUTL11(BIDFN,BICPTS,BIQDT,1) "RTN","BIREPL1",213,0) .F I=1:1 S J=$P(BIDATE,",",I) Q:J="" S BIABD(J)="" "RTN","BIREPL1",214,0) ; "RTN","BIREPL1",215,0) S J=0 F S J=$O(BIABD(J)) Q:J'=+J S BIDOSES=BIDOSES+1 "RTN","BIREPL1",216,0) Q BIDOSES "RTN","BIREPL1",217,0) PCV15(BIDFN,BICPTI,BIQDT) ;EP "RTN","BIREPL1",218,0) ;---> Return number of HPV's patient received, concat "RTN","BIREPL1",219,0) ;---> Parameters: "RTN","BIREPL1",220,0) ; 1 - BIDFN (req) Patient DFN "RTN","BIREPL1",221,0) ; 2 - BICPTI (opt) 1=Include CPT Coded Visits, 0=Ignore CPT. "RTN","BIREPL1",222,0) ; 3 - BIQDT (opt) Quarter Ending Date (ignore Visits after this date). "RTN","BIREPL1",223,0) ; "RTN","BIREPL1",224,0) ;---> Check V Imms for PCV13's. "RTN","BIREPL1",225,0) N BICVXS,BIDATE,BIDOSES,I,J,BIABD,T,D,BD,ED,G,V,X "RTN","BIREPL1",226,0) S BIDATE=0,BIDOSES=0,J=0 "RTN","BIREPL1",227,0) S:('$G(BIQDT)) BIQDT=$G(DT) "RTN","BIREPL1",228,0) S BICVXS="215" "RTN","BIREPL1",229,0) S BIDATE=$$LASTIMM^BIUTL11(BIDFN,BICVXS,BIQDT) "RTN","BIREPL1",230,0) ;set up array by date "RTN","BIREPL1",231,0) F I=1:1 S J=$P(BIDATE,",",I) Q:J="" S BIABD(J)="" "RTN","BIREPL1",232,0) ; "RTN","BIREPL1",233,0) ;---> Check (if requested) V CPTs for HPV's. "RTN","BIREPL1",234,0) D:$G(BICPTI) "RTN","BIREPL1",235,0) .N BICPTS,J S J=0 "RTN","BIREPL1",236,0) .S BICPTS="90671" "RTN","BIREPL1",237,0) .S BIDATE=$$LASTCPT^BIUTL11(BIDFN,BICPTS,BIQDT,1) "RTN","BIREPL1",238,0) .F I=1:1 S J=$P(BIDATE,",",I) Q:J="" S BIABD(J)="" "RTN","BIREPL1",239,0) ; "RTN","BIREPL1",240,0) S J=0 F S J=$O(BIABD(J)) Q:J'=+J S BIDOSES=BIDOSES+1 "RTN","BIREPL1",241,0) Q BIDOSES "RTN","BIREPL1",242,0) PCV20(BIDFN,BICPTI,BIQDT) ;EP "RTN","BIREPL1",243,0) ;---> Return number of HPV's patient received, concat "RTN","BIREPL1",244,0) ;---> Parameters: "RTN","BIREPL1",245,0) ; 1 - BIDFN (req) Patient DFN "RTN","BIREPL1",246,0) ; 2 - BICPTI (opt) 1=Include CPT Coded Visits, 0=Ignore CPT. "RTN","BIREPL1",247,0) ; 3 - BIQDT (opt) Quarter Ending Date (ignore Visits after this date). "RTN","BIREPL1",248,0) ; "RTN","BIREPL1",249,0) ;---> Check V Imms for PCV13's. "RTN","BIREPL1",250,0) N BICVXS,BIDATE,BIDOSES,I,J,BIABD,T,D,BD,ED,G,V,X "RTN","BIREPL1",251,0) S BIDATE=0,BIDOSES=0,J=0 "RTN","BIREPL1",252,0) S:('$G(BIQDT)) BIQDT=$G(DT) "RTN","BIREPL1",253,0) S BICVXS="216" "RTN","BIREPL1",254,0) S BIDATE=$$LASTIMM^BIUTL11(BIDFN,BICVXS,BIQDT) "RTN","BIREPL1",255,0) ;set up array by date "RTN","BIREPL1",256,0) F I=1:1 S J=$P(BIDATE,",",I) Q:J="" S BIABD(J)="" "RTN","BIREPL1",257,0) ; "RTN","BIREPL1",258,0) ;---> Check (if requested) V CPTs for HPV's. "RTN","BIREPL1",259,0) D:$G(BICPTI) "RTN","BIREPL1",260,0) .N BICPTS,J S J=0 "RTN","BIREPL1",261,0) .S BICPTS="90677" "RTN","BIREPL1",262,0) .S BIDATE=$$LASTCPT^BIUTL11(BIDFN,BICPTS,BIQDT,1) "RTN","BIREPL1",263,0) .F I=1:1 S J=$P(BIDATE,",",I) Q:J="" S BIABD(J)="" "RTN","BIREPL1",264,0) ; "RTN","BIREPL1",265,0) S J=0 F S J=$O(BIABD(J)) Q:J'=+J S BIDOSES=BIDOSES+1 "RTN","BIREPL1",266,0) Q BIDOSES "RTN","BIREPL1",267,0) PPSV23(BIDFN,BICPTI,BIQDT) ;EP "RTN","BIREPL1",268,0) ;---> Return number of HPV's patient received, concat "RTN","BIREPL1",269,0) ;---> Parameters: "RTN","BIREPL1",270,0) ; 1 - BIDFN (req) Patient DFN "RTN","BIREPL1",271,0) ; 2 - BICPTI (opt) 1=Include CPT Coded Visits, 0=Ignore CPT. "RTN","BIREPL1",272,0) ; 3 - BIQDT (opt) Quarter Ending Date (ignore Visits after this date). "RTN","BIREPL1",273,0) ; "RTN","BIREPL1",274,0) ;---> Check V Imms for PCV13's. "RTN","BIREPL1",275,0) N BICVXS,BIDATE,BIDOSES,I,J,BIABD,T,D,BD,ED,G,V,X "RTN","BIREPL1",276,0) S BIDATE=0,BIDOSES=0,J=0 "RTN","BIREPL1",277,0) S:('$G(BIQDT)) BIQDT=$G(DT) "RTN","BIREPL1",278,0) S BICVXS="33,109" "RTN","BIREPL1",279,0) S BIDATE=$$LASTIMM^BIUTL11(BIDFN,BICVXS,BIQDT) "RTN","BIREPL1",280,0) ;set up array by date "RTN","BIREPL1",281,0) F I=1:1 S J=$P(BIDATE,",",I) Q:J="" S BIABD(J)="" "RTN","BIREPL1",282,0) ; "RTN","BIREPL1",283,0) ;---> Check (if requested) V CPTs for HPV's. "RTN","BIREPL1",284,0) D:$G(BICPTI) "RTN","BIREPL1",285,0) .N BICPTS,J S J=0 "RTN","BIREPL1",286,0) .S BICPTS="90732,G0009,G8115,G9279" "RTN","BIREPL1",287,0) .S BIDATE=$$LASTCPT^BIUTL11(BIDFN,BICPTS,BIQDT,1) "RTN","BIREPL1",288,0) .F I=1:1 S J=$P(BIDATE,",",I) Q:J="" S BIABD(J)="" "RTN","BIREPL1",289,0) ; "RTN","BIREPL1",290,0) S J=0 F S J=$O(BIABD(J)) Q:J'=+J S BIDOSES=BIDOSES+1 "RTN","BIREPL1",291,0) Q BIDOSES "RTN","BIREPL2") 0^6^B183750515 "RTN","BIREPL2",1,0) BIREPL2 ;IHS/CMI/MWR - REPORT, ADULT IMM; MAY 10, 2010 ; 21 May 2025 12:59 PM [ 05/21/2025 11:59 AM ] "RTN","BIREPL2",2,0) ;;8.5;IMMUNIZATION;**12,26,27,29,30,31**;OCT 24,2011;Build 137 "RTN","BIREPL2",3,0) ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS * "RTN","BIREPL2",4,0) ;; VIEW ADULT IMMUNIZATION REPORT, GATHER DATA. "RTN","BIREPL2",5,0) ; "RTN","BIREPL2",6,0) HEAD(BIQDT,BICC,BIHCF,BIBEN,BICPTI,BIUP) ;EP "RTN","BIREPL2",7,0) ;---> Produce Header array for ADULT Immunization Report. "RTN","BIREPL2",8,0) ;---> Parameters: "RTN","BIREPL2",9,0) ; 1 - BIQDT (req) Quarter Ending Date. "RTN","BIREPL2",10,0) ; 2 - BICC (req) Current Community array. "RTN","BIREPL2",11,0) ; 3 - BIHCF (req) Health Care Facility array. "RTN","BIREPL2",12,0) ; 4 - BIBEN (req) Beneficiary Type array. "RTN","BIREPL2",13,0) ; 5 - BICPTI (req) 1=Include CPT Coded Visits, 0=Ignore CPT "RTN","BIREPL2",14,0) ; 6 - BIUP (req) User Population/Group (Registered, Imm, User, Active). "RTN","BIREPL2",15,0) Q:'$G(BIQDT) "RTN","BIREPL2",16,0) Q:'$D(BICC) "RTN","BIREPL2",17,0) Q:'$D(BIHCF) "RTN","BIREPL2",18,0) Q:'$D(BIBEN) "RTN","BIREPL2",19,0) I '$D(BICPTI) S BICPTI=0 "RTN","BIREPL2",20,0) Q:'$D(BIUP) "RTN","BIREPL2",21,0) ; "RTN","BIREPL2",22,0) K VALMHDR "RTN","BIREPL2",23,0) N BILINE,X "RTN","BIREPL2",24,0) S BILINE=0 "RTN","BIREPL2",25,0) ; "RTN","BIREPL2",26,0) N X "RTN","BIREPL2",27,0) S X="" "RTN","BIREPL2",28,0) ;---> If Header array is NOT being for Listmananger include version. "RTN","BIREPL2",29,0) S:'$D(VALM("BM")) X=$$LMVER^BILOGO() "RTN","BIREPL2",30,0) ; "RTN","BIREPL2",31,0) I $G(BISPD)'="CSV" D WH^BIW(.BILINE,X) "RTN","BIREPL2",32,0) S X=$$REPHDR^BIUTL6(DUZ(2)) I $G(BISPD)'="CSV" D CENTERT^BIUTL5(.X) "RTN","BIREPL2",33,0) D WH^BIW(.BILINE,X) "RTN","BIREPL2",34,0) ; "RTN","BIREPL2",35,0) S X="* Adult Immunization Report *" I $G(BISPD)'="CSV" D CENTERT^BIUTL5(.X) "RTN","BIREPL2",36,0) D WH^BIW(.BILINE,X) "RTN","BIREPL2",37,0) ; "RTN","BIREPL2",38,0) S:$G(BISPD)'="CSV" X=$$SP^BIUTL5(27)_"Report Date: "_$$SLDT1^BIUTL5(DT) S:$G(BISPD)="CSV" X="Report Date: "_$$SLDT1^BIUTL5(DT) "RTN","BIREPL2",39,0) D WH^BIW(.BILINE,X,$S($G(BISPD)="CSV":"",1:1)) "RTN","BIREPL2",40,0) ; "RTN","BIREPL2",41,0) ; "RTN","BIREPL2",42,0) S:$G(BISPD)'="CSV" X=$$SP^BIUTL5(30)_"End Date: "_$$SLDT1^BIUTL5(BIQDT) S:$G(BISPD)="CSV" X="End Date: "_$$SLDT1^BIUTL5(BIQDT) "RTN","BIREPL2",43,0) D WH^BIW(.BILINE,X,$S($G(BISPD)="CSV":"",1:1)) "RTN","BIREPL2",44,0) ; "RTN","BIREPL2",45,0) ;S X=$$SP^BIUTL5(27)_"Report Date: "_$$SLDT1^BIUTL5(DT) "RTN","BIREPL2",46,0) ;D WH^BIW(.BILINE,X,1) "RTN","BIREPL2",47,0) ; "RTN","BIREPL2",48,0) ;********** "RTN","BIREPL2",49,0) ; "RTN","BIREPL2",50,0) S X=" "_$$BIUPTX^BIUTL6(BIUP) "RTN","BIREPL2",51,0) I BICPTI S X=$$PAD^BIUTL5(X,52)_"* CPT Coded Visits Included" "RTN","BIREPL2",52,0) D WH^BIW(.BILINE,X) "RTN","BIREPL2",53,0) I $G(BISPD)'="CSV" D WH^BIW(.BILINE,$$SP^BIUTL5(79,"-")) "RTN","BIREPL2",54,0) ; "RTN","BIREPL2",55,0) D "RTN","BIREPL2",56,0) .;---> If specific Communities were selected (not ALL), then print "RTN","BIREPL2",57,0) .;---> the Communities in a subheader at the top of the report. "RTN","BIREPL2",58,0) .D SUBH^BIOUTPT5("BICC","Community",,"^AUTTCOM(",.BILINE,.BIERR,,13) "RTN","BIREPL2",59,0) .I $G(BIERR) D ERRCD^BIUTL2(BIERR,.X) D WH^BIW(.BILINE,X) Q "RTN","BIREPL2",60,0) .; "RTN","BIREPL2",61,0) .;---> If specific Health Care Facilities, print subheader. "RTN","BIREPL2",62,0) .D SUBH^BIOUTPT5("BIHCF","Facility",,"^DIC(4,",.BILINE,.BIERR,,13) "RTN","BIREPL2",63,0) .I $G(BIERR) D ERRCD^BIUTL2(BIERR,.X) D WH^BIW(.BILINE,X) Q "RTN","BIREPL2",64,0) .; "RTN","BIREPL2",65,0) .;---> If specific Beneficiary Types, print Beneficiary Type subheader. "RTN","BIREPL2",66,0) .D SUBH^BIOUTPT5("BIBEN","Beneficiary Type",,"^AUTTBEN(",.BILINE,.BIERR,,13) "RTN","BIREPL2",67,0) .I $G(BIERR) D ERRCD^BIUTL2(BIERR,.X) D WH^BIW(.BILINE,X) Q "RTN","BIREPL2",68,0) .; "RTN","BIREPL2",69,0) .I $G(BISPD)'="CSV" S X=$$SP^BIUTL5(59)_"Number Percent" D WH^BIW(.BILINE,X) "RTN","BIREPL2",70,0) ; "RTN","BIREPL2",71,0) D:$D(VALM("BM")) "RTN","BIREPL2",72,0) .S VALM("TM")=BILINE+3 "RTN","BIREPL2",73,0) .S VALM("LINES")=VALM("BM")-VALM("TM")+1 "RTN","BIREPL2",74,0) .;---> Safeguard to prevent divide/0 error. "RTN","BIREPL2",75,0) .S:VALM("LINES")<1 VALM("LINES")=1 "RTN","BIREPL2",76,0) Q "RTN","BIREPL2",77,0) ; "RTN","BIREPL2",78,0) ; "RTN","BIREPL2",79,0) ;---------- "RTN","BIREPL2",80,0) START(BIQDT,BICC,BIHCF,BIBEN,BICPTI,BIUP) ;EP "RTN","BIREPL2",81,0) ;---> Produce array for ADULT Immunization Report. "RTN","BIREPL2",82,0) ;---> Parameters: "RTN","BIREPL2",83,0) ; 1 - BIQDT (req) Quarter Ending Date. "RTN","BIREPL2",84,0) ; 2 - BICC (req) Current Community array. "RTN","BIREPL2",85,0) ; 3 - BIHCF (req) Health Care Facility array. "RTN","BIREPL2",86,0) ; 4 - BIBEN (req) Beneficiary Type array. "RTN","BIREPL2",87,0) ; 5 - BICPTI (req) 1=Include CPT Coded Visits, 0=Ignore CPT (default). "RTN","BIREPL2",88,0) ; 6 - BIUP (req) User Population/Group (Registered, Imm, User, Active). "RTN","BIREPL2",89,0) ; "RTN","BIREPL2",90,0) N BILINE,BITMP,X "RTN","BIREPL2",91,0) S BILINE=0 "RTN","BIREPL2",92,0) K ^TMP("BIREPL1",$J) "RTN","BIREPL2",93,0) ; "RTN","BIREPL2",94,0) ;---> Check for required Variables. "RTN","BIREPL2",95,0) ;---> Fix for v8.1 by adding .X to error calls below. "RTN","BIREPL2",96,0) I '$G(BIQDT) D ERRCD^BIUTL2(623,.X) D WRITE(.BILINE,X) Q "RTN","BIREPL2",97,0) I '$D(BICC) D ERRCD^BIUTL2(614,.X) D WRITE(.BILINE,X) Q "RTN","BIREPL2",98,0) I '$D(BIHCF) D ERRCD^BIUTL2(625,.X) D WRITE(.BILINE,X) Q "RTN","BIREPL2",99,0) I '$D(BIBEN) D ERRCD^BIUTL2(662,.X) D WRITE(.BILINE,X) Q "RTN","BIREPL2",100,0) I '$D(BICPTI) S BICPTI=0 "RTN","BIREPL2",101,0) S:$G(BIUP)="" BIUP="u" "RTN","BIREPL2",102,0) ; "RTN","BIREPL2",103,0) D GETSTATS^BIREPL3(BIQDT,.BICC,.BIHCF,.BIBEN,BICPTI,BIUP,.BITOTS) "RTN","BIREPL2",104,0) D DISPLAY(.BITOTS,.BILINE) "RTN","BIREPL2",105,0) S VALMCNT=BILINE "RTN","BIREPL2",106,0) Q "RTN","BIREPL2",107,0) ; "RTN","BIREPL2",108,0) ; "RTN","BIREPL2",109,0) ;---------- "RTN","BIREPL2",110,0) DISPLAY(BITOTS,BILINE) ;EP "RTN","BIREPL2",111,0) ;---> Write Adult Stats for display. "RTN","BIREPL2",112,0) ;---> Parameters: "RTN","BIREPL2",113,0) ; 1 - BITOTS (req) "RTN","BIREPL2",114,0) ; 1 - BILINE (ret) Number of lines written to Listman scroll area. "RTN","BIREPL2",115,0) ; "RTN","BIREPL2",116,0) I '$D(BITOTS) D ERRCD^BIUTL2(667,.X) D WRITE(.BILINE,X) Q "RTN","BIREPL2",117,0) I $G(BISPD)="CSV" D CSV^BIREPL5(.BITOTS,.BILINE) Q "RTN","BIREPL2",118,0) ; "RTN","BIREPL2",119,0) ; "RTN","BIREPL2",120,0) S X=$$PAD(" Total Number of Patients 19 years and older",56)_": " "RTN","BIREPL2",121,0) S X=X_$$C(BITOTS("PTS19+"),0,8) D WRITE(.BILINE,X,1) "RTN","BIREPL2",122,0) ; "RTN","BIREPL2",123,0) S X=$$PAD(" TETANUS: # patients Tdap EVER",56) "RTN","BIREPL2",124,0) S X=X_": "_$$C(BITOTS("19+TDAPEVER"),0,8) "RTN","BIREPL2",125,0) I BITOTS("PTS19+") S X=X_$J((BITOTS("19+TDAPEVER")/BITOTS("PTS19+"))*100,7,1) "RTN","BIREPL2",126,0) D WRITE(.BILINE,X) "RTN","BIREPL2",127,0) ; "RTN","BIREPL2",128,0) S X=$$PAD(" TETANUS: # patients Tdap EVER AND",56) "RTN","BIREPL2",129,0) D WRITE(.BILINE,X) "RTN","BIREPL2",130,0) S X=$$PAD(" [Td OR Tdap in past 10 years]",56) "RTN","BIREPL2",131,0) S X=X_": "_$$C(BITOTS("19+TDAP&TD10YR"),0,8) "RTN","BIREPL2",132,0) I BITOTS("PTS19+") S X=X_$J((BITOTS("19+TDAP&TD10YR")/BITOTS("PTS19+"))*100,7,1) "RTN","BIREPL2",133,0) D WRITE(.BILINE,X,1) "RTN","BIREPL2",134,0) ; "RTN","BIREPL2",135,0) ;---> HEP B "RTN","BIREPL2",136,0) S X=$$PAD(" Total Number of Patients 19-59",56)_": " "RTN","BIREPL2",137,0) S X=X_$$C(BITOTS("PTS19-59"),0,8) D WRITE(.BILINE,X,1) "RTN","BIREPL2",138,0) ; "RTN","BIREPL2",139,0) S X=$$PAD(" HEP B: # patients - Series initiated",56) "RTN","BIREPL2",140,0) S X=X_": "_$$C(BITOTS("19-59HEPB1"),0,8) ;p26 piece 3 "RTN","BIREPL2",141,0) I BITOTS("PTS19-59") S X=X_$J((BITOTS("19-59HEPB1")/BITOTS("PTS19-59"))*100,7,1) "RTN","BIREPL2",142,0) D WRITE(.BILINE,X) "RTN","BIREPL2",143,0) ; "RTN","BIREPL2",144,0) S X=$$PAD(" HEP B: # patients - Dose 2 initiated",56) "RTN","BIREPL2",145,0) S X=X_": "_$$C(BITOTS("19-59HEPB2"),0,8) ;p26 piece 3 "RTN","BIREPL2",146,0) I BITOTS("PTS19-59") S X=X_$J((BITOTS("19-59HEPB2")/BITOTS("PTS19-59"))*100,7,1) "RTN","BIREPL2",147,0) D WRITE(.BILINE,X) "RTN","BIREPL2",148,0) ; "RTN","BIREPL2",149,0) S X=$$PAD(" HEP B: # patients - Series completed",56) "RTN","BIREPL2",150,0) S X=X_": "_$$C(BITOTS("19-59HEPBC"),0,8) ;p26 piece 3 "RTN","BIREPL2",151,0) I BITOTS("PTS19-59") S X=X_$J((BITOTS("19-59HEPBC")/BITOTS("PTS19-59"))*100,7,1) "RTN","BIREPL2",152,0) D WRITE(.BILINE,X,1) "RTN","BIREPL2",153,0) ; "RTN","BIREPL2",154,0) ;;---> HPV "RTN","BIREPL2",155,0) S X=$$PAD(" Total Number of Patients age 19-26",56) "RTN","BIREPL2",156,0) S X=X_": "_$$C(BITOTS("PTS19-26"),0,8) "RTN","BIREPL2",157,0) I BITOTS("PTS19+") S X=X_$J((BITOTS("PTS19-26")/BITOTS("PTS19+"))*100,7,1) "RTN","BIREPL2",158,0) D WRITE(.BILINE,X,1) "RTN","BIREPL2",159,0) ; "RTN","BIREPL2",160,0) S X=$$PAD(" HPV: # patients - Series initiated",56) "RTN","BIREPL2",161,0) S X=X_": "_$$C(BITOTS("19-26HPV1"),0,8) "RTN","BIREPL2",162,0) I BITOTS("PTS19-26") S X=X_$J((BITOTS("19-26HPV1")/BITOTS("PTS19-26"))*100,7,1) "RTN","BIREPL2",163,0) D WRITE(.BILINE,X) "RTN","BIREPL2",164,0) ; "RTN","BIREPL2",165,0) S X=$$PAD(" HPV: # patients - Dose 2 initiated",56) "RTN","BIREPL2",166,0) S X=X_": "_$$C(BITOTS("19-26HPV2"),0,8) "RTN","BIREPL2",167,0) I BITOTS("PTS19-26") S X=X_$J((BITOTS("19-26HPV2")/BITOTS("PTS19-26"))*100,7,1) "RTN","BIREPL2",168,0) D WRITE(.BILINE,X) "RTN","BIREPL2",169,0) ; "RTN","BIREPL2",170,0) S X=$$PAD(" HPV: # patients - Series completed",56) "RTN","BIREPL2",171,0) S X=X_": "_$$C(BITOTS("19-26HPVC"),0,8) "RTN","BIREPL2",172,0) I BITOTS("PTS19-26") S X=X_$J((BITOTS("19-26HPVC")/BITOTS("PTS19-26"))*100,7,1) "RTN","BIREPL2",173,0) D WRITE(.BILINE,X,1) "RTN","BIREPL2",174,0) ; "RTN","BIREPL2",175,0) ;---> Total patients over 50 and shingrix "RTN","BIREPL2",176,0) S X=$$PAD(" Total Number of Patients 50 years and older",56) "RTN","BIREPL2",177,0) S X=X_": "_$$C(BITOTS("PTS50+"),0,8) "RTN","BIREPL2",178,0) I BITOTS("PTS19+") S X=X_$J((BITOTS("PTS50+")/BITOTS("PTS19+"))*100,7,1) "RTN","BIREPL2",179,0) D WRITE(.BILINE,X,1) "RTN","BIREPL2",180,0) ; "RTN","BIREPL2",181,0) ;V8.5 PATCH 29 - FID- Edit display spelling "RTN","BIREPL2",182,0) S X=$$PAD(" Shingrix: # patients - Series initiated",56) "RTN","BIREPL2",183,0) S X=X_": "_$$C(BITOTS("50+SHINGRIX1"),0,8) "RTN","BIREPL2",184,0) I BITOTS("PTS50+") S X=X_$J((BITOTS("50+SHINGRIX1")/BITOTS("PTS50+"))*100,7,1) "RTN","BIREPL2",185,0) D WRITE(.BILINE,X) "RTN","BIREPL2",186,0) ; "RTN","BIREPL2",187,0) S X=$$PAD(" Shingrix: # patients - Series completed",56) ;THL 6/28/23 Typo corrected "RTN","BIREPL2",188,0) S X=X_": "_$$C(BITOTS("50+SHINGRIXC"),0,8) "RTN","BIREPL2",189,0) I BITOTS("PTS50+") S X=X_$J((BITOTS("50+SHINGRIXC")/BITOTS("PTS50+"))*100,7,1) "RTN","BIREPL2",190,0) D WRITE(.BILINE,X,1) "RTN","BIREPL2",191,0) ; "RTN","BIREPL2",192,0) ;19-64 lines "RTN","BIREPL2",193,0) S X=$$PAD(" Total Number of Patients age 19-64",56) "RTN","BIREPL2",194,0) S X=X_": "_$$C(BITOTS("PTS19-64"),0,8) "RTN","BIREPL2",195,0) I BITOTS("PTS19+") S X=X_$J((BITOTS("PTS19-64")/BITOTS("PTS19+"))*100,7,1) "RTN","BIREPL2",196,0) D WRITE(.BILINE,X,1) "RTN","BIREPL2",197,0) ; "RTN","BIREPL2",198,0) S X=$$PAD(" PCV13 and PPSV23: # patients - fully vaccinated",56) "RTN","BIREPL2",199,0) S X=X_": "_$$C(BITOTS("19-64PCV13PPSV23"),0,8) "RTN","BIREPL2",200,0) I BITOTS("PTS19-64") S X=X_$J((BITOTS("19-64PCV13PPSV23")/BITOTS("PTS19-64"))*100,7,1) "RTN","BIREPL2",201,0) D WRITE(.BILINE,X) "RTN","BIREPL2",202,0) ; "RTN","BIREPL2",203,0) S X=$$PAD(" PCV20: # patients - fully vaccinated",56) "RTN","BIREPL2",204,0) S X=X_": "_$$C(BITOTS("19-64PCV20"),0,8) "RTN","BIREPL2",205,0) I BITOTS("PTS19-64") S X=X_$J((BITOTS("19-64PCV20")/BITOTS("PTS19-64"))*100,7,1) "RTN","BIREPL2",206,0) D WRITE(.BILINE,X) "RTN","BIREPL2",207,0) ; "RTN","BIREPL2",208,0) S X=$$PAD(" PPSV23 and PCV15: # patients - fully vaccinated",56) "RTN","BIREPL2",209,0) S X=X_": "_$$C(BITOTS("19-64PCV15PPSV23"),0,8) "RTN","BIREPL2",210,0) I BITOTS("PTS19-64") S X=X_$J((BITOTS("19-64PCV15PPSV23")/BITOTS("PTS19-64"))*100,7,1) "RTN","BIREPL2",211,0) D WRITE(.BILINE,X,1) "RTN","BIREPL2",212,0) ; "RTN","BIREPL2",213,0) ;65 and older lines "RTN","BIREPL2",214,0) S X=$$PAD(" Total Number of Patients 65 years and older",56) "RTN","BIREPL2",215,0) S X=X_": "_$$C(BITOTS("PTS65+"),0,8) "RTN","BIREPL2",216,0) I BITOTS("PTS19+") S X=X_$J((BITOTS("PTS65+")/BITOTS("PTS19+"))*100,7,1) "RTN","BIREPL2",217,0) D WRITE(.BILINE,X,1) "RTN","BIREPL2",218,0) ; "RTN","BIREPL2",219,0) S X=$$PAD(" Tetanus: # patients w/Td/Tdap in past 10 years",56) "RTN","BIREPL2",220,0) S X=X_": "_$$C(BITOTS("65+TDAP/TD10YR"),0,8) "RTN","BIREPL2",221,0) I BITOTS("PTS65+") S X=X_$J((BITOTS("65+TDAP/TD10YR")/BITOTS("PTS65+"))*100,7,1) "RTN","BIREPL2",222,0) D WRITE(.BILINE,X) "RTN","BIREPL2",223,0) ; "RTN","BIREPL2",224,0) S X=$$PAD(" PCV13 and PPSV23: # patients - fully vaccinated",56) "RTN","BIREPL2",225,0) S X=X_": "_$$C(BITOTS("65+PCV13PPSV23"),0,8) "RTN","BIREPL2",226,0) I BITOTS("PTS65+") S X=X_$J((BITOTS("65+PCV13PPSV23")/BITOTS("PTS65+"))*100,7,1) "RTN","BIREPL2",227,0) D WRITE(.BILINE,X) "RTN","BIREPL2",228,0) ; "RTN","BIREPL2",229,0) S X=$$PAD(" PCV20: # patients - fully vaccinated",56) "RTN","BIREPL2",230,0) S X=X_": "_$$C(BITOTS("65+PCV20"),0,8) "RTN","BIREPL2",231,0) I BITOTS("PTS65+") S X=X_$J((BITOTS("65+PCV20")/BITOTS("PTS65+"))*100,7,1) "RTN","BIREPL2",232,0) D WRITE(.BILINE,X) "RTN","BIREPL2",233,0) ; "RTN","BIREPL2",234,0) S X=$$PAD(" PPSV23 and PCV15: # patients - fully vaccinated",56) "RTN","BIREPL2",235,0) S X=X_": "_$$C(BITOTS("65+PCV15PPSV23"),0,8) "RTN","BIREPL2",236,0) I BITOTS("PTS65+") S X=X_$J((BITOTS("65+PCV15PPSV23")/BITOTS("PTS65+"))*100,7,1) "RTN","BIREPL2",237,0) D WRITE(.BILINE,X,1) "RTN","BIREPL2",238,0) ; "RTN","BIREPL2",239,0) S X=" Total Patients included who had Refusals on record....:"_$J(BITOTS("REFUSALS"),8) "RTN","BIREPL2",240,0) D WRITE(.BILINE,X,2) "RTN","BIREPL2",241,0) ; "RTN","BIREPL2",242,0) S X=$$PAD(" * * * NEW GPRA COMPOSITE MEASURE SECTION * * *") "RTN","BIREPL2",243,0) D WRITE(.BILINE,X,1) "RTN","BIREPL2",244,0) ; "RTN","BIREPL2",245,0) ;IHS/CMI/LAB - BI*8.5*29 - added HPV lines patch 29 "RTN","BIREPL2",246,0) ;;---> HPV "RTN","BIREPL2",247,0) S X=$$PAD(" Total Number of Patients ages 19 through 26 years",56) "RTN","BIREPL2",248,0) S X=X_": "_$$C(BITOTS("PTS19-26"),0,8) "RTN","BIREPL2",249,0) D WRITE(.BILINE,X,1) "RTN","BIREPL2",250,0) ; "RTN","BIREPL2",251,0) S X=$$PAD(" Received HPV Series complete",56) "RTN","BIREPL2",252,0) S X=X_": "_$$C(BITOTS("19-26HPVC"),0,8) "RTN","BIREPL2",253,0) I BITOTS("PTS19-26") S X=X_$J((BITOTS("19-26HPVC")/BITOTS("PTS19-26"))*100,7,1) "RTN","BIREPL2",254,0) D WRITE(.BILINE,X,1) "RTN","BIREPL2",255,0) ; "RTN","BIREPL2",256,0) ;composite for 19-49 years "RTN","BIREPL2",257,0) S X=$$PAD(" Total Number of Patients ages 19 through 49 years",56)_": " "RTN","BIREPL2",258,0) S X=X_$$C(BITOTS("PTS19-49"),0,8) D WRITE(.BILINE,X,1) "RTN","BIREPL2",259,0) ; "RTN","BIREPL2",260,0) S X=$$PAD(" Received 1 dose of Tdap ever",56) "RTN","BIREPL2",261,0) S X=X_": "_$$C(BITOTS("19-49TDAPEVER"),0,8) "RTN","BIREPL2",262,0) I BITOTS("PTS19-49") S X=X_$J((BITOTS("19-49TDAPEVER")/BITOTS("PTS19-49"))*100,7,1) "RTN","BIREPL2",263,0) D WRITE(.BILINE,X) "RTN","BIREPL2",264,0) ; "RTN","BIREPL2",265,0) S X=$$PAD(" Received 1 dose of Tdap or Td < 10 years",56) "RTN","BIREPL2",266,0) S X=X_": "_$$C(BITOTS("19-49TDAP/TD10YR"),0,8) "RTN","BIREPL2",267,0) I BITOTS("PTS19-49") S X=X_$J((BITOTS("19-49TDAP/TD10YR")/BITOTS("PTS19-49"))*100,7,1) "RTN","BIREPL2",268,0) D WRITE(.BILINE,X) "RTN","BIREPL2",269,0) ; "RTN","BIREPL2",270,0) S X=$$PAD(" Received 1 dose of Tdap ever AND Tdap or Td < 10 yrs",56) "RTN","BIREPL2",271,0) S X=X_": "_$$C(BITOTS("19-49TDAP&TD10YR"),0,8) "RTN","BIREPL2",272,0) I BITOTS("PTS19-49") S X=X_$J((BITOTS("19-49TDAP&TD10YR")/BITOTS("PTS19-49"))*100,7,1) "RTN","BIREPL2",273,0) D WRITE(.BILINE,X) "RTN","BIREPL2",274,0) ; "RTN","BIREPL2",275,0) S X=$$PAD(" Received HEP B Series complete",56) "RTN","BIREPL2",276,0) S X=X_": "_$$C(BITOTS("19-49HEPBC"),0,8) ;p26 piece 3 "RTN","BIREPL2",277,0) I BITOTS("PTS19-49") S X=X_$J((BITOTS("19-49HEPBC")/BITOTS("PTS19-49"))*100,7,1) "RTN","BIREPL2",278,0) D WRITE(.BILINE,X,1) "RTN","BIREPL2",279,0) ; "RTN","BIREPL2",280,0) S X=$$PAD(" Received ALL of the above (appropriately vaccinated)",56) "RTN","BIREPL2",281,0) S X=X_": "_$$C(BITOTS("19-49ALL"),0,8) ;p26 piece 3 "RTN","BIREPL2",282,0) I BITOTS("PTS19-49") S X=X_$J((BITOTS("19-49ALL")/BITOTS("PTS19-49"))*100,7,1) "RTN","BIREPL2",283,0) D WRITE(.BILINE,X,1) "RTN","BIREPL2",284,0) ; "RTN","BIREPL2",285,0) ; composite 50-59 "RTN","BIREPL2",286,0) S X=$$PAD(" Total Number of Patients ages 50 through 59 years",56)_": " "RTN","BIREPL2",287,0) S X=X_$$C(BITOTS("PTS50-59"),0,8) D WRITE(.BILINE,X,1) "RTN","BIREPL2",288,0) ; "RTN","BIREPL2",289,0) S X=$$PAD(" Received 1 dose of Tdap ever",56) "RTN","BIREPL2",290,0) S X=X_": "_$$C(BITOTS("50-59TDAPEVER"),0,8) "RTN","BIREPL2",291,0) I BITOTS("PTS50-59") S X=X_$J((BITOTS("50-59TDAPEVER")/BITOTS("PTS50-59"))*100,7,1) "RTN","BIREPL2",292,0) D WRITE(.BILINE,X) "RTN","BIREPL2",293,0) ; "RTN","BIREPL2",294,0) S X=$$PAD(" Received 1 dose of Tdap or Td < 10 years",56) "RTN","BIREPL2",295,0) S X=X_": "_$$C(BITOTS("50-59TDAP/TD10YR"),0,8) "RTN","BIREPL2",296,0) I BITOTS("PTS50-59") S X=X_$J((BITOTS("50-59TDAP/TD10YR")/BITOTS("PTS50-59"))*100,7,1) "RTN","BIREPL2",297,0) D WRITE(.BILINE,X) "RTN","BIREPL2",298,0) ; "RTN","BIREPL2",299,0) S X=$$PAD(" Received 1 dose of Tdap ever AND Tdap or Td < 10 yrs",56) "RTN","BIREPL2",300,0) S X=X_": "_$$C(BITOTS("50-59TDAP&TD10YR"),0,8) "RTN","BIREPL2",301,0) I BITOTS("PTS50-59") S X=X_$J((BITOTS("50-59TDAP&TD10YR")/BITOTS("PTS50-59"))*100,7,1) "RTN","BIREPL2",302,0) D WRITE(.BILINE,X) "RTN","BIREPL2",303,0) ; "RTN","BIREPL2",304,0) S X=$$PAD(" Received HEP B Series complete",56) "RTN","BIREPL2",305,0) S X=X_": "_$$C(BITOTS("50-59HEPBC"),0,8) ;p26 piece 3 "RTN","BIREPL2",306,0) I BITOTS("PTS50-59") S X=X_$J((BITOTS("50-59HEPBC")/BITOTS("PTS50-59"))*100,7,1) "RTN","BIREPL2",307,0) D WRITE(.BILINE,X) "RTN","BIREPL2",308,0) ; "RTN","BIREPL2",309,0) S X=$$PAD(" Received Shingrix series complete",56) "RTN","BIREPL2",310,0) S X=X_": "_$$C(BITOTS("50-59SHINC"),0,8) ;p26 piece 3 "RTN","BIREPL2",311,0) I BITOTS("PTS50-59") S X=X_$J((BITOTS("50-59SHINC")/BITOTS("PTS50-59"))*100,7,1) "RTN","BIREPL2",312,0) D WRITE(.BILINE,X,1) "RTN","BIREPL2",313,0) ; "RTN","BIREPL2",314,0) S X=$$PAD(" Received ALL of the above (appropriately vaccinated)",56) "RTN","BIREPL2",315,0) S X=X_": "_$$C(BITOTS("50-59ALL"),0,8) ;p26 piece 3 "RTN","BIREPL2",316,0) I BITOTS("PTS50-59") S X=X_$J((BITOTS("50-59ALL")/BITOTS("PTS50-59"))*100,7,1) "RTN","BIREPL2",317,0) D WRITE(.BILINE,X,1) "RTN","BIREPL2",318,0) ; "RTN","BIREPL2",319,0) ; composite 60-65 "RTN","BIREPL2",320,0) S X=$$PAD(" Total Number of Patients ages 60 through 65 years",56)_": " "RTN","BIREPL2",321,0) S X=X_$$C(BITOTS("PTS60-65"),0,8) D WRITE(.BILINE,X,1) "RTN","BIREPL2",322,0) ; "RTN","BIREPL2",323,0) S X=$$PAD(" Received 1 dose of Tdap ever",56) "RTN","BIREPL2",324,0) S X=X_": "_$$C(BITOTS("60-65TDAPEVER"),0,8) "RTN","BIREPL2",325,0) I BITOTS("PTS60-65") S X=X_$J((BITOTS("60-65TDAPEVER")/BITOTS("PTS60-65"))*100,7,1) "RTN","BIREPL2",326,0) D WRITE(.BILINE,X) "RTN","BIREPL2",327,0) ; "RTN","BIREPL2",328,0) S X=$$PAD(" Received 1 dose of Tdap or Td < 10 years",56) "RTN","BIREPL2",329,0) S X=X_": "_$$C(BITOTS("60-65TDAP/TD10YR"),0,8) "RTN","BIREPL2",330,0) I BITOTS("PTS60-65") S X=X_$J((BITOTS("60-65TDAP/TD10YR")/BITOTS("PTS60-65"))*100,7,1) "RTN","BIREPL2",331,0) D WRITE(.BILINE,X) "RTN","BIREPL2",332,0) ; "RTN","BIREPL2",333,0) S X=$$PAD(" Received 1 dose of Tdap ever AND Tdap or Td < 10 yrs",56) "RTN","BIREPL2",334,0) S X=X_": "_$$C(BITOTS("60-65TDAP&TD10YR"),0,8) "RTN","BIREPL2",335,0) I BITOTS("PTS60-65") S X=X_$J((BITOTS("60-65TDAP&TD10YR")/BITOTS("PTS60-65"))*100,7,1) "RTN","BIREPL2",336,0) D WRITE(.BILINE,X) "RTN","BIREPL2",337,0) ; "RTN","BIREPL2",338,0) S X=$$PAD(" Received Shingrix series complete",56) "RTN","BIREPL2",339,0) S X=X_": "_$$C(BITOTS("60-65SHINC"),0,8) ;p26 piece 3 "RTN","BIREPL2",340,0) I BITOTS("PTS60-65") S X=X_$J((BITOTS("60-65SHINC")/BITOTS("PTS60-65"))*100,7,1) "RTN","BIREPL2",341,0) D WRITE(.BILINE,X,1) "RTN","BIREPL2",342,0) ; "RTN","BIREPL2",343,0) S X=$$PAD(" Received ALL of the above (appropriately vaccinated)",56) "RTN","BIREPL2",344,0) S X=X_": "_$$C(BITOTS("60-65ALL"),0,8) ;p26 piece 3 "RTN","BIREPL2",345,0) I BITOTS("PTS60-65") S X=X_$J((BITOTS("60-65ALL")/BITOTS("PTS60-65"))*100,7,1) "RTN","BIREPL2",346,0) D WRITE(.BILINE,X,1) "RTN","BIREPL2",347,0) ;COMPOSITE 66+ "RTN","BIREPL2",348,0) D MORE^BIREPL4 "RTN","BIREPL2",349,0) G E "RTN","BIREPL2",350,0) ; "RTN","BIREPL2",351,0) S X=$$PAD(" Total Number of Patients 19 years and older",56)_": " "RTN","BIREPL2",352,0) S X=X_$$C(BIV(33),0,8) D WRITE(.BILINE,X) "RTN","BIREPL2",353,0) ; "RTN","BIREPL2",354,0) S X=$$PAD(" Total Patients 19 years and older appropriately ",52) "RTN","BIREPL2",355,0) D WRITE(.BILINE,X) "RTN","BIREPL2",356,0) S X=$$PAD(" vaccinated per age recommendations",56) "RTN","BIREPL2",357,0) S X=X_": "_$$C(BIV(34),0,8) "RTN","BIREPL2",358,0) I BIV(33) S X=X_$J((BIV(34)/BIV(33))*100,7,1) "RTN","BIREPL2",359,0) D WRITE(.BILINE,X,1) "RTN","BIREPL2",360,0) ; "RTN","BIREPL2",361,0) S VALMCNT=BILINE "RTN","BIREPL2",362,0) E Q "RTN","BIREPL2",363,0) ; "RTN","BIREPL2",364,0) WRITE(BILINE,BIVAL,BIBLNK) ;EP "RTN","BIREPL2",365,0) ;---> Write lines to ^TMP (see documentation in ^BIW). "RTN","BIREPL2",366,0) ;---> Parameters: "RTN","BIREPL2",367,0) ; 1 - BILINE (ret) Last line# written. "RTN","BIREPL2",368,0) ; 2 - BIVAL (opt) Value/text of line (Null=blank line). "RTN","BIREPL2",369,0) ; 3 - BIBLNK (opt) Number of blank lines to add after line sent. "RTN","BIREPL2",370,0) ; "RTN","BIREPL2",371,0) Q:'$D(BILINE) "RTN","BIREPL2",372,0) D WL^BIW(.BILINE,"BIREPL1",$G(BIVAL),$G(BIBLNK)) "RTN","BIREPL2",373,0) ; "RTN","BIREPL2",374,0) ;--->Set VALMCNT (Listman line count) for errors calls above. "RTN","BIREPL2",375,0) S VALMCNT=BILINE "RTN","BIREPL2",376,0) Q "RTN","BIREPL2",377,0) ; "RTN","BIREPL2",378,0) C(X,X2,X3) ; "RTN","BIREPL2",379,0) D COMMA^%DTC "RTN","BIREPL2",380,0) Q X "RTN","BIREPL2",381,0) ; "RTN","BIREPL2",382,0) PAD(D,L,C) ;EP "RTN","BIREPL2",383,0) Q $$PAD^BIUTL5($G(D),$G(L),".") "RTN","BIREPL4") 0^24^B108865352 "RTN","BIREPL4",1,0) BIREPL4 ;IHS/CMI/MWR - REPORT, ADULT IMM; OCT 15, 2010 ; 30 May 2025 10:36 AM "RTN","BIREPL4",2,0) ;;8.5;IMMUNIZATION;**26,29,30,31**;OCT 24,2011;Build 137 "RTN","BIREPL4",3,0) ;; GATHER DATA FOR ADULT IMMUNIZATION REPORT. "RTN","BIREPL4",4,0) ; "RTN","BIREPL4",5,0) ;---------- "RTN","BIREPL4",6,0) GETVAL ;get value for each line on the report for this patient "RTN","BIREPL4",7,0) S (BIVAL,BI19P,BI60P,BI65P,BI1926,BI1959,BITDAPEV,BITD10YR,BITDBOTH,BIALLAPP,BI66APN,BI65APN)=0 "RTN","BIREPL4",8,0) S (BIHEPB1,BIHEPB2,BIHEPBC,BIHPVD,BIHPVF1,BIHPVF2,BIHPVFC,BISHIN1,BISHINC,BIPCV13,BIPPSV23,BIPCV20,BIPCV15,BIREFUS)=0 "RTN","BIREPL4",9,0) S (BI19P,BI60P,BI65P,BI1926,BI1959,BI50P,BI1964,BI1949,BI5059,BI6065,BI66P)=0 "RTN","BIREPL4",10,0) N X,Y,I,J,T,D,G,V,BD,ED "RTN","BIREPL4",11,0) ;set age variables "RTN","BIREPL4",12,0) S BI19P=1 ;19+ "RTN","BIREPL4",13,0) S:BIAGE>59 BI60P=1 ;60+ "RTN","BIREPL4",14,0) S:BIAGE>64 BI65P=1 ;66+ "RTN","BIREPL4",15,0) I BIAGE<27 S BI1926=1 ;19-26 "RTN","BIREPL4",16,0) I BIAGE<60 S BI1959=1 ;19-59 "RTN","BIREPL4",17,0) I BIAGE>49 S BI50P=1 ;50+ FOR SHINGRIX "RTN","BIREPL4",18,0) I BIAGE<64 S BI1964=1 "RTN","BIREPL4",19,0) I BIAGE<50 S BI1949=1 "RTN","BIREPL4",20,0) I BIAGE>49,BIAGE<60 S BI5059=1 "RTN","BIREPL4",21,0) I BIAGE>59,BIAGE<66 S BI6065=1 "RTN","BIREPL4",22,0) I BIAGE>65 S BI66P=1 "RTN","BIREPL4",23,0) ;---> TETANUS STATS ****************************** "RTN","BIREPL4",24,0) TDS ;---> If Tdap EVER. "RTN","BIREPL4",25,0) I $$TD(BIDFN,BICPTI,BIQDT,2) S BITDAPEV=1 ;tdap ever "RTN","BIREPL4",26,0) I $$TD(BIDFN,BICPTI,BIQDT) S BITD10YR=1 ;TDAP OR TD IN past 10 years "RTN","BIREPL4",27,0) I BITDAPEV,BITD10YR S BITDBOTH=1 "RTN","BIREPL4",28,0) HEPBS ; "RTN","BIREPL4",29,0) I BI1959 D "RTN","BIREPL4",30,0) .S X=$$HEPB(BIDFN,BICPTI,BIQDT) "RTN","BIREPL4",31,0) .I X=1 S BIHEPB1=1 "RTN","BIREPL4",32,0) .I X=2 S BIHEPB2=1 "RTN","BIREPL4",33,0) .I X>2 S BIHEPBC=1 "RTN","BIREPL4",34,0) ; "RTN","BIREPL4",35,0) HPVS ;HPV STATS "RTN","BIREPL4",36,0) I BI1926 D "RTN","BIREPL4",37,0) .N BIHPVD S BIHPVD=$$HPV(BIDFN,BICPTI,BIQDT) "RTN","BIREPL4",38,0) .S:BIHPVD=1 BIHPVF1=1 "RTN","BIREPL4",39,0) .S:BIHPVD=2 BIHPVF2=1 "RTN","BIREPL4",40,0) .S:BIHPVD>2 BIHPVFC=1 "RTN","BIREPL4",41,0) ; "RTN","BIREPL4",42,0) SHINS ;---> Shingrix stats ************ "RTN","BIREPL4",43,0) I BI50P D "RTN","BIREPL4",44,0) .S X=$$SHINGRIX(BIDFN,BICPTI,BIQDT) "RTN","BIREPL4",45,0) .I X=1 S BISHIN1=1 "RTN","BIREPL4",46,0) .I X>1 S BISHINC=1 "RTN","BIREPL4",47,0) ; "RTN","BIREPL4",48,0) PNEUMOS ;---> Pneumo stats ****** "RTN","BIREPL4",49,0) ;set pcv13, PCV15, PCV20,PPSV23 "RTN","BIREPL4",50,0) S BIPCV13=$$PCV13^BIREPL1(BIDFN,BICPTI,BIQDT) "RTN","BIREPL4",51,0) S BIPCV15=$$PCV15^BIREPL1(BIDFN,BICPTI,BIQDT) "RTN","BIREPL4",52,0) S BIPCV20=$$PCV20^BIREPL1(BIDFN,BICPTI,BIQDT) "RTN","BIREPL4",53,0) S BIPPSV23=$$PPSV23^BIREPL1(BIDFN,BICPTI,BIQDT) "RTN","BIREPL4",54,0) REFS ; "RTN","BIREPL4",55,0) ;---> Add refusals, if any. "RTN","BIREPL4",56,0) N Z D REFUSAL^BIUTL13(BIDFN,.Z) I $O(Z(0)) S BIREFUS=1 "RTN","BIREPL4",57,0) Q "RTN","BIREPL4",58,0) ; "RTN","BIREPL4",59,0) ; "RTN","BIREPL4",60,0) ;---------- "RTN","BIREPL4",61,0) TD(BIDFN,BICPTI,BIQDT,BITDAP) ;EP "RTN","BIREPL4",62,0) ;---> Return 1 if patient received TD during 10 years prior to QDT. "RTN","BIREPL4",63,0) ;---> Parameters: "RTN","BIREPL4",64,0) ; 1 - BIDFN (req) Patient DFN "RTN","BIREPL4",65,0) ; 2 - BICPTI (opt) 1=Include CPT Coded Visits, 0=Ignore CPT. "RTN","BIREPL4",66,0) ; 3 - BIQDT (opt) Quarter Ending Date (ignore Visits after this date). "RTN","BIREPL4",67,0) ; 4 - BITDAP (opt) 1=Tdap ONLY during 10 years prior to QDT. "RTN","BIREPL4",68,0) ; 2=Tdap ONLY and EVER (no prior date restriction). "RTN","BIREPL4",69,0) ; "RTN","BIREPL4",70,0) ;---> Check V Imms for TD's. "RTN","BIREPL4",71,0) N BICVXS,BIDATE "RTN","BIREPL4",72,0) S BIDATE=0 S:('$G(BIQDT)) BIQDT=$G(DT) "RTN","BIREPL4",73,0) S BITDAP=+$G(BITDAP) "RTN","BIREPL4",74,0) S BICVXS="9,113,115,138,139" "RTN","BIREPL4",75,0) S:BITDAP BICVXS="115,113" "RTN","BIREPL4",76,0) ;V8.5 PATCH 31 - FID- "RTN","BIREPL4",77,0) S BIDATE=$$LASTIMM^BIUTL11(BIDFN,BICVXS,BIQDT) "RTN","BIREPL4",78,0) ; "RTN","BIREPL4",79,0) ;---> So, BIDATE is the latest TD in V Imm (but not after the QDT). "RTN","BIREPL4",80,0) ; "RTN","BIREPL4",81,0) ;---> Check (if requested) V CPTs for TD's. "RTN","BIREPL4",82,0) D:$G(BICPTI) "RTN","BIREPL4",83,0) .N BICPTS,Y "RTN","BIREPL4",84,0) .S BICPTS="90714,90715" "RTN","BIREPL4",85,0) .S:BITDAP BICPTS=90715 "RTN","BIREPL4",86,0) .S Y=$$LASTCPT^BIUTL11(BIDFN,BICPTS,BIQDT) "RTN","BIREPL4",87,0) .S:Y>$G(BIDATE) BIDATE=Y "RTN","BIREPL4",88,0) ; "RTN","BIREPL4",89,0) ;********** PATCH 12, v8.5, OCT 24,2011, IHS/CMI/MWR "RTN","BIREPL4",90,0) ;---> If BITDAP=2, return 1 if Tdap EVER. "RTN","BIREPL4",91,0) I BITDAP=2 Q $S(BIDATE:1,1:0) "RTN","BIREPL4",92,0) ;********** "RTN","BIREPL4",93,0) ; "RTN","BIREPL4",94,0) ;---> Return 0 if last Td was MORE than 10 yrs prior to QDT (or never); "RTN","BIREPL4",95,0) ;---> otherwise return 1. "RTN","BIREPL4",96,0) Q $S((BIDATE+100000) Return # shingrix doses "RTN","BIREPL4",103,0) ;---> Parameters: "RTN","BIREPL4",104,0) ; 1 - BIDFN (req) Patient DFN "RTN","BIREPL4",105,0) ; 2 - BICPTI (opt) 1=Include CPT Coded Visits, 0=Ignore CPT. "RTN","BIREPL4",106,0) ; 3 - BIQDT (opt) Quarter Ending Date (ignore Visits after this date). "RTN","BIREPL4",107,0) ; "RTN","BIREPL4",108,0) ;---> Check V Imms for Shingrix "RTN","BIREPL4",109,0) N BICVXS,BIDATE,BIABD,J,I,C,BICPTS,Y,BIDOSES "RTN","BIREPL4",110,0) S BIDATE=0 S:('$G(BIQDT)) BIQDT=$G(DT) "RTN","BIREPL4",111,0) S BICVXS="187,188" "RTN","BIREPL4",112,0) S BIDATE=$$LASTIMM^BIUTL11(BIDFN,BICVXS,BIQDT,1) "RTN","BIREPL4",113,0) ;set array by date "RTN","BIREPL4",114,0) F I=1:1 S J=$P(BIDATE,",",I) Q:J="" S BIABD(J)="" "RTN","BIREPL4",115,0) ; "RTN","BIREPL4",116,0) ;---> Check (if requested) V CPTs for Shingrix. "RTN","BIREPL4",117,0) D:$G(BICPTI) "RTN","BIREPL4",118,0) .S BICPTS="90750" "RTN","BIREPL4",119,0) .S Y=$$LASTCPT^BIUTL11(BIDFN,BICPTS,BIQDT,1) "RTN","BIREPL4",120,0) .F I=1:1 S J=$P(BIDATE,",",I) Q:J="" S BIABD(J)="" "RTN","BIREPL4",121,0) ; "RTN","BIREPL4",122,0) ;---> Return # of doses "RTN","BIREPL4",123,0) S BIDOSES=0 "RTN","BIREPL4",124,0) S J=0 F S J=$O(BIABD(J)) Q:J'=+J S BIDOSES=BIDOSES+1 "RTN","BIREPL4",125,0) Q BIDOSES "RTN","BIREPL4",126,0) ; "RTN","BIREPL4",127,0) ; "RTN","BIREPL4",128,0) ;---------- "RTN","BIREPL4",129,0) HPV(BIDFN,BICPTI,BIQDT) ;EP "RTN","BIREPL4",130,0) ;---> Return number of HPV's patient received, concat "RTN","BIREPL4",131,0) ;---> Parameters: "RTN","BIREPL4",132,0) ; 1 - BIDFN (req) Patient DFN "RTN","BIREPL4",133,0) ; 2 - BICPTI (opt) 1=Include CPT Coded Visits, 0=Ignore CPT. "RTN","BIREPL4",134,0) ; 3 - BIQDT (opt) Quarter Ending Date (ignore Visits after this date). "RTN","BIREPL4",135,0) ; "RTN","BIREPL4",136,0) ;---> Check V Imms for FLU's. "RTN","BIREPL4",137,0) N BICVXS,BIDATE,BIDOSES,I,J,BIABD,T,D,BD,ED,G,V,X,ON2,F "RTN","BIREPL4",138,0) S BIDATE=0,BIDOSES=0,J=0,ON2="" "RTN","BIREPL4",139,0) S:('$G(BIQDT)) BIQDT=$G(DT) "RTN","BIREPL4",140,0) ;set up array by date "RTN","BIREPL4",141,0) ;GET FIRST ONE'S DATE "RTN","BIREPL4",142,0) ;now get all of them "RTN","BIREPL4",143,0) S BICVXS="62,118,137,165" "RTN","BIREPL4",144,0) S BIDATE=$$LASTIMM^BIUTL11(BIDFN,BICVXS,BIQDT,1) "RTN","BIREPL4",145,0) ;set up array by date "RTN","BIREPL4",146,0) F I=1:1 S J=$P(BIDATE,",",I) Q:J="" S BIABD(J)="" "RTN","BIREPL4",147,0) ; "RTN","BIREPL4",148,0) ;---> Check (if requested) V CPTs for HPV's. "RTN","BIREPL4",149,0) D:$G(BICPTI) "RTN","BIREPL4",150,0) .N BICPTS,J S J=0 "RTN","BIREPL4",151,0) .S BICPTS="90649,90650,90651" "RTN","BIREPL4",152,0) .S BIDATE=$$LASTCPT^BIUTL11(BIDFN,BICPTS,BIQDT,1) "RTN","BIREPL4",153,0) .F I=1:1 S J=$P(BIDATE,",",I) Q:J="" S BIABD(J)="" "RTN","BIREPL4",154,0) ; "RTN","BIREPL4",155,0) S G="" F I=1:1 S J=$P(BIDATE,",",I) Q:J="" S:G="" G=J S:J2 Q 3 "RTN","BIREPL4",159,0) I ON2,BIDOSES>1 Q 3 "RTN","BIREPL4",160,0) Q BIDOSES "RTN","BIREPL4",161,0) HEPB(BIDFN,BICPTI,BIQDT) ;EP "RTN","BIREPL4",162,0) ;get all immunizations "RTN","BIREPL4",163,0) NEW BIABD,I,J,T,D,BD,ED,G,V,X "RTN","BIREPL4",164,0) ;check 2 dose first "RTN","BIREPL4",165,0) S BICVXS="189" "RTN","BIREPL4",166,0) S D=$$LASTIMM^BIUTL11(BIDFN,BICVXS,BIQDT,1) "RTN","BIREPL4",167,0) ;set up array by date "RTN","BIREPL4",168,0) F I=1:1 S J=$P(D,",",I) Q:J="" S BIABD(J)="" "RTN","BIREPL4",169,0) ;go through and set into array if 10 days apart "RTN","BIREPL4",170,0) ;now get cpts "RTN","BIREPL4",171,0) G:'BICPTI HEPB21 "RTN","BIREPL4",172,0) S ED=9999999-BIQDT,BD=9999999-$$DOB^AUPNPAT(BIDFN),G=0 "RTN","BIREPL4",173,0) F S ED=$O(^AUPNVSIT("AA",BIDFN,ED)) Q:ED=""!($P(ED,".")>BD) D "RTN","BIREPL4",174,0) .S V=0 F S V=$O(^AUPNVSIT("AA",BIDFN,ED,V)) Q:V'=+V D "RTN","BIREPL4",175,0) ..Q:'$D(^AUPNVSIT(V,0)) "RTN","BIREPL4",176,0) ..S X=0 F S X=$O(^AUPNVCPT("AD",V,X)) Q:X'=+X D "RTN","BIREPL4",177,0) ...S Y=$P(^AUPNVCPT(X,0),U) S Z=$P($$CPT^ICPTCOD(Y),U,2) I Z=90743 S BIABD(9999999-$P(ED,"."))="" "RTN","BIREPL4",178,0) ..S X=0 F S X=$O(^AUPNVTC("AD",V,X)) Q:X'=+X D "RTN","BIREPL4",179,0) ...S Y=$P(^AUPNVTC(X,0),U,7) Q:'Y S Z=$P($$CPT^ICPTCOD(Y),U,2) I Z=90743 S BIABD(9999999-$P(ED,"."))="" "RTN","BIREPL4",180,0) HEPB21 ; "RTN","BIREPL4",181,0) S BIABD=0,X=0 F S X=$O(BIABD(X)) Q:X'=+X S BIABD=BIABD+1 "RTN","BIREPL4",182,0) I BIABD>1 Q 3 ;2 DOSE MEANS COMPLETE SERIES SO SET TO 3 "RTN","BIREPL4",183,0) ; "RTN","BIREPL4",184,0) ;CHECK 3 DOSE "RTN","BIREPL4",185,0) S BICVXS="8,42,43,44,45,51,102,104,110,132,146,189,193,198,220" "RTN","BIREPL4",186,0) S D=$$LASTIMM^BIUTL11(BIDFN,BICVXS,BIQDT,1) "RTN","BIREPL4",187,0) ;set up array by date "RTN","BIREPL4",188,0) F I=1:1 S J=$P(D,",",I) Q:J="" S BIABD(J)="" "RTN","BIREPL4",189,0) ;go through and set into array if 10 days apart "RTN","BIREPL4",190,0) ;now get cpts "RTN","BIREPL4",191,0) G:'BICPTI HEPB1 "RTN","BIREPL4",192,0) S ED=9999999-BIQDT,BD=9999999-$$DOB^AUPNPAT(BIDFN),G=0 "RTN","BIREPL4",193,0) S T=$O(^ATXAX("B","BGP HEPATITIS CPTS",0)) "RTN","BIREPL4",194,0) F S ED=$O(^AUPNVSIT("AA",BIDFN,ED)) Q:ED=""!($P(ED,".")>BD) D "RTN","BIREPL4",195,0) .S V=0 F S V=$O(^AUPNVSIT("AA",BIDFN,ED,V)) Q:V'=+V D "RTN","BIREPL4",196,0) ..Q:'$D(^AUPNVSIT(V,0)) "RTN","BIREPL4",197,0) ..S X=0 F S X=$O(^AUPNVCPT("AD",V,X)) Q:X'=+X D "RTN","BIREPL4",198,0) ...S Y=$P(^AUPNVCPT(X,0),U) S Z=$P($$CPT^ICPTCOD(Y),U,2) I $$ICD^ATXAPI(Y,T,1) S BIABD(9999999-$P(ED,"."))="" "RTN","BIREPL4",199,0) ..S X=0 F S X=$O(^AUPNVTC("AD",V,X)) Q:X'=+X D "RTN","BIREPL4",200,0) ...S Y=$P(^AUPNVTC(X,0),U,7) Q:'Y S Z=$P($$CPT^ICPTCOD(Y),U,2) I $$ICD^ATXAPI(Y,T,1) S BIABD(9999999-$P(ED,"."))="" "RTN","BIREPL4",201,0) HEPB1 ;now check to see if they are all spaced 10 days apart, if not, kill off the odd ones "RTN","BIREPL4",202,0) S X="",Y="",C=0 F S X=$O(BIABD(X)) Q:X'=+X S C=C+1 D "RTN","BIREPL4",203,0) .I C=1 S Y=X Q "RTN","BIREPL4",204,0) .I $$FMDIFF^XLFDT(X,Y)<11 K BIABD(X) Q "RTN","BIREPL4",205,0) .S Y=X "RTN","BIREPL4",206,0) ;now count them and see if there are 3 of them "RTN","BIREPL4",207,0) S BIABD=0,X=0 F S X=$O(BIABD(X)) Q:X'=+X S BIABD=BIABD+1 "RTN","BIREPL4",208,0) Q BIABD "RTN","BIREPL4",209,0) ; "RTN","BIREPL4",210,0) MORE ;EP - called from birepl2 "RTN","BIREPL4",211,0) ; composite 66+ "RTN","BIREPL4",212,0) S X=$$PAD(" Total Number of Patients 66 years and older",56)_": " "RTN","BIREPL4",213,0) S X=X_$$C(BITOTS("PTS66+"),0,8) D WRITE^BIREPL2(.BILINE,X,1) "RTN","BIREPL4",214,0) ; "RTN","BIREPL4",215,0) S X=$$PAD(" Received 1 dose of Tdap ever",56) "RTN","BIREPL4",216,0) S X=X_": "_$$C(BITOTS("66+TDAPEVER"),0,8) "RTN","BIREPL4",217,0) I BITOTS("PTS66+") S X=X_$J((BITOTS("66+TDAPEVER")/BITOTS("PTS66+"))*100,7,1) "RTN","BIREPL4",218,0) D WRITE^BIREPL2(.BILINE,X) "RTN","BIREPL4",219,0) ; "RTN","BIREPL4",220,0) S X=$$PAD(" Received 1 dose of Tdap or Td < 10 years",56) "RTN","BIREPL4",221,0) S X=X_": "_$$C(BITOTS("66+TDAP/TD10YR"),0,8) "RTN","BIREPL4",222,0) I BITOTS("PTS66+") S X=X_$J((BITOTS("66+TDAP/TD10YR")/BITOTS("PTS66+"))*100,7,1) "RTN","BIREPL4",223,0) D WRITE^BIREPL2(.BILINE,X) "RTN","BIREPL4",224,0) ; "RTN","BIREPL4",225,0) S X=$$PAD(" Received 1 dose of Tdap ever AND Tdap or Td < 10 yrs",56) "RTN","BIREPL4",226,0) S X=X_": "_$$C(BITOTS("66+TDAP&TD10YR"),0,8) "RTN","BIREPL4",227,0) I BITOTS("PTS66+") S X=X_$J((BITOTS("66+TDAP&TD10YR")/BITOTS("PTS66+"))*100,7,1) "RTN","BIREPL4",228,0) D WRITE^BIREPL2(.BILINE,X) "RTN","BIREPL4",229,0) ; "RTN","BIREPL4",230,0) S X=$$PAD(" Received Shingrix series complete",56) "RTN","BIREPL4",231,0) S X=X_": "_$$C(BITOTS("66+SHINC"),0,8) ;p26 piece 3 "RTN","BIREPL4",232,0) I BITOTS("PTS66+") S X=X_$J((BITOTS("66+SHINC")/BITOTS("PTS66+"))*100,7,1) "RTN","BIREPL4",233,0) D WRITE^BIREPL2(.BILINE,X,1) "RTN","BIREPL4",234,0) ; "RTN","BIREPL4",235,0) S X=$$PAD(" Must meet ONE of the following:") "RTN","BIREPL4",236,0) D WRITE^BIREPL2(.BILINE,X) "RTN","BIREPL4",237,0) ; "RTN","BIREPL4",238,0) S X=$$PAD(" Received 1 dose of PCV13 AND 1 dose PPSV23",56) "RTN","BIREPL4",239,0) S X=X_": "_$$C(BITOTS("66+PCV13PPSV23"),0,8) "RTN","BIREPL4",240,0) I BITOTS("PTS66+") S X=X_$J((BITOTS("66+PCV13PPSV23")/BITOTS("PTS66+"))*100,7,1) "RTN","BIREPL4",241,0) D WRITE^BIREPL2(.BILINE,X) "RTN","BIREPL4",242,0) ; "RTN","BIREPL4",243,0) S X=$$PAD(" Received 1 dose of PCV20",56) "RTN","BIREPL4",244,0) S X=X_": "_$$C(BITOTS("66+PCV20"),0,8) "RTN","BIREPL4",245,0) I BITOTS("PTS66+") S X=X_$J((BITOTS("66+PCV20")/BITOTS("PTS66+"))*100,7,1) "RTN","BIREPL4",246,0) D WRITE^BIREPL2(.BILINE,X) "RTN","BIREPL4",247,0) ; "RTN","BIREPL4",248,0) S X=$$PAD(" Received 1 dose of PCV15 AND 1 dose of PPSV23",56) "RTN","BIREPL4",249,0) S X=X_": "_$$C(BITOTS("66+PCV15PPSV23"),0,8) "RTN","BIREPL4",250,0) I BITOTS("PTS66+") S X=X_$J((BITOTS("66+PCV15PPSV23")/BITOTS("PTS66+"))*100,7,1) "RTN","BIREPL4",251,0) D WRITE^BIREPL2(.BILINE,X) "RTN","BIREPL4",252,0) ; "RTN","BIREPL4",253,0) S X=$$PAD(" Received 1 of the above - fully vaccinated for Pneumo",56) "RTN","BIREPL4",254,0) S X=X_": "_$$C(BITOTS("66+ANYPNEU"),0,8) "RTN","BIREPL4",255,0) I BITOTS("PTS66+") S X=X_$J((BITOTS("66+ANYPNEU")/BITOTS("PTS66+"))*100,7,1) "RTN","BIREPL4",256,0) D WRITE^BIREPL2(.BILINE,X,1) "RTN","BIREPL4",257,0) ; "RTN","BIREPL4",258,0) S X=$$PAD(" Must meet ONE of the following:") "RTN","BIREPL4",259,0) D WRITE^BIREPL2(.BILINE,X) "RTN","BIREPL4",260,0) ; "RTN","BIREPL4",261,0) S X=$$PAD(" Received 1 dose of Tdap AND Tdap/Td <10 years AND Shingrix") "RTN","BIREPL4",262,0) D WRITE^BIREPL2(.BILINE,X) "RTN","BIREPL4",263,0) S X=$$PAD(" series complete and 1 dose PCV13 AND 1 dose PPSV23",56) "RTN","BIREPL4",264,0) S X=X_": "_$$C(BITOTS("66+MET1"),0,8) "RTN","BIREPL4",265,0) I BITOTS("PTS66+") S X=X_$J((BITOTS("66+MET1")/BITOTS("PTS66+"))*100,7,1) "RTN","BIREPL4",266,0) D WRITE^BIREPL2(.BILINE,X) "RTN","BIREPL4",267,0) ; "RTN","BIREPL4",268,0) S X=$$PAD(" Received 1 dose of Tdap AND Tdap/Td <10 years AND Shingrix") "RTN","BIREPL4",269,0) D WRITE^BIREPL2(.BILINE,X) "RTN","BIREPL4",270,0) S X=$$PAD(" series complete and 1 dose PCV20",56) "RTN","BIREPL4",271,0) S X=X_": "_$$C(BITOTS("66+MET2"),0,8) "RTN","BIREPL4",272,0) I BITOTS("PTS66+") S X=X_$J((BITOTS("66+MET2")/BITOTS("PTS66+"))*100,7,1) "RTN","BIREPL4",273,0) D WRITE^BIREPL2(.BILINE,X) "RTN","BIREPL4",274,0) ; "RTN","BIREPL4",275,0) S X=$$PAD(" Received 1 dose of Tdap AND Tdap/Td <10 years AND Shingrix") "RTN","BIREPL4",276,0) D WRITE^BIREPL2(.BILINE,X) "RTN","BIREPL4",277,0) S X=$$PAD(" series complete and 1 dose PCV15 AND 1 dose PPSV23",56) "RTN","BIREPL4",278,0) S X=X_": "_$$C(BITOTS("66+MET3"),0,8) "RTN","BIREPL4",279,0) I BITOTS("PTS66+") S X=X_$J((BITOTS("66+MET3")/BITOTS("PTS66+"))*100,7,1) "RTN","BIREPL4",280,0) D WRITE^BIREPL2(.BILINE,X,1) "RTN","BIREPL4",281,0) ; "RTN","BIREPL4",282,0) S X=$$PAD(" Met one of the above (fully vaccinated)",56) "RTN","BIREPL4",283,0) S X=X_": "_$$C((BITOTS("66+MET1")+BITOTS("66+MET2")+BITOTS("66+MET3")),0,8) "RTN","BIREPL4",284,0) I BITOTS("PTS66+") S X=X_$J(((BITOTS("66+MET1")+BITOTS("66+MET2")+BITOTS("66+MET3"))/BITOTS("PTS66+"))*100,7,1) "RTN","BIREPL4",285,0) D WRITE^BIREPL2(.BILINE,X,2) "RTN","BIREPL4",286,0) ; "RTN","BIREPL4",287,0) S X=$$PAD(" Total Number of Patients 19 years and older",56)_": " "RTN","BIREPL4",288,0) S X=X_$$C(BITOTS("PTS19+"),0,8) D WRITE^BIREPL2(.BILINE,X,1) "RTN","BIREPL4",289,0) ; "RTN","BIREPL4",290,0) S X=$$PAD(" Total Patients 19 years and older appropriately") "RTN","BIREPL4",291,0) D WRITE^BIREPL2(.BILINE,X) "RTN","BIREPL4",292,0) S X=$$PAD(" vaccinated per age recommendations",56) "RTN","BIREPL4",293,0) S X=X_": "_$$C(BITOTS("ALLAPP"),0,8) "RTN","BIREPL4",294,0) I BITOTS("PTS19+") S X=X_$J((BITOTS("ALLAPP")/BITOTS("PTS19+"))*100,7,1) "RTN","BIREPL4",295,0) D WRITE^BIREPL2(.BILINE,X) "RTN","BIREPL4",296,0) Q "RTN","BIREPL4",297,0) ; "RTN","BIREPL4",298,0) ; "RTN","BIREPL4",299,0) C(X,X2,X3) ; "RTN","BIREPL4",300,0) D COMMA^%DTC "RTN","BIREPL4",301,0) Q X "RTN","BIREPL4",302,0) ; "RTN","BIREPL4",303,0) ; "RTN","BIREPL4",304,0) ;---------- "RTN","BIREPL4",305,0) PAD(D,L,C) ;EP "RTN","BIREPL4",306,0) Q $$PAD^BIUTL5($G(D),$G(L),".") "RTN","BIREPL5") 0^16^B225461531 "RTN","BIREPL5",1,0) BIREPL5 ;IHS/CMI/MWR - REPORT, ADULT IMM; MAY 10, 2010 "RTN","BIREPL5",2,0) ;;8.5;IMMUNIZATION;**31**;OCT 24,2011;Build 137 "RTN","BIREPL5",3,0) ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS * "RTN","BIREPL5",4,0) ; "RTN","BIREPL5",5,0) ; "RTN","BIREPL5",6,0) S(A) ; "RTN","BIREPL5",7,0) Q $$STRIP^XLFSTR(A," ") "RTN","BIREPL5",8,0) ; "RTN","BIREPL5",9,0) P(A) ; "RTN","BIREPL5",10,0) Q $P(A,"#")_"%," "RTN","BIREPL5",11,0) ;---------- "RTN","BIREPL5",12,0) CSV(BITOTS,BILINE) ;EP "RTN","BIREPL5",13,0) ;---> Write Adult Stats for display. "RTN","BIREPL5",14,0) ;---> Parameters: "RTN","BIREPL5",15,0) ; 1 - BITOTS (req) "RTN","BIREPL5",16,0) ; "RTN","BIREPL5",17,0) ; 1 - BILINE (ret) Number of lines written to Listman scroll area. "RTN","BIREPL5",18,0) ; "RTN","BIREPL5",19,0) I '$D(BITOTS) D ERRCD^BIUTL2(667,.X) D W(.BILINE,X) Q "RTN","BIREPL5",20,0) ; "RTN","BIREPL5",21,0) ; "RTN","BIREPL5",22,0) S X="Total Number of Patients 19 years and older," "RTN","BIREPL5",23,0) S X=X_+(BITOTS("PTS19+")) D W(.BILINE,X,2) "RTN","BIREPL5",24,0) ; "RTN","BIREPL5",25,0) S X="TETANUS: patients Tdap EVER #," "RTN","BIREPL5",26,0) S X=X_+BITOTS("19+TDAPEVER") D W(.BILINE,X) "RTN","BIREPL5",27,0) S X=$$P(X) "RTN","BIREPL5",28,0) I 'BITOTS("PTS19+") S X=X_0 "RTN","BIREPL5",29,0) I BITOTS("PTS19+") S X=X_$$S($J((BITOTS("19+TDAPEVER")/BITOTS("PTS19+"))*100,0,1)) I 1 "RTN","BIREPL5",30,0) D W(.BILINE,X) "RTN","BIREPL5",31,0) ; "RTN","BIREPL5",32,0) S X="TETANUS: patients Tdap EVER AND [Td OR Tdap in past 10 years] #," "RTN","BIREPL5",33,0) S X=X_+BITOTS("19+TDAP&TD10YR") D W(.BILINE,X) "RTN","BIREPL5",34,0) S X=$$P(X) "RTN","BIREPL5",35,0) I 'BITOTS("PTS19+") S X=X_0 "RTN","BIREPL5",36,0) I BITOTS("PTS19+") S X=X_$$S($J((BITOTS("19+TDAP&TD10YR")/BITOTS("PTS19+"))*100,0,1)) I 1 "RTN","BIREPL5",37,0) D W(.BILINE,X,1) "RTN","BIREPL5",38,0) ; "RTN","BIREPL5",39,0) ;---> HEPB "RTN","BIREPL5",40,0) ; "RTN","BIREPL5",41,0) D W(.BILINE," ") "RTN","BIREPL5",42,0) S X="Total Number of Patients 19-59," "RTN","BIREPL5",43,0) S X=X_+BITOTS("PTS19-59") D W(.BILINE,X,1) "RTN","BIREPL5",44,0) ; "RTN","BIREPL5",45,0) S X=" HEP B: patients - Series initiated #," "RTN","BIREPL5",46,0) S X=X_BITOTS("19-59HEPB1") D W(.BILINE,X) "RTN","BIREPL5",47,0) S X=$$P(X) "RTN","BIREPL5",48,0) I BITOTS("PTS19-59") S X=X_$$S($J((BITOTS("19-59HEPB1")/BITOTS("PTS19-59"))*100,0,1)) I 1 "RTN","BIREPL5",49,0) E S X=X_0 "RTN","BIREPL5",50,0) D W(.BILINE,X) "RTN","BIREPL5",51,0) ; "RTN","BIREPL5",52,0) S X=" HEP B: patients - Dose 2 initiated #," "RTN","BIREPL5",53,0) S X=X_+BITOTS("19-59HEPB2") D W(.BILINE,X) "RTN","BIREPL5",54,0) S X=$$P(X) "RTN","BIREPL5",55,0) I BITOTS("PTS19-59") S X=X_$$S($J((BITOTS("19-59HEPB2")/BITOTS("PTS19-59"))*100,0,1)) I 1 "RTN","BIREPL5",56,0) E S X=X_0 "RTN","BIREPL5",57,0) D W(.BILINE,X) "RTN","BIREPL5",58,0) ; "RTN","BIREPL5",59,0) S X=" HEP B: patients - Series completed #," "RTN","BIREPL5",60,0) S X=X_+(BITOTS("19-59HEPBC")) D W(.BILINE,X) "RTN","BIREPL5",61,0) S X=$$P(X) "RTN","BIREPL5",62,0) I BITOTS("PTS19-59") S X=X_$J((BITOTS("19-59HEPBC")/BITOTS("PTS19-59"))*100,0,1) I 1 "RTN","BIREPL5",63,0) E S X=X_0 "RTN","BIREPL5",64,0) D W(.BILINE,X,1) "RTN","BIREPL5",65,0) ; "RTN","BIREPL5",66,0) ;;---> HPV "RTN","BIREPL5",67,0) D W(.BILINE," ") "RTN","BIREPL5",68,0) S X="Total Number of Patients age 19-26 #," "RTN","BIREPL5",69,0) S X=X_+BITOTS("PTS19-26") D W(.BILINE,X) "RTN","BIREPL5",70,0) S X=$$P(X) "RTN","BIREPL5",71,0) I BITOTS("PTS19+") S X=X_$J((BITOTS("PTS19-26")/BITOTS("PTS19+"))*100,0,1) I 1 "RTN","BIREPL5",72,0) E S X=X_0 "RTN","BIREPL5",73,0) D W(.BILINE,X,1) "RTN","BIREPL5",74,0) ; "RTN","BIREPL5",75,0) S X=" HPV: patients - Series initiated #," "RTN","BIREPL5",76,0) S X=X_+(BITOTS("19-26HPV1")) D W(.BILINE,X) "RTN","BIREPL5",77,0) S X=$$P(X) "RTN","BIREPL5",78,0) I BITOTS("PTS19-26") S X=X_$J((BITOTS("19-26HPV1")/BITOTS("PTS19-26"))*100,0,1) I 1 "RTN","BIREPL5",79,0) E S X=X_0 "RTN","BIREPL5",80,0) D W(.BILINE,X) "RTN","BIREPL5",81,0) ; "RTN","BIREPL5",82,0) S X=" HPV: patients - Dose 2 initiated #," "RTN","BIREPL5",83,0) S X=X_+(BITOTS("19-26HPV2")) D W(.BILINE,X) "RTN","BIREPL5",84,0) S X=$$P(X) "RTN","BIREPL5",85,0) I BITOTS("PTS19-26") S X=X_$J((BITOTS("19-26HPV2")/BITOTS("PTS19-26"))*100,0,1) I 1 "RTN","BIREPL5",86,0) E S X=X_0 "RTN","BIREPL5",87,0) D W(.BILINE,X) "RTN","BIREPL5",88,0) ; "RTN","BIREPL5",89,0) S X=" HPV: patients - Series completed #," "RTN","BIREPL5",90,0) S X=X_+(BITOTS("19-26HPVC")) D W(.BILINE,X) "RTN","BIREPL5",91,0) S X=$$P(X) "RTN","BIREPL5",92,0) I BITOTS("PTS19-26") S X=X_$J((BITOTS("19-26HPVC")/BITOTS("PTS19-26"))*100,0,1) I 1 "RTN","BIREPL5",93,0) E S X=X_0 "RTN","BIREPL5",94,0) D W(.BILINE,X,1) "RTN","BIREPL5",95,0) ; "RTN","BIREPL5",96,0) ;** "RTN","BIREPL5",97,0) ; "RTN","BIREPL5",98,0) ;---> Total patients over 50 and shingrix "RTN","BIREPL5",99,0) S X="Total Number of Patients 50 years and older #," "RTN","BIREPL5",100,0) S X=X_+(BITOTS("PTS50+")) D W(.BILINE,X) "RTN","BIREPL5",101,0) S X=$$P(X) "RTN","BIREPL5",102,0) I BITOTS("PTS19+") S X=X_$J((BITOTS("PTS50+")/BITOTS("PTS19+"))*100,0,1) I 1 "RTN","BIREPL5",103,0) E S X=X_0 "RTN","BIREPL5",104,0) D W(.BILINE,X,1) "RTN","BIREPL5",105,0) ; "RTN","BIREPL5",106,0) S X=" Shingrix: patients - Series initiated #," "RTN","BIREPL5",107,0) S X=X_+(BITOTS("50+SHINGRIX1")) D W(.BILINE,X) "RTN","BIREPL5",108,0) S X=$$P(X) "RTN","BIREPL5",109,0) I BITOTS("PTS50+") S X=X_$J((BITOTS("50+SHINGRIX1")/BITOTS("PTS50+"))*100,0,1) I 1 "RTN","BIREPL5",110,0) E S X=X_0 "RTN","BIREPL5",111,0) D W(.BILINE,X) "RTN","BIREPL5",112,0) ; "RTN","BIREPL5",113,0) S X=" Shingrix: patients - Series completed #," "RTN","BIREPL5",114,0) S X=X_+(BITOTS("50+SHINGRIXC")) D W(.BILINE,X) "RTN","BIREPL5",115,0) S X=$$P(X) "RTN","BIREPL5",116,0) I BITOTS("PTS50+") S X=X_$J((BITOTS("50+SHINGRIXC")/BITOTS("PTS50+"))*100,0,1) I 1 "RTN","BIREPL5",117,0) E S X=X_0 "RTN","BIREPL5",118,0) D W(.BILINE,X,1) "RTN","BIREPL5",119,0) ; "RTN","BIREPL5",120,0) ;19-64 lines "RTN","BIREPL5",121,0) S X="Total Number of Patients age 19-64 #," "RTN","BIREPL5",122,0) S X=X_+(BITOTS("PTS19-64")) D W(.BILINE,X) "RTN","BIREPL5",123,0) S X=$$P(X) "RTN","BIREPL5",124,0) I BITOTS("PTS19+") S X=X_$J((BITOTS("PTS19-64")/BITOTS("PTS19+"))*100,0,1) I 1 "RTN","BIREPL5",125,0) E S X=X_0 "RTN","BIREPL5",126,0) D W(.BILINE,X,1) "RTN","BIREPL5",127,0) ; "RTN","BIREPL5",128,0) S X="PCV13 and PPSV23: patients - fully vaccinated #," "RTN","BIREPL5",129,0) S X=X_+(BITOTS("19-64PCV13PPSV23")) D W(.BILINE,X) "RTN","BIREPL5",130,0) S X=$$P(X) "RTN","BIREPL5",131,0) I BITOTS("PTS19-64") S X=X_$J((BITOTS("19-64PCV13PPSV23")/BITOTS("PTS19-64"))*100,0,1) I 1 "RTN","BIREPL5",132,0) E S X=X_0 "RTN","BIREPL5",133,0) D W(.BILINE,X) "RTN","BIREPL5",134,0) ; "RTN","BIREPL5",135,0) S X=" PCV20: patients - fully vaccinated #," "RTN","BIREPL5",136,0) S X=X_+(BITOTS("19-64PCV20")) D W(.BILINE,X) "RTN","BIREPL5",137,0) S X=$$P(X) "RTN","BIREPL5",138,0) I BITOTS("PTS19-64") S X=X_$J((BITOTS("19-64PCV20")/BITOTS("PTS19-64"))*100,0,1) I 1 "RTN","BIREPL5",139,0) E S X=X_0 "RTN","BIREPL5",140,0) D W(.BILINE,X) "RTN","BIREPL5",141,0) ; "RTN","BIREPL5",142,0) S X=" PPSV23 and PCV15: patients - fully vaccinated #," "RTN","BIREPL5",143,0) S X=X_+(BITOTS("19-64PCV15PPSV23")) D W(.BILINE,X) "RTN","BIREPL5",144,0) S X=$$P(X) "RTN","BIREPL5",145,0) I BITOTS("PTS19-64") S X=X_$J((BITOTS("19-64PCV15PPSV23")/BITOTS("PTS19-64"))*100,0,1) I 1 "RTN","BIREPL5",146,0) E S X=X_0 "RTN","BIREPL5",147,0) D W(.BILINE,X,1) "RTN","BIREPL5",148,0) ; "RTN","BIREPL5",149,0) ;65 and older lines "RTN","BIREPL5",150,0) S X="Total Number of Patients 65 years and older #," "RTN","BIREPL5",151,0) S X=X_+(BITOTS("PTS65+")) D W(.BILINE,X) "RTN","BIREPL5",152,0) S X=$$P(X) "RTN","BIREPL5",153,0) I BITOTS("PTS19+") S X=X_$J((BITOTS("PTS65+")/BITOTS("PTS19+"))*100,0,1) I 1 "RTN","BIREPL5",154,0) E S X=X_0 "RTN","BIREPL5",155,0) D W(.BILINE,X,1) "RTN","BIREPL5",156,0) ; "RTN","BIREPL5",157,0) S X=" Tetanus: patients w/Td/Tdap in past 10 years #," "RTN","BIREPL5",158,0) S X=X_+(BITOTS("65+TDAP/TD10YR")) D W(.BILINE,X) "RTN","BIREPL5",159,0) S X=$$P(X) "RTN","BIREPL5",160,0) I BITOTS("PTS65+") S X=X_$J((BITOTS("65+TDAP/TD10YR")/BITOTS("PTS65+"))*100,0,1) I 1 "RTN","BIREPL5",161,0) E S X=X_0 "RTN","BIREPL5",162,0) D W(.BILINE,X) "RTN","BIREPL5",163,0) ; "RTN","BIREPL5",164,0) S X="PCV13 and PPSV23: patients - fully vaccinated #," "RTN","BIREPL5",165,0) S X=X_+(BITOTS("65+PCV13PPSV23")) D W(.BILINE,X) "RTN","BIREPL5",166,0) S X=$$P(X) "RTN","BIREPL5",167,0) I BITOTS("PTS65+") S X=X_$J((BITOTS("65+PCV13PPSV23")/BITOTS("PTS65+"))*100,0,1) I 1 "RTN","BIREPL5",168,0) E S X=X_0 "RTN","BIREPL5",169,0) D W(.BILINE,X) "RTN","BIREPL5",170,0) ; "RTN","BIREPL5",171,0) S X="PCV20: patients - fully vaccinated #," "RTN","BIREPL5",172,0) S X=X_+(BITOTS("65+PCV20")) D W(.BILINE,X) "RTN","BIREPL5",173,0) S X=$$P(X) "RTN","BIREPL5",174,0) I BITOTS("PTS65+") S X=X_$J((BITOTS("65+PCV20")/BITOTS("PTS65+"))*100,0,1) I 1 "RTN","BIREPL5",175,0) E S X=X_0 "RTN","BIREPL5",176,0) D W(.BILINE,X) "RTN","BIREPL5",177,0) ; "RTN","BIREPL5",178,0) S X="PPSV23 and PCV15: patients - fully vaccinated #," "RTN","BIREPL5",179,0) S X=X_+(BITOTS("65+PCV15PPSV23")) D W(.BILINE,X) "RTN","BIREPL5",180,0) S X=$$P(X) "RTN","BIREPL5",181,0) I BITOTS("PTS65+") S X=X_$J((BITOTS("65+PCV15PPSV23")/BITOTS("PTS65+"))*100,0,1) I 1 "RTN","BIREPL5",182,0) E S X=X_0 "RTN","BIREPL5",183,0) D W(.BILINE,X,1) "RTN","BIREPL5",184,0) ; "RTN","BIREPL5",185,0) ;---> Now write total patients considered who had refusals. "RTN","BIREPL5",186,0) S X=" Total Patients included who had Refusals on record,"_+BITOTS("REFUSALS") "RTN","BIREPL5",187,0) D W(.BILINE,X,2) "RTN","BIREPL5",188,0) ; "RTN","BIREPL5",189,0) ; "RTN","BIREPL5",190,0) ; "RTN","BIREPL5",191,0) S X="* * * NEW GPRA COMPOSITE MEASURE SECTION * * *" "RTN","BIREPL5",192,0) D W(.BILINE,X,1) "RTN","BIREPL5",193,0) ; "RTN","BIREPL5",194,0) ;IHS/CMI/LAB - BI*8.5*29 - added HPV lines patch 29 "RTN","BIREPL5",195,0) ;;---> HPV "RTN","BIREPL5",196,0) S X="Total Number of Patients ages 19 through 26 years," "RTN","BIREPL5",197,0) S X=X_+(BITOTS("PTS19-26")) "RTN","BIREPL5",198,0) D W(.BILINE,X,1) "RTN","BIREPL5",199,0) ; "RTN","BIREPL5",200,0) S X="Received HPV Series complete #," "RTN","BIREPL5",201,0) S X=X_+(BITOTS("19-26HPVC")) D W(.BILINE,X) "RTN","BIREPL5",202,0) S X=$$P(X) "RTN","BIREPL5",203,0) I BITOTS("PTS19-26") S X=X_$J((BITOTS("19-26HPVC")/BITOTS("PTS19-26"))*100,0,1) I 1 "RTN","BIREPL5",204,0) E S X=X_0 "RTN","BIREPL5",205,0) D W(.BILINE,X,1) "RTN","BIREPL5",206,0) ; "RTN","BIREPL5",207,0) ;composite for 19-49 years "RTN","BIREPL5",208,0) ; "RTN","BIREPL5",209,0) S X="Total Number of Patients ages 19 through 49 years #," "RTN","BIREPL5",210,0) S X=X_+(BITOTS("PTS19-49")) D W(.BILINE,X,1) "RTN","BIREPL5",211,0) ; "RTN","BIREPL5",212,0) S X="Received 1 dose of Tdap ever #," "RTN","BIREPL5",213,0) S X=X_+(BITOTS("19-49TDAPEVER")) D W(.BILINE,X) "RTN","BIREPL5",214,0) S X=$$P(X) "RTN","BIREPL5",215,0) I BITOTS("PTS19-49") S X=X_$J((BITOTS("19-49TDAPEVER")/BITOTS("PTS19-49"))*100,0,1) I 1 "RTN","BIREPL5",216,0) E S X=X_0 "RTN","BIREPL5",217,0) D W(.BILINE,X) "RTN","BIREPL5",218,0) ; "RTN","BIREPL5",219,0) S X="Received 1 dose of Tdap or Td < 10 years #," "RTN","BIREPL5",220,0) S X=X_+(BITOTS("19-49TDAP/TD10YR")) D W(.BILINE,X) "RTN","BIREPL5",221,0) S X=$$P(X) "RTN","BIREPL5",222,0) I BITOTS("PTS19-49") S X=X_$J((BITOTS("19-49TDAP/TD10YR")/BITOTS("PTS19-49"))*100,0,1) I 1 "RTN","BIREPL5",223,0) E S X=X_0 "RTN","BIREPL5",224,0) D W(.BILINE,X) "RTN","BIREPL5",225,0) ; "RTN","BIREPL5",226,0) S X="Received 1 dose of Tdap ever AND Tdap or Td < 10 yrs #," "RTN","BIREPL5",227,0) S X=X_+(BITOTS("19-49TDAP&TD10YR")) D W(.BILINE,X) "RTN","BIREPL5",228,0) S X=$$P(X) "RTN","BIREPL5",229,0) I BITOTS("PTS19-49") S X=X_$J((BITOTS("19-49TDAP&TD10YR")/BITOTS("PTS19-49"))*100,0,1) I 1 "RTN","BIREPL5",230,0) E S X=X_0 "RTN","BIREPL5",231,0) D W(.BILINE,X) "RTN","BIREPL5",232,0) ; "RTN","BIREPL5",233,0) S X="Received HEP B Series complete #," "RTN","BIREPL5",234,0) S X=X_+(BITOTS("19-49HEPBC")) D W(.BILINE,X) "RTN","BIREPL5",235,0) S X=$$P(X) "RTN","BIREPL5",236,0) I BITOTS("PTS19-49") S X=X_$J((BITOTS("19-49HEPBC")/BITOTS("PTS19-49"))*100,0,1) I 1 "RTN","BIREPL5",237,0) E S X=X_0 "RTN","BIREPL5",238,0) D W(.BILINE,X,1) "RTN","BIREPL5",239,0) ; "RTN","BIREPL5",240,0) S X="Received ALL of the above (appropriately vaccinated) #," "RTN","BIREPL5",241,0) S X=X_+(BITOTS("19-49ALL")) D W(.BILINE,X) "RTN","BIREPL5",242,0) S X=$$P(X) "RTN","BIREPL5",243,0) I BITOTS("PTS19-49") S X=X_$J((BITOTS("19-49ALL")/BITOTS("PTS19-49"))*100,0,1) I 1 "RTN","BIREPL5",244,0) E S X=X_0 "RTN","BIREPL5",245,0) D W(.BILINE,X,1) "RTN","BIREPL5",246,0) ; "RTN","BIREPL5",247,0) ; composite 50-59 "RTN","BIREPL5",248,0) S X="Total Number of Patients ages 50 through 59 years #," "RTN","BIREPL5",249,0) S X=X_+(BITOTS("PTS50-59")) D W(.BILINE,X,1) "RTN","BIREPL5",250,0) ; "RTN","BIREPL5",251,0) S X="Received 1 dose of Tdap ever #," "RTN","BIREPL5",252,0) S X=X_+(BITOTS("50-59TDAPEVER")) D W(.BILINE,X) "RTN","BIREPL5",253,0) S X=$$P(X) "RTN","BIREPL5",254,0) I BITOTS("PTS50-59") S X=X_$J((BITOTS("50-59TDAPEVER")/BITOTS("PTS50-59"))*100,0,1) I 1 "RTN","BIREPL5",255,0) E S X=X_0 "RTN","BIREPL5",256,0) D W(.BILINE,X) "RTN","BIREPL5",257,0) ; "RTN","BIREPL5",258,0) S X="Received 1 dose of Tdap or Td < 10 years #," "RTN","BIREPL5",259,0) S X=X_+(BITOTS("50-59TDAP/TD10YR")) D W(.BILINE,X) "RTN","BIREPL5",260,0) S X=$$P(X) "RTN","BIREPL5",261,0) I BITOTS("PTS50-59") S X=X_$J((BITOTS("50-59TDAP/TD10YR")/BITOTS("PTS50-59"))*100,0,1) I 1 "RTN","BIREPL5",262,0) E S X=X_0 "RTN","BIREPL5",263,0) D W(.BILINE,X) "RTN","BIREPL5",264,0) ; "RTN","BIREPL5",265,0) S X="Received 1 dose of Tdap ever AND Tdap or Td < 10 yrs #," "RTN","BIREPL5",266,0) S X=X_+(BITOTS("50-59TDAP&TD10YR")) D W(.BILINE,X) "RTN","BIREPL5",267,0) S X=$$P(X) "RTN","BIREPL5",268,0) I BITOTS("PTS50-59") S X=X_$J((BITOTS("50-59TDAP&TD10YR")/BITOTS("PTS50-59"))*100,0,1) I 1 "RTN","BIREPL5",269,0) E S X=X_0 "RTN","BIREPL5",270,0) D W(.BILINE,X) "RTN","BIREPL5",271,0) ; "RTN","BIREPL5",272,0) S X="Received HEP B Series complete #," "RTN","BIREPL5",273,0) S X=X_+(BITOTS("50-59HEPBC")) D W(.BILINE,X) "RTN","BIREPL5",274,0) S X=$$P(X) "RTN","BIREPL5",275,0) I BITOTS("PTS50-59") S X=X_$J((BITOTS("50-59HEPBC")/BITOTS("PTS50-59"))*100,0,1) I 1 "RTN","BIREPL5",276,0) E S X=X_0 "RTN","BIREPL5",277,0) D W(.BILINE,X) "RTN","BIREPL5",278,0) ; "RTN","BIREPL5",279,0) S X="Received Shingrix series complete #," "RTN","BIREPL5",280,0) S X=X_+(BITOTS("50-59SHINC")) D W(.BILINE,X) "RTN","BIREPL5",281,0) S X=$$P(X) "RTN","BIREPL5",282,0) I BITOTS("PTS50-59") S X=X_$J((BITOTS("50-59SHINC")/BITOTS("PTS50-59"))*100,0,1) I 1 "RTN","BIREPL5",283,0) E S X=X_0 "RTN","BIREPL5",284,0) D W(.BILINE,X,1) "RTN","BIREPL5",285,0) ; "RTN","BIREPL5",286,0) S X="Received ALL of the above (appropriately vaccinated) #," "RTN","BIREPL5",287,0) S X=X_+(BITOTS("50-59ALL")) D W(.BILINE,X) "RTN","BIREPL5",288,0) S X=$$P(X) "RTN","BIREPL5",289,0) I BITOTS("PTS50-59") S X=X_$J((BITOTS("50-59ALL")/BITOTS("PTS50-59"))*100,0,1) I 1 "RTN","BIREPL5",290,0) E S X=X_0 "RTN","BIREPL5",291,0) D W(.BILINE,X,1) "RTN","BIREPL5",292,0) ; "RTN","BIREPL5",293,0) ; composite 60-65 "RTN","BIREPL5",294,0) S X="Total Number of Patients ages 60 through 65 years," "RTN","BIREPL5",295,0) S X=X_+(BITOTS("PTS60-65")) D W(.BILINE,X,1) "RTN","BIREPL5",296,0) ; "RTN","BIREPL5",297,0) S X="Received 1 dose of Tdap ever #," "RTN","BIREPL5",298,0) S X=X_+(BITOTS("60-65TDAPEVER")) D W(.BILINE,X) "RTN","BIREPL5",299,0) S X=$$P(X) "RTN","BIREPL5",300,0) I BITOTS("PTS60-65") S X=X_$J((BITOTS("60-65TDAPEVER")/BITOTS("PTS60-65"))*100,0,1) I 1 "RTN","BIREPL5",301,0) E S X=X_0 "RTN","BIREPL5",302,0) D W(.BILINE,X) "RTN","BIREPL5",303,0) ; "RTN","BIREPL5",304,0) S X="Received 1 dose of Tdap or Td < 10 years #," "RTN","BIREPL5",305,0) S X=X_+(BITOTS("60-65TDAP/TD10YR")) D W(.BILINE,X) "RTN","BIREPL5",306,0) S X=$$P(X) "RTN","BIREPL5",307,0) I BITOTS("PTS60-65") S X=X_$J((BITOTS("60-65TDAP/TD10YR")/BITOTS("PTS60-65"))*100,0,1) I 1 "RTN","BIREPL5",308,0) E S X=X_0 "RTN","BIREPL5",309,0) D W(.BILINE,X) "RTN","BIREPL5",310,0) ; "RTN","BIREPL5",311,0) S X="Received 1 dose of Tdap ever AND Tdap or Td < 10 yrs #," "RTN","BIREPL5",312,0) S X=X_+(BITOTS("60-65TDAP&TD10YR")) D W(.BILINE,X) "RTN","BIREPL5",313,0) S X=$$P(X) "RTN","BIREPL5",314,0) I BITOTS("PTS60-65") S X=X_$J((BITOTS("60-65TDAP&TD10YR")/BITOTS("PTS60-65"))*100,0,1) I 1 "RTN","BIREPL5",315,0) E S X=X_0 "RTN","BIREPL5",316,0) D W(.BILINE,X) "RTN","BIREPL5",317,0) ; "RTN","BIREPL5",318,0) S X="Received Shingrix series complete #," "RTN","BIREPL5",319,0) S X=X_+(BITOTS("60-65SHINC")) D W(.BILINE,X) "RTN","BIREPL5",320,0) S X=$$P(X) "RTN","BIREPL5",321,0) I BITOTS("PTS60-65") S X=X_$J((BITOTS("60-65SHINC")/BITOTS("PTS60-65"))*100,0,1) I 1 "RTN","BIREPL5",322,0) E S X=X_0 "RTN","BIREPL5",323,0) D W(.BILINE,X,1) "RTN","BIREPL5",324,0) ; "RTN","BIREPL5",325,0) S X="Received ALL of the above (appropriately vaccinated) #," "RTN","BIREPL5",326,0) S X=X_+(BITOTS("60-65ALL")) D W(.BILINE,X) "RTN","BIREPL5",327,0) S X=$$P(X) "RTN","BIREPL5",328,0) I BITOTS("PTS60-65") S X=X_$J((BITOTS("60-65ALL")/BITOTS("PTS60-65"))*100,0,1) I 1 "RTN","BIREPL5",329,0) E S X=X_0 "RTN","BIREPL5",330,0) D W(.BILINE,X,1) "RTN","BIREPL5",331,0) ;COMPOSITE 66+ "RTN","BIREPL5",332,0) D MORE "RTN","BIREPL5",333,0) E Q "RTN","BIREPL5",334,0) ; "RTN","BIREPL5",335,0) ; "RTN","BIREPL5",336,0) ;---------- "RTN","BIREPL5",337,0) W(BILINE,BIVAL,BIBLNK) ;EP "RTN","BIREPL5",338,0) ;---> Write lines to ^TMP (see documentation in ^BIW). "RTN","BIREPL5",339,0) ;---> Parameters: "RTN","BIREPL5",340,0) ; 1 - BILINE (ret) Last line# written. "RTN","BIREPL5",341,0) ; 2 - BIVAL (opt) Value/text of line (Null=blank line). "RTN","BIREPL5",342,0) ; 3 - BIBLNK (opt) Number of blank lines to add after line sent. "RTN","BIREPL5",343,0) ; "RTN","BIREPL5",344,0) Q:'$D(BILINE) "RTN","BIREPL5",345,0) D WL^BIW(.BILINE,"BIREPL1",$G(BIVAL),$G(BIBLNK)) "RTN","BIREPL5",346,0) ; "RTN","BIREPL5",347,0) ;--->Set VALMCNT (Listman line count) for errors calls above. "RTN","BIREPL5",348,0) S VALMCNT=BILINE "RTN","BIREPL5",349,0) Q "RTN","BIREPL5",350,0) ; "RTN","BIREPL5",351,0) ; "RTN","BIREPL5",352,0) C(X,X2,X3) ; "RTN","BIREPL5",353,0) D COMMA^%DTC "RTN","BIREPL5",354,0) Q $$STRIP^XLFSTR(X," ") "RTN","BIREPL5",355,0) ; "RTN","BIREPL5",356,0) ; "RTN","BIREPL5",357,0) MORE ; "RTN","BIREPL5",358,0) ; composite 66+ "RTN","BIREPL5",359,0) S X="Total Number of Patients 66 years and older," "RTN","BIREPL5",360,0) S X=X_+(BITOTS("PTS66+")) D W(.BILINE,X,1) "RTN","BIREPL5",361,0) ; "RTN","BIREPL5",362,0) S X="Received 1 dose of Tdap ever #," "RTN","BIREPL5",363,0) S X=X_+(BITOTS("66+TDAPEVER")) D W(.BILINE,X) "RTN","BIREPL5",364,0) S X=$$P(X) "RTN","BIREPL5",365,0) I BITOTS("PTS66+") S X=X_$J((BITOTS("66+TDAPEVER")/BITOTS("PTS66+"))*100,0,1) I 1 "RTN","BIREPL5",366,0) E S X=X_0 "RTN","BIREPL5",367,0) D W(.BILINE,X) "RTN","BIREPL5",368,0) ; "RTN","BIREPL5",369,0) S X="Received 1 dose of Tdap or Td < 10 years #," "RTN","BIREPL5",370,0) S X=X_+(BITOTS("66+TDAP/TD10YR")) D W(.BILINE,X) "RTN","BIREPL5",371,0) S X=$$P(X) "RTN","BIREPL5",372,0) I BITOTS("PTS66+") S X=X_$J((BITOTS("66+TDAP/TD10YR")/BITOTS("PTS66+"))*100,0,1) I 1 "RTN","BIREPL5",373,0) E S X=X_0 "RTN","BIREPL5",374,0) D W(.BILINE,X) "RTN","BIREPL5",375,0) ; "RTN","BIREPL5",376,0) S X="Received 1 dose of Tdap ever AND Tdap or Td < 10 yrs #," "RTN","BIREPL5",377,0) S X=X_+(BITOTS("66+TDAP&TD10YR")) D W(.BILINE,X) "RTN","BIREPL5",378,0) S X=$$P(X) "RTN","BIREPL5",379,0) I BITOTS("PTS66+") S X=X_$J((BITOTS("66+TDAP&TD10YR")/BITOTS("PTS66+"))*100,0,1) I 1 "RTN","BIREPL5",380,0) E S X=X_0 "RTN","BIREPL5",381,0) D W(.BILINE,X) "RTN","BIREPL5",382,0) ; "RTN","BIREPL5",383,0) S X="Received Shingrix series complete #," "RTN","BIREPL5",384,0) S X=X_+(BITOTS("66+SHINC")) D W(.BILINE,X) "RTN","BIREPL5",385,0) S X=$$P(X) "RTN","BIREPL5",386,0) I BITOTS("PTS66+") S X=X_$J((BITOTS("66+SHINC")/BITOTS("PTS66+"))*100,0,1) I 1 "RTN","BIREPL5",387,0) E S X=X_0 "RTN","BIREPL5",388,0) D W(.BILINE,X,1) "RTN","BIREPL5",389,0) ; "RTN","BIREPL5",390,0) S X="Must meet ONE of the following:" "RTN","BIREPL5",391,0) D W(.BILINE,X) "RTN","BIREPL5",392,0) ; "RTN","BIREPL5",393,0) S X="Received 1 dose of PCV13 AND 1 dose PPSV23 #," "RTN","BIREPL5",394,0) S X=X_+(BITOTS("66+PCV13PPSV23")) D W(.BILINE,X) "RTN","BIREPL5",395,0) S X=$$P(X) "RTN","BIREPL5",396,0) I BITOTS("PTS66+") S X=X_$J((BITOTS("66+PCV13PPSV23")/BITOTS("PTS66+"))*100,0,1) I 1 "RTN","BIREPL5",397,0) E S X=X_0 "RTN","BIREPL5",398,0) D W(.BILINE,X) "RTN","BIREPL5",399,0) ; "RTN","BIREPL5",400,0) S X="Received 1 dose of PCV20 #," "RTN","BIREPL5",401,0) S X=X_+(BITOTS("66+PCV20")) D W(.BILINE,X) "RTN","BIREPL5",402,0) S X=$$P(X) "RTN","BIREPL5",403,0) I BITOTS("PTS66+") S X=X_$J((BITOTS("66+PCV20")/BITOTS("PTS66+"))*100,0,1) I 1 "RTN","BIREPL5",404,0) E S X=X_0 "RTN","BIREPL5",405,0) D W(.BILINE,X) "RTN","BIREPL5",406,0) ; "RTN","BIREPL5",407,0) S X="Received 1 dose of PCV15 AND 1 dose of PPSV23 #," "RTN","BIREPL5",408,0) S X=X_+(BITOTS("66+PCV15PPSV23")) D W(.BILINE,X) "RTN","BIREPL5",409,0) S X=$$P(X) "RTN","BIREPL5",410,0) I BITOTS("PTS66+") S X=X_$J((BITOTS("66+PCV15PPSV23")/BITOTS("PTS66+"))*100,0,1) I 1 "RTN","BIREPL5",411,0) E S X=X_0 "RTN","BIREPL5",412,0) D W(.BILINE,X) "RTN","BIREPL5",413,0) ; "RTN","BIREPL5",414,0) S X="Received 1 of the above - fully vaccinated for Pneumo #," "RTN","BIREPL5",415,0) S X=X_+(BITOTS("66+ANYPNEU")) D W(.BILINE,X) "RTN","BIREPL5",416,0) S X=$$P(X) "RTN","BIREPL5",417,0) I BITOTS("PTS66+") S X=X_$J((BITOTS("66+ANYPNEU")/BITOTS("PTS66+"))*100,0,1) I 1 "RTN","BIREPL5",418,0) E S X=X_0 "RTN","BIREPL5",419,0) D W(.BILINE,X,1) "RTN","BIREPL5",420,0) ; "RTN","BIREPL5",421,0) S X="Must meet ONE of the following:" "RTN","BIREPL5",422,0) D W(.BILINE,X) "RTN","BIREPL5",423,0) ; "RTN","BIREPL5",424,0) S X="Received 1 dose of Tdap AND Tdap/Td <10 years AND Shingrix series complete and 1 dose PCV13 AND 1 dose PPSV23 #," "RTN","BIREPL5",425,0) S X=X_+(BITOTS("66+MET1")) D W(.BILINE,X) "RTN","BIREPL5",426,0) S X=$$P(X) "RTN","BIREPL5",427,0) I BITOTS("PTS66+") S X=X_$J((BITOTS("66+MET1")/BITOTS("PTS66+"))*100,0,1) I 1 "RTN","BIREPL5",428,0) E S X=X_0 "RTN","BIREPL5",429,0) D W(.BILINE,X) "RTN","BIREPL5",430,0) ; "RTN","BIREPL5",431,0) S X="Received 1 dose of Tdap AND Tdap/Td <10 years AND Shingrix series complete and 1 dose PCV20 #," "RTN","BIREPL5",432,0) S X=X_+(BITOTS("66+MET2")) D W(.BILINE,X) "RTN","BIREPL5",433,0) S X=$$P(X) "RTN","BIREPL5",434,0) I BITOTS("PTS66+") S X=X_$J((BITOTS("66+MET2")/BITOTS("PTS66+"))*100,0,1) I 1 "RTN","BIREPL5",435,0) E S X=X_0 "RTN","BIREPL5",436,0) D W(.BILINE,X) "RTN","BIREPL5",437,0) ; "RTN","BIREPL5",438,0) S X="Received 1 dose of Tdap AND Tdap/Td <10 years AND Shingrix series complete and 1 dose PCV15 AND 1 dose PPSV23 #," "RTN","BIREPL5",439,0) S X=X_+(BITOTS("66+MET3")) D W(.BILINE,X) "RTN","BIREPL5",440,0) S X=$$P(X) "RTN","BIREPL5",441,0) I BITOTS("PTS66+") S X=X_$J((BITOTS("66+MET3")/BITOTS("PTS66+"))*100,0,1) I 1 "RTN","BIREPL5",442,0) E S X=X_0 "RTN","BIREPL5",443,0) D W(.BILINE,X,1) "RTN","BIREPL5",444,0) ; "RTN","BIREPL5",445,0) S X="Met one of the above (fully vaccinated) #," "RTN","BIREPL5",446,0) S X=X_+((BITOTS("66+MET1")+BITOTS("66+MET2")+BITOTS("66+MET3"))) D W(.BILINE,X) "RTN","BIREPL5",447,0) S X=$$P(X) "RTN","BIREPL5",448,0) I BITOTS("PTS66+") S X=X_$J(((BITOTS("66+MET1")+BITOTS("66+MET2")+BITOTS("66+MET3"))/BITOTS("PTS66+"))*100,0,1) I 1 "RTN","BIREPL5",449,0) E S X=X_0 "RTN","BIREPL5",450,0) D W(.BILINE,X,2) "RTN","BIREPL5",451,0) ; "RTN","BIREPL5",452,0) S X="Total Number of Patients 19 years and older," "RTN","BIREPL5",453,0) S X=X_+(BITOTS("PTS19+")) D W(.BILINE,X,1) "RTN","BIREPL5",454,0) ; "RTN","BIREPL5",455,0) S X="Total Patients 19 years and older appropriately vaccinated per age recommendations #," "RTN","BIREPL5",456,0) S X=X_+(BITOTS("ALLAPP")) D W(.BILINE,X) "RTN","BIREPL5",457,0) S X=$$P(X) "RTN","BIREPL5",458,0) I BITOTS("PTS19+") S X=X_$J((BITOTS("ALLAPP")/BITOTS("PTS19+"))*100,0,1) I 1 "RTN","BIREPL5",459,0) E S X=X_0 "RTN","BIREPL5",460,0) D W(.BILINE,X) "RTN","BIREPL5",461,0) Q "RTN","BIREPQ1") 0^10^B25087044 "RTN","BIREPQ1",1,0) BIREPQ1 ;IHS/CMI/MWR - REPORT, QUARTERLY IMM; MAY 10, 2010 "RTN","BIREPQ1",2,0) ;;8.5;IMMUNIZATION;**31**;OCT 24,2011;Build 137 "RTN","BIREPQ1",3,0) ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS * "RTN","BIREPQ1",4,0) ;; VIEW OR PRINT QUARTERLY IMMUNIZATION REPORT. "RTN","BIREPQ1",5,0) ; "RTN","BIREPQ1",6,0) ; "RTN","BIREPQ1",7,0) ;---------- "RTN","BIREPQ1",8,0) START(BIX) ;EP "RTN","BIREPQ1",9,0) ;---> VIEW Quarterly Report. "RTN","BIREPQ1",10,0) ;---> Prepare and display Quarterly Immunization Report. "RTN","BIREPQ1",11,0) ;---> Parameters: "RTN","BIREPQ1",12,0) ; 1 - BIX (req) If BIX="PRINT", then print Qtr Report. "RTN","BIREPQ1",13,0) ; If BIX="VIEW", then view Qtr Report (default). "RTN","BIREPQ1",14,0) ;---> Variables: "RTN","BIREPQ1",15,0) ; 1 - BIQDT (req) Quarter Ending Date. "RTN","BIREPQ1",16,0) ; 2 - BICC (req) Current Community array. "RTN","BIREPQ1",17,0) ; 3 - BIHCF (req) Health Care Facility array. "RTN","BIREPQ1",18,0) ; 4 - BICM (req) Case Manager array. "RTN","BIREPQ1",19,0) ; 5 - BIBEN (req) Beneficiary Type array. "RTN","BIREPQ1",20,0) ; 6 - BIHPV (opt) 1=Include Varicella & Pneumo. "RTN","BIREPQ1",21,0) ; 7 - BIPOP (ret) BIPOP=1 if error. "RTN","BIREPQ1",22,0) ; "RTN","BIREPQ1",23,0) ;---> Check for required Variables. "RTN","BIREPQ1",24,0) I '$G(BIQDT) D ERROR(622) D RESET^BIREPQ Q "RTN","BIREPQ1",25,0) I '$D(BICC) D ERROR(614) D RESET^BIREPQ Q "RTN","BIREPQ1",26,0) I '$D(BIHCF) D ERROR(625) D RESET^BIREPQ Q "RTN","BIREPQ1",27,0) I '$D(BICM) D ERROR(615) D RESET^BIREPQ Q "RTN","BIREPQ1",28,0) I '$D(BIBEN) D ERROR(662) D RESET^BIREPQ Q "RTN","BIREPQ1",29,0) S:'$D(BIHPV) BIHPV=1 "RTN","BIREPQ1",30,0) S:$G(BIUP)="" BIUP="u" "RTN","BIREPQ1",31,0) ; "RTN","BIREPQ1",32,0) D SETVARS^BIUTL5 N VALMCNT "RTN","BIREPQ1",33,0) S BISPD=BIX "RTN","BIREPQ1",34,0) I $G(BIX)="PRINT" D PRINT,RESET^BIREPQ Q "RTN","BIREPQ1",35,0) ;IHS/CMI/LAB - patch 31 csv output "RTN","BIREPQ1",36,0) ;I DUZ=2881 S BIX="CSV" "RTN","BIREPQ1",37,0) I $G(BIX)="CSV" D DELIM^BIREPCSV("BIREPQ1","QUARTERLY REPORT","QTR"),RESET^BIREPQ Q "RTN","BIREPQ1",38,0) ; "RTN","BIREPQ1",39,0) ;---> Set BIAG for Age Range in header of report. "RTN","BIREPQ1",40,0) ;---> Set BIRPDT for Report Date ("Quarterly, etc.). "RTN","BIREPQ1",41,0) ;---> Set BIRTN in case user runs Patient List then needs to return "RTN","BIREPQ1",42,0) ;---> to INIT here. "RTN","BIREPQ1",43,0) ;---> Set BITITL for Report Name in Patient List, if called. vvv83 "RTN","BIREPQ1",44,0) N BIAG,BIRPDT,BIRTN,BITITL "RTN","BIREPQ1",45,0) S BIAG="3-27",BIRPDT=BIQDT,BIRTN="BIREPQ1",BITITL="3-27 MONTH" "RTN","BIREPQ1",46,0) D EN "RTN","BIREPQ1",47,0) D RESET^BIREPQ "RTN","BIREPQ1",48,0) Q "RTN","BIREPQ1",49,0) ; "RTN","BIREPQ1",50,0) ; "RTN","BIREPQ1",51,0) ;---------- "RTN","BIREPQ1",52,0) PRINT ;EP "RTN","BIREPQ1",53,0) ;---> Main entry point for printing the Quarterly Immunization Report. "RTN","BIREPQ1",54,0) D DEVICE(.BIPOP) "RTN","BIREPQ1",55,0) Q:$G(BIPOP) "RTN","BIREPQ1",56,0) ; "RTN","BIREPQ1",57,0) D:$G(IO)'=$G(IO(0)) "RTN","BIREPQ1",58,0) .W !!?10,"This may take some time. Please hold on...",! "RTN","BIREPQ1",59,0) ; "RTN","BIREPQ1",60,0) ;---> Prepare report. "RTN","BIREPQ1",61,0) K ^TMP("BIREPQ1",$J),^TMP("BIDUL",$J) "RTN","BIREPQ1",62,0) N VALM,VALMHDR "RTN","BIREPQ1",63,0) D HDR,START^BIREPQ2(BIQDT,.BICC,.BIHCF,.BICM,.BIBEN,BIHPV,BIUP) "RTN","BIREPQ1",64,0) ; "RTN","BIREPQ1",65,0) D PRTLST^BIUTL8("BIREPQ1") "RTN","BIREPQ1",66,0) D EXIT,RESET^BIREPQ "RTN","BIREPQ1",67,0) Q "RTN","BIREPQ1",68,0) ; "RTN","BIREPQ1",69,0) ; "RTN","BIREPQ1",70,0) ;---------- "RTN","BIREPQ1",71,0) EN ;EP "RTN","BIREPQ1",72,0) ;---> Main entry point for List Template BI REPORT QUARTERLY IMM1. "RTN","BIREPQ1",73,0) D EN^VALM("BI REPORT QUARTERLY IMM1") "RTN","BIREPQ1",74,0) Q "RTN","BIREPQ1",75,0) ; "RTN","BIREPQ1",76,0) ; "RTN","BIREPQ1",77,0) ;---------- "RTN","BIREPQ1",78,0) HDR ;EP "RTN","BIREPQ1",79,0) ;---> Header code "RTN","BIREPQ1",80,0) D HEAD^BIREPQ2(BIQDT,.BICC,.BIHCF,.BICM,.BIBEN,BIUP) "RTN","BIREPQ1",81,0) Q "RTN","BIREPQ1",82,0) ; "RTN","BIREPQ1",83,0) ; "RTN","BIREPQ1",84,0) ;---------- "RTN","BIREPQ1",85,0) INIT ;EP "RTN","BIREPQ1",86,0) ;---> Initialize variables and list array. "RTN","BIREPQ1",87,0) K ^TMP("BIREPQ1",$J),^TMP("BIDUL",$J) "RTN","BIREPQ1",88,0) S VALM("TITLE")=$$LMVER^BILOGO "RTN","BIREPQ1",89,0) S VALMSG="To view patient rosters, select a group below:" "RTN","BIREPQ1",90,0) W !!?10,"This may take some time. Please hold on...",! "RTN","BIREPQ1",91,0) D START^BIREPQ2(BIQDT,.BICC,.BIHCF,.BICM,.BIBEN,BIHPV,BIUP) "RTN","BIREPQ1",92,0) ;---> Set up ZTSAVE in case user Queues from PL in List. "RTN","BIREPQ1",93,0) D ZSAVES^BIUTL3 "RTN","BIREPQ1",94,0) Q "RTN","BIREPQ1",95,0) ; "RTN","BIREPQ1",96,0) ; "RTN","BIREPQ1",97,0) ;---------- "RTN","BIREPQ1",98,0) RESET ;EP "RTN","BIREPQ1",99,0) ;---> Update partition for return to Listmanager. "RTN","BIREPQ1",100,0) I $D(VALMQUIT) S VALMBCK="Q" Q "RTN","BIREPQ1",101,0) D TERM^VALM0 S VALMBCK="R" "RTN","BIREPQ1",102,0) D INIT,HDR "RTN","BIREPQ1",103,0) Q "RTN","BIREPQ1",104,0) ; "RTN","BIREPQ1",105,0) ; "RTN","BIREPQ1",106,0) ;---------- "RTN","BIREPQ1",107,0) RESET1 ;EP "RTN","BIREPQ1",108,0) ;---> Update partition for return to Listmanager. "RTN","BIREPQ1",109,0) I $D(VALMQUIT) S VALMBCK="Q" Q "RTN","BIREPQ1",110,0) D TERM^VALM0 S VALMBCK="R" "RTN","BIREPQ1",111,0) S VALM("TITLE")=$$LMVER^BILOGO "RTN","BIREPQ1",112,0) S VALMSG="To view patient lists, select a group below:" "RTN","BIREPQ1",113,0) D HDR "RTN","BIREPQ1",114,0) Q "RTN","BIREPQ1",115,0) ; "RTN","BIREPQ1",116,0) ; vvv83 "RTN","BIREPQ1",117,0) ;---------- "RTN","BIREPQ1",118,0) HELP ;EP "RTN","BIREPQ1",119,0) N BIX S BIX=X "RTN","BIREPQ1",120,0) D FULL^VALM1 N BIPOP "RTN","BIREPQ1",121,0) D TITLE^BIUTL5("VIEW 3-27 MONTH REPORT - HELP, page 1 of 1") "RTN","BIREPQ1",122,0) D TEXT1,DIRZ^BIUTL3() "RTN","BIREPQ1",123,0) D:BIX'="??" RE^VALM4 "RTN","BIREPQ1",124,0) Q "RTN","BIREPQ1",125,0) ; "RTN","BIREPQ1",126,0) ; vvv83 "RTN","BIREPQ1",127,0) ;---------- "RTN","BIREPQ1",128,0) TEXT1 ;EP "RTN","BIREPQ1",129,0) ;;You have chosen to View the 3-27 Month Report rather than Print it. "RTN","BIREPQ1",130,0) ;;(You may print the report from here as well by entering "PL".) "RTN","BIREPQ1",131,0) ;; "RTN","BIREPQ1",132,0) ;;Also, you may: "RTN","BIREPQ1",133,0) ;; "RTN","BIREPQ1",134,0) ;;Enter "N" to view the list of Patients who were NOT Current "RTN","BIREPQ1",135,0) ;; or "NOT up-to-date" with their immunizations, according "RTN","BIREPQ1",136,0) ;; to recommendeded guidelines for their age. "RTN","BIREPQ1",137,0) ;; "RTN","BIREPQ1",138,0) ;;Enter "C" to view the list of Patients who were CURRENT or "RTN","BIREPQ1",139,0) ;; "up-to-date" with their immunizations, according to "RTN","BIREPQ1",140,0) ;; recommendeded guidelines for their age. "RTN","BIREPQ1",141,0) ;; "RTN","BIREPQ1",142,0) ;;Enter "B" to view a list of both groups of patients combined. "RTN","BIREPQ1",143,0) ;; "RTN","BIREPQ1",144,0) ;; "RTN","BIREPQ1",145,0) D PRINTX("TEXT1") "RTN","BIREPQ1",146,0) Q "RTN","BIREPQ1",147,0) ; "RTN","BIREPQ1",148,0) ; "RTN","BIREPQ1",149,0) ;---------- "RTN","BIREPQ1",150,0) EXIT ;EP "RTN","BIREPQ1",151,0) ;---> Cleanup, EOJ. "RTN","BIREPQ1",152,0) K ^TMP("BIREPQ1",$J),^TMP("BIDUL",$J) "RTN","BIREPQ1",153,0) D CLEAR^VALM1 "RTN","BIREPQ1",154,0) D FULL^VALM1 "RTN","BIREPQ1",155,0) Q "RTN","BIREPQ1",156,0) ; "RTN","BIREPQ1",157,0) ; "RTN","BIREPQ1",158,0) ;---------- "RTN","BIREPQ1",159,0) DEVICE(BIPOP) ;EP "RTN","BIREPQ1",160,0) ;---> Get Device and possibly queue to Taskman. "RTN","BIREPQ1",161,0) ;---> Parameters: "RTN","BIREPQ1",162,0) ; 1 - BIPOP (ret) If error or Queue, BIPOP=1 "RTN","BIREPQ1",163,0) ; "RTN","BIREPQ1",164,0) K %ZIS,IOP S BIPOP=0 "RTN","BIREPQ1",165,0) S ZTRTN="DEQUEUE^BIREPQ1" "RTN","BIREPQ1",166,0) D ZSAVES^BIUTL3 "RTN","BIREPQ1",167,0) D ZIS^BIUTL2(.BIPOP,1) "RTN","BIREPQ1",168,0) Q "RTN","BIREPQ1",169,0) ; "RTN","BIREPQ1",170,0) ; "RTN","BIREPQ1",171,0) ;---------- "RTN","BIREPQ1",172,0) DEQUEUE ;EP "RTN","BIREPQ1",173,0) ; "RTN","BIREPQ1",174,0) ;---> Prepare and print Quarterly Report. "RTN","BIREPQ1",175,0) K VALMHDR,^TMP("BIREPQ1",$J) "RTN","BIREPQ1",176,0) D HDR^BIREPQ1,START^BIREPQ2(BIQDT,.BICC,.BIHCF,.BICM,.BIBEN,BIHPV,BIUP) "RTN","BIREPQ1",177,0) D PRTLST^BIUTL8("BIREPQ1"),EXIT "RTN","BIREPQ1",178,0) Q "RTN","BIREPQ1",179,0) ; "RTN","BIREPQ1",180,0) ; "RTN","BIREPQ1",181,0) ;---------- "RTN","BIREPQ1",182,0) PRINTX(BILINL,BITAB) ;EP "RTN","BIREPQ1",183,0) Q:$G(BILINL)="" "RTN","BIREPQ1",184,0) N I,T,X S T="" S:'$D(BITAB) BITAB=5 F I=1:1:BITAB S T=T_" " "RTN","BIREPQ1",185,0) F I=1:1 S X=$T(@BILINL+I) Q:X'[";;" W !,T,$P(X,";;",2) "RTN","BIREPQ1",186,0) Q "RTN","BIREPQ1",187,0) ; "RTN","BIREPQ1",188,0) ; "RTN","BIREPQ1",189,0) ;---------- "RTN","BIREPQ1",190,0) ERROR(BIERR) ;EP "RTN","BIREPQ1",191,0) ;---> Report error, either to screen or print. "RTN","BIREPQ1",192,0) ;---> Parameters: "RTN","BIREPQ1",193,0) ; 1 - BIERR (ret) Text of Error Code if any, otherwise null. "RTN","BIREPQ1",194,0) ; "RTN","BIREPQ1",195,0) D ERRCD^BIUTL2($G(BIERR),,1) S BIPOP=1 "RTN","BIREPQ1",196,0) Q "RTN","BIREPQ2") 0^11^B25449213 "RTN","BIREPQ2",1,0) BIREPQ2 ;IHS/CMI/MWR - REPORT, QUARTERLY IMM; MAY 10, 2010 "RTN","BIREPQ2",2,0) ;;8.5;IMMUNIZATION;**31**;OCT 24,2011;Build 137 "RTN","BIREPQ2",3,0) ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS * "RTN","BIREPQ2",4,0) ;; VIEW QUARTERLY IMMUNIZATION REPORT, GATHER DATA. "RTN","BIREPQ2",5,0) ; "RTN","BIREPQ2",6,0) ; "RTN","BIREPQ2",7,0) ;---------- "RTN","BIREPQ2",8,0) HEAD(BIQDT,BICC,BIHCF,BICM,BIBEN,BIUP) ;EP "RTN","BIREPQ2",9,0) ;---> Produce Header array for Quarterly Immunization Report. "RTN","BIREPQ2",10,0) ;---> Parameters: "RTN","BIREPQ2",11,0) ; 1 - BIQDT (req) Quarter Ending Date. "RTN","BIREPQ2",12,0) ; 2 - BICC (req) Current Community array. "RTN","BIREPQ2",13,0) ; 3 - BIHCF (req) Health Care Facility array. "RTN","BIREPQ2",14,0) ; 4 - BICM (req) Case Manager array. "RTN","BIREPQ2",15,0) ; 5 - BIBEN (req) Beneficiary Type array. "RTN","BIREPQ2",16,0) ; 6 - BIUP (req) User Population/Group (Registered, Imm, User, Active). "RTN","BIREPQ2",17,0) ; "RTN","BIREPQ2",18,0) ;---> Check for required Variables. "RTN","BIREPQ2",19,0) Q:'$G(BIQDT) "RTN","BIREPQ2",20,0) Q:'$D(BICC) "RTN","BIREPQ2",21,0) Q:'$D(BIHCF) "RTN","BIREPQ2",22,0) Q:'$D(BICM) "RTN","BIREPQ2",23,0) Q:'$D(BIBEN) "RTN","BIREPQ2",24,0) S:$G(BIUP)="" BIUP="u" "RTN","BIREPQ2",25,0) ; "RTN","BIREPQ2",26,0) K VALMHDR "RTN","BIREPQ2",27,0) N BILINE,X S BILINE=0 "RTN","BIREPQ2",28,0) ; "RTN","BIREPQ2",29,0) N X S X="" "RTN","BIREPQ2",30,0) ;---> If Header array is NOT being for Listmananger include version. vvv83 "RTN","BIREPQ2",31,0) S:'$D(VALM("BM")) X=$$LMVER^BILOGO() "RTN","BIREPQ2",32,0) ; "RTN","BIREPQ2",33,0) I BISPD'="CSV" D WH^BIW(.BILINE,X) "RTN","BIREPQ2",34,0) S X=$$REPHDR^BIUTL6(DUZ(2)) I BISPD'="CSV" D CENTERT^BIUTL5(.X) "RTN","BIREPQ2",35,0) D WH^BIW(.BILINE,X) "RTN","BIREPQ2",36,0) ; "RTN","BIREPQ2",37,0) S X="* 3-27 Month Immunization Report *" I BISPD'="CSV" D CENTERT^BIUTL5(.X) "RTN","BIREPQ2",38,0) D WH^BIW(.BILINE,X) "RTN","BIREPQ2",39,0) ;S X="For Children 3-27 Months of Age" D CENTERT^BIUTL5(.X) vvv83 "RTN","BIREPQ2",40,0) ;D WH^BIW(.BILINE,X) "RTN","BIREPQ2",41,0) ; "RTN","BIREPQ2",42,0) S:BISPD'="CSV" X=$$SP^BIUTL5(27)_"Report Date: "_$$SLDT1^BIUTL5(DT) S:BISPD="CSV" X="Report Date: "_$$SLDT1^BIUTL5(DT) "RTN","BIREPQ2",43,0) D WH^BIW(.BILINE,X,$S(BISPD="CSV":"",1:1)) "RTN","BIREPQ2",44,0) ; "RTN","BIREPQ2",45,0) S:BISPD'="CSV" X=$$SP^BIUTL5(30)_"End Date: "_$$SLDT1^BIUTL5(BIQDT) S:BISPD="CSV" X="End Date: "_$$SLDT1^BIUTL5(BIQDT) "RTN","BIREPQ2",46,0) D WH^BIW(.BILINE,X,$S(BISPD="CSV":"",1:1)) "RTN","BIREPQ2",47,0) ; "RTN","BIREPQ2",48,0) S X=" "_$$BIUPTX^BIUTL6(BIUP) D WH^BIW(.BILINE,X) "RTN","BIREPQ2",49,0) I BISPD'="CSV" D WH^BIW(.BILINE,$$SP^BIUTL5(79,"-")) "RTN","BIREPQ2",50,0) ; "RTN","BIREPQ2",51,0) D "RTN","BIREPQ2",52,0) .;---> If specific Communities were selected (not ALL), then print "RTN","BIREPQ2",53,0) .;---> the Communities in a subheader at the top of the report. "RTN","BIREPQ2",54,0) .D SUBH^BIOUTPT5("BICC","Community",,"^AUTTCOM(",.BILINE,.BIERR,,12) "RTN","BIREPQ2",55,0) .I $G(BIERR) D ERRCD^BIUTL2(BIERR,.X) D WH^BIW(.BILINE,X) Q "RTN","BIREPQ2",56,0) .; "RTN","BIREPQ2",57,0) .;---> If specific Health Care Facilities, print subheader. "RTN","BIREPQ2",58,0) .D SUBH^BIOUTPT5("BIHCF","Facility",,"^DIC(4,",.BILINE,.BIERR,,12) "RTN","BIREPQ2",59,0) .I $G(BIERR) D ERRCD^BIUTL2(BIERR,.X) D WH^BIW(.BILINE,X) Q "RTN","BIREPQ2",60,0) .; "RTN","BIREPQ2",61,0) .;---> If specific Case Managers, print Case Manager subheader. "RTN","BIREPQ2",62,0) .D SUBH^BIOUTPT5("BICM","Case Manager",,"^VA(200,",.BILINE,.BIERR,,12) "RTN","BIREPQ2",63,0) .I $G(BIERR) D ERRCD^BIUTL2(BIERR,.X) D WH^BIW(.BILINE,X) Q "RTN","BIREPQ2",64,0) .; "RTN","BIREPQ2",65,0) .;---> If specific Beneficiary Types, print Beneficiary Type subheader. "RTN","BIREPQ2",66,0) .D SUBH^BIOUTPT5("BIBEN","Beneficiary Type",,"^AUTTBEN(",.BILINE,.BIERR,,12) "RTN","BIREPQ2",67,0) .I $G(BIERR) D ERRCD^BIUTL2(BIERR,.X) D WH^BIW(.BILINE,X) Q "RTN","BIREPQ2",68,0) .; "RTN","BIREPQ2",69,0) .I BISPD="CSV" D Q "RTN","BIREPQ2",70,0) ..S X="Age in Months,3-4 mths,5-6 mths,7-15 mths,16-18 mths,19-23 mths,24-27 mths,Totals" "RTN","BIREPQ2",71,0) ..D WH^BIW(.BILINE,X) "RTN","BIREPQ2",72,0) .S X=$$SP^BIUTL5(10)_"|"_$$SP^BIUTL5(21)_"Age in Months" "RTN","BIREPQ2",73,0) .S X=X_$$SP^BIUTL5(24)_"|" "RTN","BIREPQ2",74,0) .D WH^BIW(.BILINE,X) "RTN","BIREPQ2",75,0) .S X=$$SP^BIUTL5(10)_"|"_$$SP^BIUTL5(58,"-")_"| Totals" "RTN","BIREPQ2",76,0) .D WH^BIW(.BILINE,X) "RTN","BIREPQ2",77,0) .S X=" | 3-4 5-6 7-15 16-18 19-23" "RTN","BIREPQ2",78,0) .S X=X_" 24-27 |" "RTN","BIREPQ2",79,0) .D WH^BIW(.BILINE,X) "RTN","BIREPQ2",80,0) ; "RTN","BIREPQ2",81,0) ;---> If Header array is being built for Listmananger, "RTN","BIREPQ2",82,0) ;---> reset display window margins for Communities, etc. "RTN","BIREPQ2",83,0) D:$D(VALM("BM")) "RTN","BIREPQ2",84,0) .S VALM("TM")=BILINE+3 "RTN","BIREPQ2",85,0) .S VALM("LINES")=VALM("BM")-VALM("TM")+1 "RTN","BIREPQ2",86,0) .;---> Safeguard to prevent divide/0 error. "RTN","BIREPQ2",87,0) .S:VALM("LINES")<1 VALM("LINES")=1 "RTN","BIREPQ2",88,0) Q "RTN","BIREPQ2",89,0) ; "RTN","BIREPQ2",90,0) ; "RTN","BIREPQ2",91,0) ;---------- "RTN","BIREPQ2",92,0) START(BIQDT,BICC,BIHCF,BICM,BIBEN,BIHPV,BIUP) ;EP "RTN","BIREPQ2",93,0) ;---> Produce array for Quarterly Immunization Report. "RTN","BIREPQ2",94,0) ;---> Parameters: "RTN","BIREPQ2",95,0) ; 1 - BIQDT (req) Quarter Ending Date. "RTN","BIREPQ2",96,0) ; 2 - BICC (req) Current Community array. "RTN","BIREPQ2",97,0) ; 3 - BIHCF (req) Health Care Facility array. "RTN","BIREPQ2",98,0) ; 4 - BICM (req) Case Manager array. "RTN","BIREPQ2",99,0) ; 5 - BIBEN (req) Beneficiary Type array. "RTN","BIREPQ2",100,0) ; 6 - BIHPV (opt) 1=Include Varicella & Pneumo. "RTN","BIREPQ2",101,0) ; 7 - BIUP (req) User Population/Group (Registered, Imm, User, Active). "RTN","BIREPQ2",102,0) ; "RTN","BIREPQ2",103,0) K ^TMP("BIREPQ1",$J) "RTN","BIREPQ2",104,0) N BILINE,BITMP,X S BILINE=0,BIPOP=0 "RTN","BIREPQ2",105,0) ; "RTN","BIREPQ2",106,0) ;---> Check for required Variables. "RTN","BIREPQ2",107,0) ; "RTN","BIREPQ2",108,0) I '$G(BIQDT) D ERRCD^BIUTL2(623,.X) D WRITERR(BILINE,X) Q "RTN","BIREPQ2",109,0) I '$D(BICC) D ERRCD^BIUTL2(614,.X) D WRITERR(BILINE,X) Q "RTN","BIREPQ2",110,0) I '$D(BIHCF) D ERRCD^BIUTL2(625,.X) D WRITERR(BILINE,X) Q "RTN","BIREPQ2",111,0) I '$D(BICM) D ERRCD^BIUTL2(615,.X) D WRITERR(BILINE,X) Q "RTN","BIREPQ2",112,0) I '$D(BIBEN) D ERRCD^BIUTL2(662,.X) D WRITERR(BILINE,X) Q "RTN","BIREPQ2",113,0) S:'$D(BIHPV) BIHPV=1 "RTN","BIREPQ2",114,0) S:$G(BIUP)="" BIUP="u" "RTN","BIREPQ2",115,0) ; "RTN","BIREPQ2",116,0) ;---> Write Age Totals line. "RTN","BIREPQ2",117,0) D AGETOT^BIREPQ3(.BILINE,.BICC,.BIHCF,.BICM,.BIBEN,BIQDT,BIHPV,BIUP,.BIPOP) "RTN","BIREPQ2",118,0) Q:BIPOP "RTN","BIREPQ2",119,0) ; "RTN","BIREPQ2",120,0) ;---> Write lines that define minimum needs. "RTN","BIREPQ2",121,0) D MNEED^BIREPQ3(.BILINE,BIHPV) "RTN","BIREPQ2",122,0) ; "RTN","BIREPQ2",123,0) ;---> Write Approp for Age and Vaccine Group lines. "RTN","BIREPQ2",124,0) D APPROP^BIREPQ3(.BILINE) "RTN","BIREPQ2",125,0) ; "RTN","BIREPQ2",126,0) ;---> Write Statistics lines for each Vaccine Group (BIVGRP). "RTN","BIREPQ2",127,0) F BIVGRP=1,2,6,3,4,7,9,11,15 D VGRP^BIREPQ3(.BILINE,BIVGRP) "RTN","BIREPQ2",128,0) ;---> Per Ros Singleton, show HPV individual stats, even if not including "RTN","BIREPQ2",129,0) ;---> them in the totals for Age Appropriate. "RTN","BIREPQ2",130,0) ;F BIVGRP=1,2,6,3,4 D VGRP^BIREPQ3(.BILINE,BIVGRP) "RTN","BIREPQ2",131,0) ;I $G(BIHPV) F BIVGRP=7,9,11 D VGRP^BIREPQ3(.BILINE,BIVGRP) "RTN","BIREPQ2",132,0) ; "RTN","BIREPQ2",133,0) ;---> Now write total patients considered who had refusals. "RTN","BIREPQ2",134,0) N M,N S (M,N)=0 F S M=$O(BITMP("REFUSALS",M)) Q:'M S N=N+1 "RTN","BIREPQ2",135,0) I BISPD'="CSV" S X=" Total Patients included who had Refusals on record"_$J(N,25) "RTN","BIREPQ2",136,0) I BISPD="CSV" S X=" " D WRITE^BIREPQ3(.BILINE,X) S X="Total Patients included who had Refusals on record"_","_+N "RTN","BIREPQ2",137,0) D WRITE^BIREPQ3(.BILINE,X) I BISPD'="CSV" D WRITE^BIREPQ3(.BILINE,$$SP^BIUTL5(79,"-")) "RTN","BIREPQ2",138,0) ; "RTN","BIREPQ2",139,0) S VALMCNT=BILINE "RTN","BIREPQ2",140,0) Q "RTN","BIREPQ2",141,0) ; "RTN","BIREPQ2",142,0) ; "RTN","BIREPQ2",143,0) ;---------- "RTN","BIREPQ2",144,0) WRITERR(BILINE,X) ;EP "RTN","BIREPQ2",145,0) ;---> Write error line to report. "RTN","BIREPQ2",146,0) ;---> Parameters: "RTN","BIREPQ2",147,0) ; 1 - BILINE (ret) Last line# written. "RTN","BIREPQ2",148,0) ; 2 - BIVAL (req) Error text. "RTN","BIREPQ2",149,0) ; "RTN","BIREPQ2",150,0) S:'$D(X) X="No error text." "RTN","BIREPQ2",151,0) S:'$D(BILINE) BILINE=1 "RTN","BIREPQ2",152,0) D WRITE^BIREPQ3(.BILINE,X) S VALMCNT=BILINE "RTN","BIREPQ2",153,0) Q "RTN","BIREPQ3") 0^12^B39950450 "RTN","BIREPQ3",1,0) BIREPQ3 ;IHS/CMI/MWR - REPORT, QUARTERLY IMM; OCT 15, 2010 "RTN","BIREPQ3",2,0) ;;8.5;IMMUNIZATION;**31**;OCT 24,2011;Build 137 "RTN","BIREPQ3",3,0) ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS * "RTN","BIREPQ3",4,0) ;; VIEW QUARTERLY IMMUNIZATION REPORT. "RTN","BIREPQ3",5,0) ;; PATCH 2: Fix header at 16-18mths to say 4-PCV. MNEED+24 "RTN","BIREPQ3",6,0) ; "RTN","BIREPQ3",7,0) ; "RTN","BIREPQ3",8,0) ;---------- "RTN","BIREPQ3",9,0) AGETOT(BILINE,BICC,BIHCF,BICM,BIBEN,BIQDT,BIHPV,BIUP,BIPOP) ;EP "RTN","BIREPQ3",10,0) ;---> Write Age Total line. "RTN","BIREPQ3",11,0) ;---> Parameters: "RTN","BIREPQ3",12,0) ; 1 - BILINE (req) Line number in ^TMP Listman array. "RTN","BIREPQ3",13,0) ; 2 - BICC (req) Current Community array. "RTN","BIREPQ3",14,0) ; 3 - BIHCF (req) Health Care Facility array. "RTN","BIREPQ3",15,0) ; 4 - BICM (req) Case Manager array. "RTN","BIREPQ3",16,0) ; 5 - BIBEN (req) Beneficiary Type array. "RTN","BIREPQ3",17,0) ; 6 - BIQDT (req) Quarter Ending Date. "RTN","BIREPQ3",18,0) ; 7 - BIHPV (req) 1=include Hep A. "RTN","BIREPQ3",19,0) ; 8 - BIUP (req) User Population/Group (Registered, Imm, User, Active). "RTN","BIREPQ3",20,0) ; 9 - BIPOP (ret) BIPOP=1 if error. "RTN","BIREPQ3",21,0) ; "RTN","BIREPQ3",22,0) S BIPOP=0 "RTN","BIREPQ3",23,0) ;---> Check for required Variables. "RTN","BIREPQ3",24,0) I '$G(BIQDT) D ERRCD^BIUTL2(623,.X) D WRITERR^BIREPQ2(BILINE,X) S BIPOP=1 Q "RTN","BIREPQ3",25,0) ; "RTN","BIREPQ3",26,0) ;---> Gather and sort patients. "RTN","BIREPQ3",27,0) N N S N=0 "RTN","BIREPQ3",28,0) F I="3-4","5-6","7-15","16-18","19-23","24-27" D "RTN","BIREPQ3",29,0) .;---> For each age range, get Begin and End Dates (DOB's). "RTN","BIREPQ3",30,0) .D AGEDATE^BIAGE(I,BIQDT,.BIBEGDT,.BIENDDT) "RTN","BIREPQ3",31,0) .S N=N+1 "RTN","BIREPQ3",32,0) .D GETPATS^BIREPQ4(BIBEGDT,BIENDDT,N,.BICC,.BIHCF,.BICM,.BIBEN,BIQDT,BIHPV,BIUP) "RTN","BIREPQ3",33,0) ; "RTN","BIREPQ3",34,0) ;---> Count patients. "RTN","BIREPQ3",35,0) N BIAGRP,BITOT S BITOT=0 "RTN","BIREPQ3",36,0) F I=1:1:6 D "RTN","BIREPQ3",37,0) .N M,N S M=0,N=0,BIAGRP(I)=0 "RTN","BIREPQ3",38,0) .F S N=$O(^TMP("BIREPQ1",$J,"PATS",I,N)) Q:'N D "RTN","BIREPQ3",39,0) ..S BIAGRP(I)=BIAGRP(I)+1,BITOT=BITOT+1 "RTN","BIREPQ3",40,0) .S BITMP("STATS","TOTAL",I)=BIAGRP(I) "RTN","BIREPQ3",41,0) S BITMP("STATS","TOTAL","ALL")=BITOT "RTN","BIREPQ3",42,0) ; "RTN","BIREPQ3",43,0) ;---> Write Age Totals line. "RTN","BIREPQ3",44,0) N X "RTN","BIREPQ3",45,0) ;N X S X=" Age Total|" "RTN","BIREPQ3",46,0) I BISPD'="CSV" D "RTN","BIREPQ3",47,0) .S X=" # in Age |" "RTN","BIREPQ3",48,0) .F I=1:1:6 S X=X_$J(BIAGRP(I),7)_" " "RTN","BIREPQ3",49,0) .S X=$E(X,1,$L(X)-2)_"|"_$J(BITOT,7) "RTN","BIREPQ3",50,0) I BISPD="CSV" D "RTN","BIREPQ3",51,0) .S X="# in Age" "RTN","BIREPQ3",52,0) .F I=1:1:6 S X=X_","_BIAGRP(I) "RTN","BIREPQ3",53,0) .S X=X_","_BITOT "RTN","BIREPQ3",54,0) D WRITE(.BILINE,X) "RTN","BIREPQ3",55,0) I BISPD'="CSV" D WRITE(.BILINE,$$SP^BIUTL5(79,"-")) "RTN","BIREPQ3",56,0) Q "RTN","BIREPQ3",57,0) ; "RTN","BIREPQ3",58,0) ; "RTN","BIREPQ3",59,0) ;---------- "RTN","BIREPQ3",60,0) MNEED(BILINE,BIHPV) ;EP "RTN","BIREPQ3",61,0) ;---> Write Minimum Needs lines. "RTN","BIREPQ3",62,0) ;---> Parameters: "RTN","BIREPQ3",63,0) ; 1 - BILINE (req) Line number in ^TMP Listman array. "RTN","BIREPQ3",64,0) ; 2 - BIHPV (req) 1=Include Varicella & Pneumo. "RTN","BIREPQ3",65,0) ; "RTN","BIREPQ3",66,0) S:'$D(BILINE) BILINE=0 "RTN","BIREPQ3",67,0) I BISPD="CSV" D Q "RTN","BIREPQ3",68,0) .S X="Minimun Needs,1-DTaP|1-Polio|1-HIB|1-HEPB"_$S($G(BIHPV):"|1-PCV",1:"") "RTN","BIREPQ3",69,0) .S X=X_",2-DTaP|2-Polio|2-HIB|2-HEPB"_$S($G(BIHPV):"|2-PCV",1:"") "RTN","BIREPQ3",70,0) .S X=X_",3-DTaP|2-Polio|2-HIB|2-HEPB"_$S($G(BIHPV):"|3-PCV",1:"") "RTN","BIREPQ3",71,0) .S X=X_",3-DTaP|2-Polio|3-HIB|2-HEPB"_$S($G(BIHPV):"|4-PCV",1:"")_"|1-MMR|"_$S($G(BIHPV):"|1-VAR",1:"") "RTN","BIREPQ3",72,0) .S X=X_",4-DTaP|3-Polio|3-HIB|3-HEPB"_$S($G(BIHPV):"|4-PCV",1:"")_"|1-MMR|"_$S($G(BIHPV):"|1-VAR",1:"") "RTN","BIREPQ3",73,0) .S X=X_",4-DTaP|3-Polio|3-HIB|3-HEPB"_$S($G(BIHPV):"|4-PCV",1:"")_"|1-MMR|"_$S($G(BIHPV):"|1-VAR",1:"") "RTN","BIREPQ3",74,0) .D WRITE(.BILINE,X) "RTN","BIREPQ3",75,0) S X=" Minimum | 1-DTaP 2-DTaP 3-DTaP 3-DTaP 4-DTaP" "RTN","BIREPQ3",76,0) S X=X_" 4-DTaP|" "RTN","BIREPQ3",77,0) D WRITE(.BILINE,X) "RTN","BIREPQ3",78,0) S X=" Needs | 1-POLIO 2-POLIO 2-POLIO 2-POLIO" "RTN","BIREPQ3",79,0) S X=X_" 3-POLIO 3-POLI|" "RTN","BIREPQ3",80,0) D WRITE(.BILINE,X) "RTN","BIREPQ3",81,0) S X=" | 1-HIB 2-HIB 2-HIB 3-HIB 3-HIB" "RTN","BIREPQ3",82,0) S X=X_" 3-HIB |" "RTN","BIREPQ3",83,0) D WRITE(.BILINE,X) "RTN","BIREPQ3",84,0) S X=" | 1-HEPB 2-HEPB 2-HEPB 2-HEPB 3-HEPB" "RTN","BIREPQ3",85,0) S X=X_" 3-HEPB|" "RTN","BIREPQ3",86,0) D WRITE(.BILINE,X) "RTN","BIREPQ3",87,0) D:$G(BIHPV) "RTN","BIREPQ3",88,0) .; "RTN","BIREPQ3",89,0) .;********** PATCH 2, v8.4, OCT 15,2010, IHS/CMI/MWR "RTN","BIREPQ3",90,0) .;---> Fix header at 16-18mths to say 4-PCV. "RTN","BIREPQ3",91,0) .;S X=" | 1-PCV 2-PCV 3-PCV 3-PCV " "RTN","BIREPQ3",92,0) .S X=" | 1-PCV 2-PCV 3-PCV 4-PCV " "RTN","BIREPQ3",93,0) .;********** "RTN","BIREPQ3",94,0) .; "RTN","BIREPQ3",95,0) .S X=X_" 4-PCV 4-PCV |" "RTN","BIREPQ3",96,0) .D WRITE(.BILINE,X) "RTN","BIREPQ3",97,0) ;S X=" | 1-ROTA 2-ROTA 3-ROTA 3-ROTA 3-ROTA" "RTN","BIREPQ3",98,0) ;S X=X_" 3-ROTA|" "RTN","BIREPQ3",99,0) ;D WRITE(.BILINE,X) "RTN","BIREPQ3",100,0) S X=" | 1-MMR 1-MMR " "RTN","BIREPQ3",101,0) S X=X_" 1-MMR |" "RTN","BIREPQ3",102,0) D WRITE(.BILINE,X) "RTN","BIREPQ3",103,0) D:$G(BIHPV) "RTN","BIREPQ3",104,0) .S X=" | 1-VAR 1-VAR " "RTN","BIREPQ3",105,0) .S X=X_" 1-VAR |" "RTN","BIREPQ3",106,0) .D WRITE(.BILINE,X) "RTN","BIREPQ3",107,0) ;D:$G(BIHPV) ;Never include Hep A. "RTN","BIREPQ3",108,0) ;.S X=" | " "RTN","BIREPQ3",109,0) ;.S X=X_" 1-HEPA|" "RTN","BIREPQ3",110,0) ;.D WRITE(.BILINE,X) "RTN","BIREPQ3",111,0) D WRITE(.BILINE,$$SP^BIUTL5(79,"-")) "RTN","BIREPQ3",112,0) Q "RTN","BIREPQ3",113,0) ; "RTN","BIREPQ3",114,0) ; "RTN","BIREPQ3",115,0) ;---------- "RTN","BIREPQ3",116,0) APPROP(BILINE) ;EP "RTN","BIREPQ3",117,0) ;---> Write Appropriate for Age lines. "RTN","BIREPQ3",118,0) ;---> Parameters: "RTN","BIREPQ3",119,0) ; 1 - BILINE (req) Line number in ^TMP Listman array. "RTN","BIREPQ3",120,0) ; "RTN","BIREPQ3",121,0) ;---> Numbers of appropriate line. "RTN","BIREPQ3",122,0) N BITOT,X S BITOT=0 "RTN","BIREPQ3",123,0) I BISPD'="CSV" D "RTN","BIREPQ3",124,0) .S X=" Approp. |" "RTN","BIREPQ3",125,0) .F BIAGRP=1:1:6 D "RTN","BIREPQ3",126,0) ..N Y S Y=$G(BITMP("STATS","APPRO",BIAGRP)) S:Y="" Y=0 "RTN","BIREPQ3",127,0) ..S X=X_$J(Y,7)_" ",BITOT=BITOT+Y "RTN","BIREPQ3",128,0) .S X=$E(X,1,$L(X)-2)_"|"_$J(BITOT,7) "RTN","BIREPQ3",129,0) I BISPD="CSV" D "RTN","BIREPQ3",130,0) .S X="Approp. for Age #" "RTN","BIREPQ3",131,0) .F BIAGRP=1:1:6 D "RTN","BIREPQ3",132,0) ..N Y S Y=$G(BITMP("STATS","APPRO",BIAGRP)) S:Y="" Y=0 "RTN","BIREPQ3",133,0) ..S X=X_","_Y,BITOT=BITOT+Y "RTN","BIREPQ3",134,0) .S X=X_","_+BITOT_"," "RTN","BIREPQ3",135,0) D WRITE(.BILINE,X) "RTN","BIREPQ3",136,0) D MARK^BIW(BILINE,3,"BIREPQ1") "RTN","BIREPQ3",137,0) ; "RTN","BIREPQ3",138,0) ;---> Percentage of appropriate line. "RTN","BIREPQ3",139,0) I BISPD'="CSV" D "RTN","BIREPQ3",140,0) .S X=" for Age |",BITOT=0 "RTN","BIREPQ3",141,0) .F BIAGRP=1:1:6 D "RTN","BIREPQ3",142,0) ..N Y S Y=$G(BITMP("STATS","APPRO",BIAGRP)) S:Y="" Y=0 "RTN","BIREPQ3",143,0) ..N Z S Z=$G(BITMP("STATS","TOTAL",BIAGRP)) S:'Z Y=0,Z=1 "RTN","BIREPQ3",144,0) ..N BIPERC S BIPERC=" "_$J((100*Y/Z),3,0)_"%" "RTN","BIREPQ3",145,0) ..S X=X_BIPERC_" ",BITOT=BITOT+Y "RTN","BIREPQ3",146,0) I BISPD="CSV" D "RTN","BIREPQ3",147,0) .S X="Approp. for Age %" "RTN","BIREPQ3",148,0) .S BITOT=0 "RTN","BIREPQ3",149,0) .F BIAGRP=1:1:6 D "RTN","BIREPQ3",150,0) ..N Y S Y=$G(BITMP("STATS","APPRO",BIAGRP)) S:Y="" Y=0 "RTN","BIREPQ3",151,0) ..N Z S Z=$G(BITMP("STATS","TOTAL",BIAGRP)) S:'Z Y=0,Z=1 "RTN","BIREPQ3",152,0) ..N BIPERC S BIPERC=$J((100*Y/Z),3,0) "RTN","BIREPQ3",153,0) ..S X=X_","_$$STRIP^XLFSTR(BIPERC," "),BITOT=BITOT+Y "RTN","BIREPQ3",154,0) ; "RTN","BIREPQ3",155,0) N Y S Y=BITOT S:Y="" Y=0 "RTN","BIREPQ3",156,0) N Z S Z=$G(BITMP("STATS","TOTAL","ALL")) S:'Z Y=0,Z=1 "RTN","BIREPQ3",157,0) I BISPD'="CSV" S X=$E(X,1,$L(X)-2)_"| "_$J((100*Y/Z),3,0)_"%" "RTN","BIREPQ3",158,0) I BISPD="CSV" S X=X_","_$$STRIP^XLFSTR($J((100*Y/Z),3,0)," ") "RTN","BIREPQ3",159,0) D WRITE(.BILINE,X) "RTN","BIREPQ3",160,0) I BISPD'="CSV" D WRITE(.BILINE,$$SP^BIUTL5(79,"-")) "RTN","BIREPQ3",161,0) Q "RTN","BIREPQ3",162,0) ; "RTN","BIREPQ3",163,0) ; "RTN","BIREPQ3",164,0) ;---------- "RTN","BIREPQ3",165,0) VGRP(BILINE,BIVGRP) ;EP "RTN","BIREPQ3",166,0) ;---> Write Stats lines for each Vaccine Group. "RTN","BIREPQ3",167,0) ;---> Parameters: "RTN","BIREPQ3",168,0) ; 1 - BILINE (req) Line number in ^TMP Listman array. "RTN","BIREPQ3",169,0) ; 2 - BIVGRP (req) IEN of Vaccine Group. "RTN","BIREPQ3",170,0) ; "RTN","BIREPQ3",171,0) ;---> Write a line for each Dose of this Vaccine Group. "RTN","BIREPQ3",172,0) N BIDOSE,BIMAXD S BIMAXD=$$VGROUP^BIUTL2(BIVGRP,6) "RTN","BIREPQ3",173,0) N BIDOSE F BIDOSE=1:1:BIMAXD D "RTN","BIREPQ3",174,0) .; "RTN","BIREPQ3",175,0) .;---> BIX=text of the line to write. "RTN","BIREPQ3",176,0) .;---> Write the Dose#-Vaccine Group in left margin. "RTN","BIREPQ3",177,0) .N BIX "RTN","BIREPQ3",178,0) .I BISPD'="CSV" S BIX=" "_BIDOSE_"-"_$$VGROUP^BIUTL2(BIVGRP,5) S BIX=$$PAD^BIUTL5(BIX,10)_"|" "RTN","BIREPQ3",179,0) .I BISPD="CSV" S BIX=BIDOSE_"-"_$$VGROUP^BIUTL2(BIVGRP,5)_" #" "RTN","BIREPQ3",180,0) .; "RTN","BIREPQ3",181,0) .;---> Now loop through the 6 age groups, concating subtotals. "RTN","BIREPQ3",182,0) .N BIAGRP,BISUBT S BISUBT=0 "RTN","BIREPQ3",183,0) .F BIAGRP=1:1:6 D "RTN","BIREPQ3",184,0) ..N Y S Y=$G(BITMP("STATS",BIVGRP,BIDOSE,BIAGRP)) "RTN","BIREPQ3",185,0) ..I BISPD'="CSV" S BIX=BIX_$J(Y,7)_" ",BISUBT=BISUBT+Y "RTN","BIREPQ3",186,0) ..I BISPD="CSV" S BIX=BIX_","_+Y,BISUBT=BISUBT+Y "RTN","BIREPQ3",187,0) .; "RTN","BIREPQ3",188,0) .I BISPD'="CSV" S BIX=$E(BIX,1,$L(BIX)-2)_"|"_$J(BISUBT,7) "RTN","BIREPQ3",189,0) .I BISPD="CSV" S BIX=BIX_","_+BISUBT_"," "RTN","BIREPQ3",190,0) .D WRITE(.BILINE,BIX) "RTN","BIREPQ3",191,0) .I BIDOSE=1 D MARK^BIW(BILINE,BIMAXD+1,"BIREPQ1") "RTN","BIREPQ3",192,0) I BISPD'="CSV" D WRITE(.BILINE,$$SP^BIUTL5(79,"-")) "RTN","BIREPQ3",193,0) Q "RTN","BIREPQ3",194,0) ; "RTN","BIREPQ3",195,0) ; "RTN","BIREPQ3",196,0) ;---------- "RTN","BIREPQ3",197,0) WRITE(BILINE,BIVAL,BIBLNK) ;EP "RTN","BIREPQ3",198,0) ;---> Write lines to ^TMP (see documentation in ^BIW). "RTN","BIREPQ3",199,0) ;---> Parameters: "RTN","BIREPQ3",200,0) ; 1 - BILINE (ret) Last line# written. "RTN","BIREPQ3",201,0) ; 2 - BIVAL (opt) Value/text of line (Null=blank line). "RTN","BIREPQ3",202,0) ; "RTN","BIREPQ3",203,0) Q:'$D(BILINE) "RTN","BIREPQ3",204,0) D WL^BIW(.BILINE,"BIREPQ1",$G(BIVAL),$G(BIBLNK)) "RTN","BIREPQ3",205,0) Q "RTN","BIREPT1") 0^13^B23734284 "RTN","BIREPT1",1,0) BIREPT1 ;IHS/CMI/MWR - REPORT, TWO-YR-OLD RATES; MAY 10, 2010 "RTN","BIREPT1",2,0) ;;8.5;IMMUNIZATION;**31**;OCT 24,2011;Build 137 "RTN","BIREPT1",3,0) ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS * "RTN","BIREPT1",4,0) ;; VIEW OR PRINT TWO-YR-OLD IMMUNIZATION RATES REPORT. "RTN","BIREPT1",5,0) ; "RTN","BIREPT1",6,0) ; "RTN","BIREPT1",7,0) ;---------- "RTN","BIREPT1",8,0) START(BIX) ;EP "RTN","BIREPT1",9,0) ;---> Prepare and display or print Two-Yr-Old Rates Report. "RTN","BIREPT1",10,0) ;---> Parameters: "RTN","BIREPT1",11,0) ; 1 - BIX (req) If BIX="PRINT", then print Report. "RTN","BIREPT1",12,0) ; If BIX="VIEW", then view Report (default). "RTN","BIREPT1",13,0) ; If BIX="CSV", then create delimited output to screen or host file IHS/LAB patch 31 delimited output "RTN","BIREPT1",14,0) ;---> Variables: "RTN","BIREPT1",15,0) ; 1 - BIQDT (req) Quarter Ending Date. "RTN","BIREPT1",16,0) ; 2 - BITAR (opt) Two-Yr-Old Report Age Range, default="19-35". "RTN","BIREPT1",17,0) ; 3 - BICC (req) Current Community array. "RTN","BIREPT1",18,0) ; 4 - BIHCF (req) Health Care Facility array. "RTN","BIREPT1",19,0) ; 5 - BICM (req) Case Manager array. "RTN","BIREPT1",20,0) ; 6 - BIBEN (req) Beneficiary Type array. "RTN","BIREPT1",21,0) ; 7 - BIPOP (ret) BIPOP=1 if error. "RTN","BIREPT1",22,0) ; 8 - BIUP (req) User Population/Group (Registered, Imm, User, Active). "RTN","BIREPT1",23,0) ; "RTN","BIREPT1",24,0) ;---> Check for required Variables. "RTN","BIREPT1",25,0) I '$G(BIQDT) D ERRCD^BIUTL2(622,,1) D RESET^BIREPT Q "RTN","BIREPT1",26,0) I '$D(BICC) D ERRCD^BIUTL2(614,,1) D RESET^BIREPT Q "RTN","BIREPT1",27,0) I '$D(BIHCF) D ERRCD^BIUTL2(625,,1) D RESET^BIREPT Q "RTN","BIREPT1",28,0) I '$D(BICM) D ERRCD^BIUTL2(615,,1) D RESET^BIREPT Q "RTN","BIREPT1",29,0) I '$D(BIBEN) D ERRCD^BIUTL2(662,,1) D RESET^BIREPT Q "RTN","BIREPT1",30,0) I '$G(BISITE) S BISITE=$G(DUZ(2)) "RTN","BIREPT1",31,0) I '$G(BISITE) D ERRCD^BIUTL2(109,,1) D RESET^BIREPT Q "RTN","BIREPT1",32,0) S:$G(BIUP)="" BIUP="u" "RTN","BIREPT1",33,0) ; "RTN","BIREPT1",34,0) S:'$G(BITAR) BITAR="19-35" "RTN","BIREPT1",35,0) S BIAGRPS=$S(BITAR="19-35":"3,5,7,16,19,36",1:"3,5,7,16,19,24,36") "RTN","BIREPT1",36,0) ; "RTN","BIREPT1",37,0) ;---> BITOTPTS=Total Patients, used by HDR code after EN. "RTN","BIREPT1",38,0) N BITOTPTS "RTN","BIREPT1",39,0) ; "RTN","BIREPT1",40,0) D SETVARS^BIUTL5 N VALMCNT "RTN","BIREPT1",41,0) ;IHS/LAB patch 31 delimited save print type for later use "RTN","BIREPT1",42,0) S BISPD=BIX "RTN","BIREPT1",43,0) I $G(BIX)="PRINT" D PRINT,RESET^BIREPT Q "RTN","BIREPT1",44,0) I $G(BIX)="CSV" D DELIM^BIREPCSV("BIREPT1","TWO YR OLD REPORT","TWO"),RESET^BIREPT Q ;IHS/LAB patch 31 delimited output "RTN","BIREPT1",45,0) ; "RTN","BIREPT1",46,0) ; "RTN","BIREPT1",47,0) ;---> Set BIAG for Age Range in header of report. "RTN","BIREPT1",48,0) ;---> Set BIRPDT for Report Date ("Quarterly, etc.). "RTN","BIREPT1",49,0) ;---> Set BIRTN in case user runs Patient List then needs to return "RTN","BIREPT1",50,0) ;---> to INIT here. "RTN","BIREPT1",51,0) ;---> Set BITITL for Report Name in Patient List, if called. "RTN","BIREPT1",52,0) N BIRPDT,BIRTN,BITITL "RTN","BIREPT1",53,0) S BIRPDT=BIQDT,BIRTN="BIREPT1",BITITL="TWO-YR-OLD" "RTN","BIREPT1",54,0) D EN "RTN","BIREPT1",55,0) Q "RTN","BIREPT1",56,0) ; "RTN","BIREPT1",57,0) ; "RTN","BIREPT1",58,0) ;---------- "RTN","BIREPT1",59,0) PRINT ;EP "RTN","BIREPT1",60,0) ;---> Main entry point for printing the Two-Yr-Old Rates Report. "RTN","BIREPT1",61,0) D DEVICE(.BIPOP) "RTN","BIREPT1",62,0) Q:$G(BIPOP) "RTN","BIREPT1",63,0) ; "RTN","BIREPT1",64,0) D:$G(IO)'=$G(IO(0)) "RTN","BIREPT1",65,0) .W !!?10,"This may take some time. Please hold on...",! "RTN","BIREPT1",66,0) ; "RTN","BIREPT1",67,0) ;---> Prepare report. "RTN","BIREPT1",68,0) K ^TMP("BIREPT1",$J),^TMP("BIDUL",$J) "RTN","BIREPT1",69,0) N VALM,VALMHDR "RTN","BIREPT1",70,0) D START^BIREPT2(BIQDT,BITAR,BIAGRPS,.BICC,.BIHCF,.BICM,.BIBEN,BISITE,BIUP),HDR "RTN","BIREPT1",71,0) ; "RTN","BIREPT1",72,0) D PRTLST^BIUTL8("BIREPT1") "RTN","BIREPT1",73,0) D EXIT,RESET^BIREPT "RTN","BIREPT1",74,0) Q "RTN","BIREPT1",75,0) ; "RTN","BIREPT1",76,0) ; "RTN","BIREPT1",77,0) ;---------- "RTN","BIREPT1",78,0) EN ;EP "RTN","BIREPT1",79,0) ;---> Main entry point for List Template BI REPORT TWO-YR-OLD RATES1. "RTN","BIREPT1",80,0) D EN^VALM("BI REPORT TWO-YR-OLD RATES1") "RTN","BIREPT1",81,0) Q "RTN","BIREPT1",82,0) ; "RTN","BIREPT1",83,0) ; "RTN","BIREPT1",84,0) ;---------- "RTN","BIREPT1",85,0) HDR ;EP "RTN","BIREPT1",86,0) ;---> Header code "RTN","BIREPT1",87,0) D HEAD^BIREPT2(BIQDT,BITAR,BIAGRPS,.BICC,.BIHCF,.BICM,.BIBEN,BIUP) "RTN","BIREPT1",88,0) Q "RTN","BIREPT1",89,0) ; "RTN","BIREPT1",90,0) ; "RTN","BIREPT1",91,0) ;---------- "RTN","BIREPT1",92,0) INIT ;EP "RTN","BIREPT1",93,0) ;---> Initialize variables and list array. "RTN","BIREPT1",94,0) S VALM("TITLE")=$$LMVER^BILOGO "RTN","BIREPT1",95,0) W !!?10,"This may take some time. Please hold on...",! "RTN","BIREPT1",96,0) K ^TMP("BIREPT1",$J),^TMP("BIDUL",$J) "RTN","BIREPT1",97,0) D START^BIREPT2(BIQDT,BITAR,BIAGRPS,.BICC,.BIHCF,.BICM,.BIBEN,BISITE,BIUP) "RTN","BIREPT1",98,0) ;---> Set up ZTSAVE in case user Queues from PL in List. "RTN","BIREPT1",99,0) D ZSAVES^BIUTL3 "RTN","BIREPT1",100,0) Q "RTN","BIREPT1",101,0) ; "RTN","BIREPT1",102,0) ; "RTN","BIREPT1",103,0) ;---------- "RTN","BIREPT1",104,0) RESET ;EP "RTN","BIREPT1",105,0) ;---> Update partition for return to Listmanager. "RTN","BIREPT1",106,0) I $D(VALMQUIT) S VALMBCK="Q" Q "RTN","BIREPT1",107,0) D TERM^VALM0 S VALMBCK="R" "RTN","BIREPT1",108,0) D INIT,HDR Q "RTN","BIREPT1",109,0) ; "RTN","BIREPT1",110,0) ; "RTN","BIREPT1",111,0) ;---------- "RTN","BIREPT1",112,0) HELP ;EP "RTN","BIREPT1",113,0) N BIX S BIX=X "RTN","BIREPT1",114,0) D FULL^VALM1 N BIPOP "RTN","BIREPT1",115,0) D TITLE^BIUTL5("VIEW TWO-YR-OLD REPORT - HELP") "RTN","BIREPT1",116,0) D TEXT1,DIRZ^BIUTL3() "RTN","BIREPT1",117,0) D:BIX'="??" RE^VALM4 "RTN","BIREPT1",118,0) Q "RTN","BIREPT1",119,0) ; "RTN","BIREPT1",120,0) ; "RTN","BIREPT1",121,0) ;---------- "RTN","BIREPT1",122,0) TEXT1 ;EP "RTN","BIREPT1",123,0) ;;You have chosen to View the Two-Yr-Old Report rather than Print it. "RTN","BIREPT1",124,0) ;;(You may print the report from here as well by entering "PL".) "RTN","BIREPT1",125,0) ;; "RTN","BIREPT1",126,0) ;;Also, you may: "RTN","BIREPT1",127,0) ;; "RTN","BIREPT1",128,0) ;;Enter "N" to view the list of Patients who were NOT Current "RTN","BIREPT1",129,0) ;; or "NOT up-to-date" with their immunizations, according "RTN","BIREPT1",130,0) ;; to recommendeded guidelines for their age. "RTN","BIREPT1",131,0) ;; "RTN","BIREPT1",132,0) ;;Enter "C" to view the list of Patients who were CURRENT or "RTN","BIREPT1",133,0) ;; "up-to-date" with their immunizations, according to "RTN","BIREPT1",134,0) ;; recommendeded guidelines for their age. "RTN","BIREPT1",135,0) ;; "RTN","BIREPT1",136,0) ;;Enter "B" to view a list of both groups of patients combined. "RTN","BIREPT1",137,0) ;; "RTN","BIREPT1",138,0) ;; "RTN","BIREPT1",139,0) D PRINTX("TEXT1") "RTN","BIREPT1",140,0) Q "RTN","BIREPT1",141,0) ; "RTN","BIREPT1",142,0) ; "RTN","BIREPT1",143,0) ;---------- "RTN","BIREPT1",144,0) EXIT ;EP "RTN","BIREPT1",145,0) ;---> Cleanup, EOJ. "RTN","BIREPT1",146,0) K ^TMP("BIREPT1",$J) "RTN","BIREPT1",147,0) D CLEAR^VALM1 "RTN","BIREPT1",148,0) D FULL^VALM1 "RTN","BIREPT1",149,0) Q "RTN","BIREPT1",150,0) ; "RTN","BIREPT1",151,0) ; "RTN","BIREPT1",152,0) ;---------- "RTN","BIREPT1",153,0) DEVICE(BIPOP) ;EP "RTN","BIREPT1",154,0) ;---> Get Device and possibly queue to Taskman. "RTN","BIREPT1",155,0) ;---> Parameters: "RTN","BIREPT1",156,0) ; 1 - BIPOP (ret) If error or Queue, BIPOP=1 "RTN","BIREPT1",157,0) ; "RTN","BIREPT1",158,0) K %ZIS,IOP S BIPOP=0 "RTN","BIREPT1",159,0) S ZTRTN="DEQUEUE^BIREPT1" "RTN","BIREPT1",160,0) D ZSAVES^BIUTL3 "RTN","BIREPT1",161,0) D ZIS^BIUTL2(.BIPOP,1) "RTN","BIREPT1",162,0) Q "RTN","BIREPT1",163,0) ; "RTN","BIREPT1",164,0) ; "RTN","BIREPT1",165,0) ;---------- "RTN","BIREPT1",166,0) DEQUEUE ;EP "RTN","BIREPT1",167,0) ; "RTN","BIREPT1",168,0) ;---> Prepare and print Two-Year-Old Report. "RTN","BIREPT1",169,0) K VALMHDR,^TMP("BIREPT1",$J) "RTN","BIREPT1",170,0) D HDR^BIREPT1 "RTN","BIREPT1",171,0) D START^BIREPT2(BIQDT,BITAR,BIAGRPS,.BICC,.BIHCF,.BICM,.BIBEN,BISITE,BIUP) "RTN","BIREPT1",172,0) D PRTLST^BIUTL8("BIREPT1"),EXIT "RTN","BIREPT1",173,0) Q "RTN","BIREPT1",174,0) ; "RTN","BIREPT1",175,0) ; "RTN","BIREPT1",176,0) ;---------- "RTN","BIREPT1",177,0) PRINTX(BILINL,BITAB) ;EP "RTN","BIREPT1",178,0) Q:$G(BILINL)="" "RTN","BIREPT1",179,0) N I,T,X S T="" S:'$D(BITAB) BITAB=5 F I=1:1:BITAB S T=T_" " "RTN","BIREPT1",180,0) F I=1:1 S X=$T(@BILINL+I) Q:X'[";;" W !,T,$P(X,";;",2) "RTN","BIREPT1",181,0) Q "RTN","BIREPT2") 0^14^B48769780 "RTN","BIREPT2",1,0) BIREPT2 ;IHS/CMI/MWR - REPORT, TWO-YR-OLD RATES; MAY 10, 2010 ; 17 Apr 2025 11:21 AM "RTN","BIREPT2",2,0) ;;8.5;IMMUNIZATION;**17,31**;OCT 24, 2011;Build 137 "RTN","BIREPT2",3,0) ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS * "RTN","BIREPT2",4,0) ;; VIEW TWO-YR-OLD IMMUNIZATION RATES REPORT, GATHER DATA. "RTN","BIREPT2",5,0) ;; PATCH 3: Add report line for Hx of Chickenpox. START+34 "RTN","BIREPT2",6,0) ;; PATCG 17: GDIT/HS/BEE 01/15/19;BI*8.5*17;CR#7454-Two-Yr Report Rotavirus Enhancement "RTN","BIREPT2",7,0) ; "RTN","BIREPT2",8,0) ; "RTN","BIREPT2",9,0) ;---------- "RTN","BIREPT2",10,0) HEAD(BIQDT,BITAR,BIAGRPS,BICC,BIHCF,BICM,BIBEN,BIUP) ;EP "RTN","BIREPT2",11,0) ;---> Produce Header array for Two-Yr-Old Report. "RTN","BIREPT2",12,0) ;---> Parameters: "RTN","BIREPT2",13,0) ; 1 - BIQDT (req) Quarter Ending Date. "RTN","BIREPT2",14,0) ; 2 - BITAR (req) Two-Yr-Old Report Age Range, default="19-35". "RTN","BIREPT2",15,0) ; 3 - BIAGRPS (req) String of Age Groups (e.g., 3,5,7,16,19,24,36) "RTN","BIREPT2",16,0) ; 4 - BICC (req) Current Community array. "RTN","BIREPT2",17,0) ; 5 - BIHCF (req) Health Care Facility array. "RTN","BIREPT2",18,0) ; 6 - BICM (req) Case Manager array. "RTN","BIREPT2",19,0) ; 7 - BIBEN (req) Beneficiary Type array. "RTN","BIREPT2",20,0) ; 8 - BIUP (req) User Population/Group (Registered, Imm, User, Active). "RTN","BIREPT2",21,0) ; "RTN","BIREPT2",22,0) ;---> Check for required Variables. "RTN","BIREPT2",23,0) Q:'$G(BIQDT) "RTN","BIREPT2",24,0) Q:'$D(BICC) "RTN","BIREPT2",25,0) Q:'$D(BIHCF) "RTN","BIREPT2",26,0) Q:'$D(BICM) "RTN","BIREPT2",27,0) Q:'$D(BIBEN) "RTN","BIREPT2",28,0) Q:'$D(BITAR) "RTN","BIREPT2",29,0) Q:'$G(BIAGRPS) "RTN","BIREPT2",30,0) S:$G(BIUP)="" BIUP="u" "RTN","BIREPT2",31,0) ; "RTN","BIREPT2",32,0) K VALMHDR "RTN","BIREPT2",33,0) N BILINE,X S BILINE=0 "RTN","BIREPT2",34,0) ; "RTN","BIREPT2",35,0) N X S X="" "RTN","BIREPT2",36,0) ;---> If Header array is NOT being for Listmananger include version. "RTN","BIREPT2",37,0) S:'$D(VALM("BM")) X=$$LMVER^BILOGO() "RTN","BIREPT2",38,0) ; "RTN","BIREPT2",39,0) I BISPD'="CSV" D WH^BIW(.BILINE,X) "RTN","BIREPT2",40,0) S X=$$REPHDR^BIUTL6(DUZ(2)) I BISPD'="CSV" D CENTERT^BIUTL5(.X) "RTN","BIREPT2",41,0) D WH^BIW(.BILINE,X) "RTN","BIREPT2",42,0) ; "RTN","BIREPT2",43,0) S X="* Two-Yr-Old Immunization Report ("_$P(BITAR,"-")_"-35 mths) *" "RTN","BIREPT2",44,0) D CENTERT^BIUTL5(.X) "RTN","BIREPT2",45,0) D WH^BIW(.BILINE,X) "RTN","BIREPT2",46,0) ; "RTN","BIREPT2",47,0) S:BISPD'="CSV" X=$$SP^BIUTL5(27)_"Report Date: "_$$SLDT1^BIUTL5(DT) S:BISPD="CSV" X="Report Date: "_$$SLDT1^BIUTL5(DT) "RTN","BIREPT2",48,0) D WH^BIW(.BILINE,X) "RTN","BIREPT2",49,0) ; "RTN","BIREPT2",50,0) S:BISPD'="CSV" X=$$SP^BIUTL5(30)_"End Date: "_$$SLDT1^BIUTL5(BIQDT) S:BISPD="CSV" X="End Date: "_$$SLDT1^BIUTL5(BIQDT) "RTN","BIREPT2",51,0) D WH^BIW(.BILINE,X,$S(BISPD="CSV":"",1:1)) "RTN","BIREPT2",52,0) ; "RTN","BIREPT2",53,0) S X=" "_$$BIUPTX^BIUTL6(BIUP) ;I BISPD="CSV" S X=$TR(BISPD," ") "RTN","BIREPT2",54,0) I BIUP="i" S X=" "_$$BIUPTX^BIUTL6(BIUP,1)_" (Active)" "RTN","BIREPT2",55,0) S:BISPD'="CSV" X=$$PAD^BIUTL5(X,54) S:BISPD="CSV" X=X_"," "RTN","BIREPT2",56,0) ; "RTN","BIREPT2",57,0) S X=X_$J("Total Patients: "_$G(BITOTPTS),24) D WH^BIW(.BILINE,X) "RTN","BIREPT2",58,0) ; "RTN","BIREPT2",59,0) I BISPD'="CSV" D WH^BIW(.BILINE,$$SP^BIUTL5(79,"-")) "RTN","BIREPT2",60,0) ; "RTN","BIREPT2",61,0) D "RTN","BIREPT2",62,0) .;---> If specific Communities were selected (not ALL), then print "RTN","BIREPT2",63,0) .;---> the Communities in a subheader at the top of the report. "RTN","BIREPT2",64,0) .D SUBH^BIOUTPT5("BICC","Community",,"^AUTTCOM(",.BILINE,.BIERR,,12) "RTN","BIREPT2",65,0) .I $G(BIERR) D ERRCD^BIUTL2(BIERR,.X) D WH^BIW(.BILINE,X) Q "RTN","BIREPT2",66,0) .; "RTN","BIREPT2",67,0) .;---> If specific Health Care Facilities, print subheader. "RTN","BIREPT2",68,0) .D SUBH^BIOUTPT5("BIHCF","Facility",,"^DIC(4,",.BILINE,.BIERR,,12) "RTN","BIREPT2",69,0) .I $G(BIERR) D ERRCD^BIUTL2(BIERR,.X) D WH^BIW(.BILINE,X) Q "RTN","BIREPT2",70,0) .; "RTN","BIREPT2",71,0) .;---> If specific Case Managers, print Case Manager subheader. "RTN","BIREPT2",72,0) .D SUBH^BIOUTPT5("BICM","Case Manager",,"^VA(200,",.BILINE,.BIERR,,12) "RTN","BIREPT2",73,0) .I $G(BIERR) D ERRCD^BIUTL2(BIERR,.X) D WH^BIW(.BILINE,X) Q "RTN","BIREPT2",74,0) .; "RTN","BIREPT2",75,0) .;---> If specific Beneficiary Types, print Beneficiary Type subheader. "RTN","BIREPT2",76,0) .D SUBH^BIOUTPT5("BIBEN","Beneficiary Type",,"^AUTTBEN(",.BILINE,.BIERR,,12) "RTN","BIREPT2",77,0) .I $G(BIERR) D ERRCD^BIUTL2(BIERR,.X) D WH^BIW(.BILINE,X) Q "RTN","BIREPT2",78,0) N .; "RTN","BIREPT2",79,0) .I BISPD="CSV" D Q "RTN","BIREPT2",80,0) ..S X="Age Group,3 mo,5 mo,7 mo,16 mo,19 mo" "RTN","BIREPT2",81,0) ..S:BIAGRPS["24" X=X_",24 mo" "RTN","BIREPT2",82,0) ..S X=X_",35 mo" ;X_","_$E(BIQDT,4,5)_"."_$E(BIQDT,6,7)_"."_$E(BIQDT,2,3) ;$$SLDT2^BIUTL5(BIQDT,1) "RTN","BIREPT2",83,0) ..D WH^BIW(.BILINE,X) "RTN","BIREPT2",84,0) ..S X="Total Number of Eligible Patients,"_BITOTPTS_","_BITOTPTS_","_BITOTPTS_","_BITOTPTS_","_BITOTPTS_","_BITOTPTS S:BIAGRPS["24" X=X_","_BITOTPTS "RTN","BIREPT2",85,0) ..D WH^BIW(.BILINE,X) "RTN","BIREPT2",86,0) .S X=" Received by | 3 mo 5 mo 7 mo 16 mo 19 mo" "RTN","BIREPT2",87,0) .S:BIAGRPS["24" X=X_" 24 mo" "RTN","BIREPT2",88,0) .S X=X_" "_$$SLDT2^BIUTL5(BIQDT,1) "RTN","BIREPT2",89,0) .D WH^BIW(.BILINE,X) "RTN","BIREPT2",90,0) .S X=" | # % # % # % # % # %" "RTN","BIREPT2",91,0) .S X=X_" # %" "RTN","BIREPT2",92,0) .S:BIAGRPS["24" X=X_" # %" "RTN","BIREPT2",93,0) .D WH^BIW(.BILINE,X) "RTN","BIREPT2",94,0) ; "RTN","BIREPT2",95,0) ;---> If Header array is being built for Listmananger, "RTN","BIREPT2",96,0) ;---> reset display window margins for Communities, etc. "RTN","BIREPT2",97,0) D:$D(VALM("BM")) "RTN","BIREPT2",98,0) .S VALM("TM")=BILINE+3 "RTN","BIREPT2",99,0) .S VALM("LINES")=VALM("BM")-VALM("TM")+1 "RTN","BIREPT2",100,0) .;---> Safeguard to prevent divide/0 error. "RTN","BIREPT2",101,0) .S:VALM("LINES")<1 VALM("LINES")=1 "RTN","BIREPT2",102,0) Q "RTN","BIREPT2",103,0) ; "RTN","BIREPT2",104,0) ; "RTN","BIREPT2",105,0) ;---------- "RTN","BIREPT2",106,0) START(BIQDT,BITAR,BIAGRPS,BICC,BIHCF,BICM,BIBEN,BISITE,BIUP) ;EP "RTN","BIREPT2",107,0) ;---> Produce array for Quarterly Immunization Report. "RTN","BIREPT2",108,0) ;---> Parameters: "RTN","BIREPT2",109,0) ; 1 - BIQDT (req) Quarter Ending Date. "RTN","BIREPT2",110,0) ; 2 - BITAR (opt) Two-Yr-Old Report Age Range, default="19-35". "RTN","BIREPT2",111,0) ; 3 - BIAGRPS (req) String of Age Groups (e.g., 3,5,7,16,19,24,36) "RTN","BIREPT2",112,0) ; 4 - BICC (req) Current Community array. "RTN","BIREPT2",113,0) ; 5 - BIHCF (req) Health Care Facility array. "RTN","BIREPT2",114,0) ; 6 - BICM (req) Case Manager array. "RTN","BIREPT2",115,0) ; 7 - BIBEN (req) Beneficiary Type array. "RTN","BIREPT2",116,0) ; 8 - BISITE (req) Site IEN. "RTN","BIREPT2",117,0) ; 9 - BIUP (req) User Population/Group (Registered, Imm, User, Active). "RTN","BIREPT2",118,0) ; "RTN","BIREPT2",119,0) K ^TMP("BIREPT1",$J) "RTN","BIREPT2",120,0) N BILINE,BITMP,X S BILINE=0 "RTN","BIREPT2",121,0) ; "RTN","BIREPT2",122,0) ;---> Check for required Variables. "RTN","BIREPT2",123,0) I '$G(BIQDT) D ERRCD^BIUTL2(623,.X) D WRITE^BIREPT3(.BILINE,X) Q "RTN","BIREPT2",124,0) I '$D(BITAR) D ERRCD^BIUTL2(613,.X) D WRITE^BIREPT3(.BILINE,X) Q "RTN","BIREPT2",125,0) I '$G(BIAGRPS) D ERRCD^BIUTL2(677,.X) D WRITE^BIREPT3(.BILINE,X) Q "RTN","BIREPT2",126,0) I '$D(BICC) D ERRCD^BIUTL2(614,.X) D WRITE^BIREPT3(.BILINE,X) Q "RTN","BIREPT2",127,0) I '$D(BIHCF) D ERRCD^BIUTL2(625,.X) D WRITE^BIREPT3(.BILINE,X) Q "RTN","BIREPT2",128,0) I '$D(BICM) D ERRCD^BIUTL2(615,.X) D WRITE^BIREPT3(.BILINE,X) Q "RTN","BIREPT2",129,0) I '$D(BIBEN) D ERRCD^BIUTL2(662,.X) D WRITE^BIREPT3(.BILINE,X) Q "RTN","BIREPT2",130,0) I '$G(BISITE) S BISITE=$G(DUZ(2)) "RTN","BIREPT2",131,0) I '$G(BISITE) D ERRCD^BIUTL2(109,.X) D WRITE^BIREPT3(.BILINE,X) Q "RTN","BIREPT2",132,0) S:$G(BIUP)="" BIUP="u" "RTN","BIREPT2",133,0) ; "RTN","BIREPT2",134,0) ;---> Gather data. "RTN","BIREPT2",135,0) D GETDATA^BIREPT3(.BICC,.BIHCF,.BICM,.BIBEN,BIQDT,BITAR,BIAGRPS,BISITE,BIUP,.BIERR) "RTN","BIREPT2",136,0) I $G(BIERR)]"" D WRITE^BIREPT3(.BILINE,BIERR) Q "RTN","BIREPT2",137,0) ; "RTN","BIREPT2",138,0) ;---> Write Statistics lines for each Vaccine Group (BIVGRP). "RTN","BIREPT2",139,0) ; "RTN","BIREPT2",140,0) ; GDIT/HS/BEE 01/15/19;BI*8.5*17;CR#7454-Two-Yr Report Rotavirus Enhancement "RTN","BIREPT2",141,0) ;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR "RTN","BIREPT2",142,0) ;---> Add report line for Hx of Chickenpox. "RTN","BIREPT2",143,0) ;F BIVGRP=1,2,3,4,6,7,9,10,11,15 D VGRP^BIREPT3(.BILINE,BIVGRP,BIAGRPS,.BIERR) "RTN","BIREPT2",144,0) ;F BIVGRP=1,2,3,4,6,7,132,9,10,11,15 D VGRP^BIREPT3(.BILINE,BIVGRP,BIAGRPS,.BIERR) "RTN","BIREPT2",145,0) F BIVGRP=1,2,3,4,6,7,132,9,10,11,135,140 D VGRP^BIREPT3(.BILINE,BIVGRP,BIAGRPS,.BIERR) "RTN","BIREPT2",146,0) ;********** "RTN","BIREPT2",147,0) ; "RTN","BIREPT2",148,0) I $G(BIERR)]"" D WRITE^BIREPT3(.BILINE,BIERR) Q "RTN","BIREPT2",149,0) ; "RTN","BIREPT2",150,0) ;---> Write Statistics lines for each Vaccine Combinations. "RTN","BIREPT2",151,0) ;---> NOTE: These Combo strings are also used to set BITMP("STATS" "RTN","BIREPT2",152,0) ;---> nodes beginning at +130^BIREPT4. vvv83 "RTN","BIREPT2",153,0) D VCOMB^BIREPT3(.BILINE,"1|1^2|1^3|1^4|1",BIAGRPS,.BIERR) "RTN","BIREPT2",154,0) D VCOMB^BIREPT3(.BILINE,"1|4^2|3^6|1",BIAGRPS,.BIERR) "RTN","BIREPT2",155,0) D VCOMB^BIREPT3(.BILINE,"1|4^2|3^6|1^3|3",BIAGRPS,.BIERR) "RTN","BIREPT2",156,0) D VCOMB^BIREPT3(.BILINE,"1|4^2|3^6|1^3|3^4|3",BIAGRPS,.BIERR) "RTN","BIREPT2",157,0) D VCOMB^BIREPT3(.BILINE,"1|4^2|3^6|1^3|3^4|3^7|1",BIAGRPS,.BIERR) "RTN","BIREPT2",158,0) D VCOMB^BIREPT3(.BILINE,"1|4^2|3^6|1^3|3^4|3^7|1^11|3",BIAGRPS,.BIERR) "RTN","BIREPT2",159,0) ;---> Next combo is up to date (UTD); send 5th parameter=1. "RTN","BIREPT2",160,0) D VCOMB^BIREPT3(.BILINE,"1|4^2|3^6|1^3|3^4|3^7|1^11|4",BIAGRPS,.BIERR,1) "RTN","BIREPT2",161,0) D VCOMB^BIREPT3(.BILINE,"1|4^2|3^6|1^3|3^4|3^7|1^11|4^9|1",BIAGRPS,.BIERR) "RTN","BIREPT2",162,0) D VCOMB^BIREPT3(.BILINE,"1|4^2|3^6|1^3|3^4|3^7|1^11|4^9|2^15|3",BIAGRPS,.BIERR) "RTN","BIREPT2",163,0) D VCOMB^BIREPT3(.BILINE,"1|4^2|3^6|1^3|3^4|3^7|1^11|4^9|2^15|3^10|2",BIAGRPS,.BIERR) "RTN","BIREPT2",164,0) I $G(BIERR)]"" D WRITE^BIREPT3(.BILINE,BIERR) Q "RTN","BIREPT2",165,0) ; "RTN","BIREPT2",166,0) ;---> BITOTPTS (total patients) not newed here because it is also "RTN","BIREPT2",167,0) ;---> used in the Header. "RTN","BIREPT2",168,0) S BITOTPTS=+$G(BITMP("STATS","TOTLPTS")) "RTN","BIREPT2",169,0) I BISPD'="CSV" S X=" Total Active Patients reviewed"_$J(BITOTPTS,44) "RTN","BIREPT2",170,0) I BISPD="CSV" S X="Total Active Patients reviewed,"_BITOTPTS "RTN","BIREPT2",171,0) D WRITE^BIREPT3(.BILINE,X) "RTN","BIREPT2",172,0) I BISPD'="CSV" D WRITE^BIREPT3(.BILINE,$$SP^BIUTL5(79,"-")) "RTN","BIREPT2",173,0) ; "RTN","BIREPT2",174,0) ;---> Now write total patients considered who had refusals. "RTN","BIREPT2",175,0) N M,N S (M,N)=0 F S M=$O(BITMP("REFUSALS",M)) Q:'M S N=N+1 "RTN","BIREPT2",176,0) I BISPD'="CSV" S X=" Total Patients included who had Refusals on record"_$J(N,24) "RTN","BIREPT2",177,0) I BISPD="CSV" S X="Total Patients included who had Refusals on record,"_N "RTN","BIREPT2",178,0) D WRITE^BIREPT3(.BILINE,X) I BISPD'="CSV" D WRITE^BIREPT3(.BILINE,$$SP^BIUTL5(79,"-")) "RTN","BIREPT2",179,0) ; "RTN","BIREPT2",180,0) ;---> Set final VALMCNT (Listman line count). "RTN","BIREPT2",181,0) S VALMCNT=BILINE "RTN","BIREPT2",182,0) Q "RTN","BIREPT2",183,0) ; "RTN","BIREPT2",184,0) ;GDIT/HS/BEE 01/15/19;BI*8.5*17;CR#7454-Two-Yr Report Rotavirus Enhancement "RTN","BIREPT2",185,0) ;New CKROTA taga - Determine if patient up to date on ROTA "RTN","BIREPT2",186,0) CKROTA(BIROTA,BIROTA1,BIROTA5) ;EP "RTN","BIREPT2",187,0) ; "RTN","BIREPT2",188,0) ;Input: "RTN","BIREPT2",189,0) ; BIROTA - Number of unknown/Non-ROTA1/Non-ROTA5 vaccines administered "RTN","BIREPT2",190,0) ;BIROTA1 - Number of ROTA1 vaccines administered "RTN","BIREPT2",191,0) ;BIROTA5 - Number of ROTA5 vaccines administered "RTN","BIREPT2",192,0) ; "RTN","BIREPT2",193,0) ;Output: 1 - UTD, 0 - Not UTD "RTN","BIREPT2",194,0) ; "RTN","BIREPT2",195,0) ;Check for 2 ROTA1 "RTN","BIREPT2",196,0) I +$G(BIROTA1)>1 Q 1 "RTN","BIREPT2",197,0) ; "RTN","BIREPT2",198,0) ;Check for 3 of any (ROTA1, ROTA5, unknown) "RTN","BIREPT2",199,0) I (+$G(BIROTA)+$G(BIROTA1)+$G(BIROTA5))>2 Q 1 "RTN","BIREPT2",200,0) ; "RTN","BIREPT2",201,0) Q 0 "RTN","BIREPT3") 0^15^B44572047 "RTN","BIREPT3",1,0) BIREPT3 ;IHS/CMI/MWR - REPORT, TWO-YR-OLD RATES; MAY 10, 2010 "RTN","BIREPT3",2,0) ;;8.5;IMMUNIZATION;**17,31**;OCT 24,2011;Build 137 "RTN","BIREPT3",3,0) ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS * "RTN","BIREPT3",4,0) ;; VIEW TWO-YR-OLD IMMUNIZATION RATES REPORT. "RTN","BIREPT3",5,0) ;; PATCH 3: Add report line for Hx of Chickenpox. VGRP+19 "RTN","BIREPT3",6,0) ;; PATCH 17: GDIT/HS/BEE 01/15/19;BI*8.5*17;CR#7454-Two-Yr Report Rotavirus Enhancement "RTN","BIREPT3",7,0) ; "RTN","BIREPT3",8,0) ; "RTN","BIREPT3",9,0) ;---------- "RTN","BIREPT3",10,0) GETDATA(BICC,BIHCF,BICM,BIBEN,BIQDT,BITAR,BIAGRPS,BISITE,BIUP,BIERR) ;EP "RTN","BIREPT3",11,0) ;---> Gather Immunization History data on selected patients. "RTN","BIREPT3",12,0) ;---> Parameters: "RTN","BIREPT3",13,0) ; 1 - BICC (req) Current Community array. "RTN","BIREPT3",14,0) ; 2 - BIHCF (req) Health Care Facility array. "RTN","BIREPT3",15,0) ; 3 - BICM (req) Case Manager array. "RTN","BIREPT3",16,0) ; 4 - BIBEN (req) Beneficiary Type array. "RTN","BIREPT3",17,0) ; 5 - BIQDT (req) Quarter Ending Date. "RTN","BIREPT3",18,0) ; 6 - BITAR (opt) Two-Yr-Old Age Range; default="19-35" (months). "RTN","BIREPT3",19,0) ; 7 - BIAGRPS (req) String of Age Groups (e.g., 3,5,7,16,19,24,36) "RTN","BIREPT3",20,0) ; 8 - BISITE (req) Site IEN. "RTN","BIREPT3",21,0) ; 9 - BIUP (req) User Population/Group (Registered, Imm, User, Active). "RTN","BIREPT3",22,0) ; 10 - BIERR (ret) Error. "RTN","BIREPT3",23,0) ; "RTN","BIREPT3",24,0) S:'$G(BISITE) BISITE=$G(DUZ(2)) I '$G(BISITE) S BIERR=109 Q "RTN","BIREPT3",25,0) S:'$G(BIQDT) BIQDT=DT "RTN","BIREPT3",26,0) S:'$D(BITAR) BITAR="19-35" "RTN","BIREPT3",27,0) S:$G(BIUP)="" BIUP="u" "RTN","BIREPT3",28,0) ; "RTN","BIREPT3",29,0) ;---> Get Begin and End Dates (DOB's). "RTN","BIREPT3",30,0) D AGEDATE^BIAGE(BITAR,BIQDT,.BIBEGDT,.BIENDDT,.BIERR) "RTN","BIREPT3",31,0) Q:$G(BIERR)]"" "RTN","BIREPT3",32,0) ; "RTN","BIREPT3",33,0) ;---> Gather and sort patients. "RTN","BIREPT3",34,0) D GETPATS^BIREPT4(BIBEGDT,BIENDDT,.BICC,.BIHCF,.BICM,.BIBEN,BIQDT,BIAGRPS,BISITE,BIUP) "RTN","BIREPT3",35,0) Q "RTN","BIREPT3",36,0) ; "RTN","BIREPT3",37,0) ; "RTN","BIREPT3",38,0) ;---------- "RTN","BIREPT3",39,0) VGRP(BILINE,BIVGRP,BIAGRPS,BIERR,BIDELIM) ;EP "RTN","BIREPT3",40,0) ;IHS/LAB - patch 31 add setting of "," delimited output if delimited "RTN","BIREPT3",41,0) ;---> Write Stats lines for each Vaccine Group. "RTN","BIREPT3",42,0) ;---> Parameters: "RTN","BIREPT3",43,0) ; 1 - BILINE (req) Line number in ^TMP Listman array. "RTN","BIREPT3",44,0) ; 2 - BIVGRP (req) IEN of Vaccine Group. "RTN","BIREPT3",45,0) ; 3 - BIAGRPS (req) String of Age Groups (e.g., 3,5,7,16,19,24,36) "RTN","BIREPT3",46,0) ; 4 - BIERR (ret) Error. "RTN","BIREPT3",47,0) ; "RTN","BIREPT3",48,0) I '$G(BIVGRP) D ERRCD^BIUTL2(510,.BIERR) Q "RTN","BIREPT3",49,0) I '$G(BIAGRPS) D ERRCD^BIUTL2(677,.BIERR) Q "RTN","BIREPT3",50,0) ;IHS/LAB - patch 31 "RTN","BIREPT3",51,0) ; "RTN","BIREPT3",52,0) ;---> Write two lines for each Dose of this Vaccine Group. "RTN","BIREPT3",53,0) N BIDOSE,BIMAXD S BIMAXD=$$VGROUP^BIUTL2(BIVGRP,6) "RTN","BIREPT3",54,0) ; "RTN","BIREPT3",55,0) ;GDIT/HS/BEE 01/15/19;BI*8.5*17;CR#7454-Two-Yr Report Rotavirus Enhancement "RTN","BIREPT3",56,0) ;Handle custom groups for ROTA5/ROTA1 "RTN","BIREPT3",57,0) I BIVGRP=135 S BIMAXD=3 "RTN","BIREPT3",58,0) I BIVGRP=140 S BIMAXD=2 "RTN","BIREPT3",59,0) ;********** "RTN","BIREPT3",60,0) S:'BIMAXD BIMAXD=1 "RTN","BIREPT3",61,0) ;********** "RTN","BIREPT3",62,0) F BIDOSE=1:1:BIMAXD D "RTN","BIREPT3",63,0) .;---> BIX=text of the line to write. "RTN","BIREPT3",64,0) .; "RTN","BIREPT3",65,0) .;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR "RTN","BIREPT3",66,0) .;---> Add report line for Hx of Chickenpox. "RTN","BIREPT3",67,0) .;N BIX S BIX=" "_BIDOSE_"-"_$$VGROUP^BIUTL2(BIVGRP,5) "RTN","BIREPT3",68,0) .;GDIT/HS/BEE 01/15/19;BI*8.5*17;CR#7454-Two-Yr Report Rotavirus Enhancement "RTN","BIREPT3",69,0) .;Rework name logic to handle custom names "RTN","BIREPT3",70,0) .;N BIX D "RTN","BIREPT3",71,0) .;.;---> Include exception here for Chickenpox. "RTN","BIREPT3",72,0) .;.I BIVGRP=132 S BIX=" Hx of ChPox" Q "RTN","BIREPT3",73,0) .;.;---> Write the Dose#-Vaccine Group in left margin. "RTN","BIREPT3",74,0) .;.S BIX=" "_BIDOSE_"-"_$$VGROUP^BIUTL2(BIVGRP,5) "RTN","BIREPT3",75,0) .N BIX,BINAM D "RTN","BIREPT3",76,0) ..;---> Include exception here for Chickenpox. "RTN","BIREPT3",77,0) ..I BIVGRP=132 S BIX=" Hx of ChPox"_$S(BISPD="CSV":" (Immune) #",1:"") Q "RTN","BIREPT3",78,0) ..;---> Write the Dose#-Vaccine Group in left margin. "RTN","BIREPT3",79,0) ..S BINAM=$$VGROUP^BIUTL2(BIVGRP,5) "RTN","BIREPT3",80,0) ..I BIVGRP=135 S BINAM="ROTA5" "RTN","BIREPT3",81,0) ..I BIVGRP=140 S BINAM="ROTA1" "RTN","BIREPT3",82,0) ..I $G(BISPD)="CSV" S BIX=BIDOSE_"-"_BINAM_" #" "RTN","BIREPT3",83,0) ..I $G(BISPD)'="CSV" S BIX=" "_BIDOSE_"-"_BINAM "RTN","BIREPT3",84,0) .;********** "RTN","BIREPT3",85,0) .; "RTN","BIREPT3",86,0) .I BISPD'="CSV" S BIX=$$PAD^BIUTL5(BIX,13)_"|" "RTN","BIREPT3",87,0) .; "RTN","BIREPT3",88,0) 2 .;---> Now loop through the 6 age groups, concating subtotals. "RTN","BIREPT3",89,0) .N BIAGRP,K "RTN","BIREPT3",90,0) .F K=1:1 S BIAGRP=$P(BIAGRPS,",",K) Q:'BIAGRP D "RTN","BIREPT3",91,0) ..N Y S Y=$G(BITMP("STATS",BIVGRP,BIDOSE,BIAGRP)) "RTN","BIREPT3",92,0) ..I $G(BISPD)="CSV" S BIX=BIX_","_+Y "RTN","BIREPT3",93,0) ..I $G(BISPD)'="CSV" S BIX=BIX_$J(Y,7)_" " "RTN","BIREPT3",94,0) .I BISPD="CSV" S BIX=BIX_"," "RTN","BIREPT3",95,0) .D WRITE(.BILINE,BIX) "RTN","BIREPT3",96,0) .D MARK^BIW(BILINE,3,"BIREPT1") "RTN","BIREPT3",97,0) .; "RTN","BIREPT3",98,0) .;---> Now write percentages line. "RTN","BIREPT3",99,0) .; "RTN","BIREPT3",100,0) .;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR "RTN","BIREPT3",101,0) .;---> Add report line for Hx of Chickenpox. "RTN","BIREPT3",102,0) .I BISPD'="CSV" D "RTN","BIREPT3",103,0) ..S BIX=$$SP^BIUTL5(13)_"|" "RTN","BIREPT3",104,0) ..S BIX="" S:BIVGRP=132 BIX=" (Immune)" "RTN","BIREPT3",105,0) ..S BIX=$$PAD^BIUTL5(BIX,13)_"|" "RTN","BIREPT3",106,0) .I BISPD="CSV" D "RTN","BIREPT3",107,0) ..I BIVGRP=132 S BIX="Hx of ChPox (Immune) %" Q "RTN","BIREPT3",108,0) ..S BIX=BIDOSE_"-"_BINAM_" %" "RTN","BIREPT3",109,0) .;********** "RTN","BIREPT3",110,0) .; "RTN","BIREPT3",111,0) .F K=1:1 S BIAGRP=$P(BIAGRPS,",",K) Q:'BIAGRP D "RTN","BIREPT3",112,0) ..N Y S Y=$G(BITMP("STATS",BIVGRP,BIDOSE,BIAGRP)) "RTN","BIREPT3",113,0) ..I 'Y,BISPD'="CSV" S BIX=BIX_$J(Y,7)_" " Q "RTN","BIREPT3",114,0) ..I 'Y,BISPD="CSV" S BIX=BIX_","_+Y Q "RTN","BIREPT3",115,0) ..I '$G(BITMP("STATS","TOTLPTS")) S:BISPD'="CSV" BIX=BIX_$J(Y,7)_" " S:BISPD="CSV" BIX=BIX_","_0 Q "RTN","BIREPT3",116,0) ..S Y=(Y*100)/$G(BITMP("STATS","TOTLPTS")) "RTN","BIREPT3",117,0) ..I BISPD'="CSV" S BIX=BIX_$J(Y,7,0)_"% " "RTN","BIREPT3",118,0) ..I BISPD="CSV" S BIX=BIX_","_$$STRIP^XLFSTR($J(Y,7,0)," ") "RTN","BIREPT3",119,0) .D WRITE(.BILINE,BIX) "RTN","BIREPT3",120,0) .Q:BIDOSE=BIMAXD "RTN","BIREPT3",121,0) .Q:BISPD="CSV" "RTN","BIREPT3",122,0) .S BIX=$$SP^BIUTL5(13)_"|"_$$SP^BIUTL5(65,"-") "RTN","BIREPT3",123,0) .D WRITE(.BILINE,BIX) "RTN","BIREPT3",124,0) I BISPD'="CSV" D WRITE(.BILINE,$$SP^BIUTL5(79,"-")) "RTN","BIREPT3",125,0) Q "RTN","BIREPT3",126,0) ; "RTN","BIREPT3",127,0) ; "RTN","BIREPT3",128,0) ;---------- "RTN","BIREPT3",129,0) VCOMB(BILINE,BICOMB,BIAGRPS,BIERR,BIUTD) ;EP "RTN","BIREPT3",130,0) ;---> Write Stats lines for each Vaccine Combination. "RTN","BIREPT3",131,0) ;---> Parameters: "RTN","BIREPT3",132,0) ; 1 - BILINE (req) Line number in ^TMP Listman array. "RTN","BIREPT3",133,0) ; 2 - BICOMB (req) Numeric code of Vaccine Combination. "RTN","BIREPT3",134,0) ; 3 - BIAGRPS (req) String of Age Groups (e.g., 3,5,7,16,19,24,36) "RTN","BIREPT3",135,0) ; 4 - BIERR (ret) Error. "RTN","BIREPT3",136,0) ; 5 - BIUTD (opt) If BIUTD=1, tack on text: "*UTD" "RTN","BIREPT3",137,0) ; "RTN","BIREPT3",138,0) I '$G(BIVGRP) D ERRCD^BIUTL2(678,.BIERR) Q "RTN","BIREPT3",139,0) I '$G(BIAGRPS) D ERRCD^BIUTL2(677,.BIERR) Q "RTN","BIREPT3",140,0) ; vvv83 "RTN","BIREPT3",141,0) ; "RTN","BIREPT3",142,0) N BIX,I,X "RTN","BIREPT3",143,0) F I=1:1:6 S BIX(I)="" "RTN","BIREPT3",144,0) F I=1:1 S X=$P(BICOMB,U,I) Q:X="" D "RTN","BIREPT3",145,0) .;GDIT/HS/BEE 01/15/19;BI*8.5*17;CR#7454-Two-Yr Report Rotavirus Enhancement "RTN","BIREPT3",146,0) .;Handle 2/3-ROTA display "RTN","BIREPT3",147,0) .;S X=$P(X,"|",2)_"-"_$$VGROUP^BIUTL2($P(X,"|"),5) "RTN","BIREPT3",148,0) .NEW GRP "RTN","BIREPT3",149,0) .S GRP=$$VGROUP^BIUTL2($P(X,"|"),5) "RTN","BIREPT3",150,0) .S X=$S(GRP="ROTA":"2/3",1:$P(X,"|",2))_"-"_GRP "RTN","BIREPT3",151,0) .;S X=$P(X,"|",2)_"-"_$$VGROUP^BIUTL2($P(X,"|"),5) "RTN","BIREPT3",152,0) .I I<3 S BIX(1)=BIX(1)_" "_X Q "RTN","BIREPT3",153,0) .I I<5 S BIX(2)=BIX(2)_" "_X Q "RTN","BIREPT3",154,0) .I I<7 S BIX(3)=BIX(3)_" "_X Q "RTN","BIREPT3",155,0) .I I<9 S BIX(4)=BIX(4)_" "_X S:$G(BIUTD) BIX(4)=BIX(4)_" *UTD" Q "RTN","BIREPT3",156,0) .I I<10 S BIX(5)=BIX(5)_" "_X Q "RTN","BIREPT3",157,0) .S BIX(6)=BIX(6)_" "_X "RTN","BIREPT3",158,0) ; "RTN","BIREPT3",159,0) ;---> Now loop through the age groups, concating subtotals. "RTN","BIREPT3",160,0) I BISPD'="CSV" S BIX=BIX(1) S BIX=$$PAD^BIUTL5(BIX,13)_"|" "RTN","BIREPT3",161,0) I BISPD="CSV" D "RTN","BIREPT3",162,0) .S BIX=BIX(1)_" "_BIX(2) "RTN","BIREPT3",163,0) .F I=3,4,5,6 I BIX(I)]"" S BIX=BIX_" "_BIX(I) "RTN","BIREPT3",164,0) .S BIX=BIX_" #" "RTN","BIREPT3",165,0) N BIAGRP,K "RTN","BIREPT3",166,0) F K=1:1 S BIAGRP=$P(BIAGRPS,",",K) Q:'BIAGRP D "RTN","BIREPT3",167,0) .N Y S Y=$G(BITMP("STATS",BICOMB,BIAGRP)) "RTN","BIREPT3",168,0) .I BISPD'="CSV" S BIX=BIX_$J(Y,7)_" " "RTN","BIREPT3",169,0) .I BISPD="CSV" S BIX=BIX_","_+Y "RTN","BIREPT3",170,0) S:BISPD="CSV" BIX=BIX_"," "RTN","BIREPT3",171,0) D WRITE(.BILINE,BIX) "RTN","BIREPT3",172,0) S I=3 S:BIX(3)]"" I=4 S:BIX(4)]"" I=5 "RTN","BIREPT3",173,0) D MARK^BIW(BILINE,I,"BIREPT1") "RTN","BIREPT3",174,0) ; "RTN","BIREPT3",175,0) ;---> Now write percentages line. "RTN","BIREPT3",176,0) I BISPD'="CSV" S BIX=BIX(2),BIX=$$PAD^BIUTL5(BIX,13)_"|" "RTN","BIREPT3",177,0) I BISPD="CSV" S BIX=$P(BIX,"#"),BIX=BIX_"%" "RTN","BIREPT3",178,0) F K=1:1 S BIAGRP=$P(BIAGRPS,",",K) Q:'BIAGRP D "RTN","BIREPT3",179,0) .N Y S Y=$G(BITMP("STATS",BICOMB,BIAGRP)) "RTN","BIREPT3",180,0) .;I 'Y S BIX=BIX_$J(Y,7)_" " Q "RTN","BIREPT3",181,0) .I 'Y,BISPD'="CSV" S BIX=BIX_$J(Y,7)_" " Q "RTN","BIREPT3",182,0) .I 'Y,BISPD="CSV" S BIX=BIX_","_+Y Q "RTN","BIREPT3",183,0) .I '$G(BITMP("STATS","TOTLPTS")) S:BISPD'="CSV" BIX=BIX_$J(Y,7)_" " S:BISPD="CSV" BIX=BIX_","_0 Q "RTN","BIREPT3",184,0) .S Y=(Y*100)/$G(BITMP("STATS","TOTLPTS")) "RTN","BIREPT3",185,0) .I BISPD'="CSV" S BIX=BIX_$J(Y,7,0)_"% " "RTN","BIREPT3",186,0) .I BISPD="CSV" S BIX=BIX_","_$$STRIP^XLFSTR($J(Y,7,0)," ") "RTN","BIREPT3",187,0) D WRITE(.BILINE,BIX) "RTN","BIREPT3",188,0) ; "RTN","BIREPT3",189,0) I BISPD'="CSV" F I=3,4,5,6 D:BIX(I)]"" "RTN","BIREPT3",190,0) .S BIX=BIX(I),BIX=$$PAD^BIUTL5(BIX,13)_"|" "RTN","BIREPT3",191,0) .D WRITE(.BILINE,BIX) "RTN","BIREPT3",192,0) ; "RTN","BIREPT3",193,0) I BISPD'="CSV" D WRITE(.BILINE,$$SP^BIUTL5(79,"-")) "RTN","BIREPT3",194,0) Q "RTN","BIREPT3",195,0) ; "RTN","BIREPT3",196,0) ; "RTN","BIREPT3",197,0) ;---------- "RTN","BIREPT3",198,0) WRITE(BILINE,BIVAL,BIBLNK) ;EP "RTN","BIREPT3",199,0) ;---> Write lines to ^TMP (see documentation in ^BIW). "RTN","BIREPT3",200,0) ;---> Parameters: "RTN","BIREPT3",201,0) ; 1 - BILINE (ret) Last line# written. "RTN","BIREPT3",202,0) ; 2 - BIVAL (opt) Value/text of line (Null=blank line). "RTN","BIREPT3",203,0) ; "RTN","BIREPT3",204,0) Q:'$D(BILINE) "RTN","BIREPT3",205,0) ;I $G(BISPD)="CSV" S BIVAL=$TR(BIX,"|",","),BIVAL=$$STRIP^XLFSTR(BIVAL," ") "RTN","BIREPT3",206,0) D WL^BIW(.BILINE,"BIREPT1",$G(BIVAL),$G(BIBLNK)) "RTN","BIREPT3",207,0) ; "RTN","BIREPT3",208,0) ;--->Set VALMCNT (Listman line count) for errors calls above. "RTN","BIREPT3",209,0) S VALMCNT=BILINE "RTN","BIREPT3",210,0) Q "RTN","BIRPC") 0^25^B49695963 "RTN","BIRPC",1,0) BIRPC ;IHS/CMI/MWR - REMOTE PROCEDURE CALLS; MAY 10, 2010 ; 27 Aug 2025 11:24 PM "RTN","BIRPC",2,0) ;;8.5;IMMUNIZATION;**18,31**;OCT 24,2011;Build 137 "RTN","BIRPC",3,0) ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS * "RTN","BIRPC",4,0) ;; RETURNS IMMUNIZATION HISTORY, FORECAST, IMM/SERV PROFILE. "RTN","BIRPC",5,0) ;; PATCH 1: Add API: FORCALL, to allow queued update of all BI Patients. "RTN","BIRPC",6,0) ;; PATCH 3: Add NDC and Elig Codes, plus Date of Event to default Hx string. IMMHX+60 "RTN","BIRPC",7,0) ;; PATCH 5: Add Admin Note to default Hx string. IMMHX+60 "RTN","BIRPC",8,0) ;; PATCH 9: Add Date VIS Presented to Patient as piece 26. IMMHX+65 "RTN","BIRPC",9,0) ;; PATCH 18: Changes to for ICE Forecaster. IMMFORC+36 "RTN","BIRPC",10,0) ;; PATCH 31: ^BIDX sets BIRPROF(BIVGO) risk profile for vaccine "RTN","BIRPC",11,0) ;; group, forecast display checks BIRPROF(BIVGO) to "RTN","BIRPC",12,0) ;; determine adding *RB* flag "RTN","BIRPC",13,0) ; "RTN","BIRPC",14,0) ; "RTN","BIRPC",15,0) ;---------- "RTN","BIRPC",16,0) IMMHX(BIHX,BIDFN,BIDE,BISKIN,BIFMT) ;PEP - Return Immunization History. "RTN","BIRPC",17,0) ;---> Return Patient's Immunization History. "RTN","BIRPC",18,0) ;---> Immunizations returned in one string, delimited by "^". "RTN","BIRPC",19,0) ;---> Parameters: "RTN","BIRPC",20,0) ; 1 - BIHX (ret) String of patient's immunizations_||_Error. "RTN","BIRPC",21,0) ; 2 - BIDFN (req) DFN of patient. "RTN","BIRPC",22,0) ; 3 - BIDE (opt) Array of Data Elements to be returned: "RTN","BIRPC",23,0) ; BIDE(IEN of Data Element). "RTN","BIRPC",24,0) ; 4 - BISKIN (opt) =1 if Skin Tests should be included (DEFAULT); "RTN","BIRPC",25,0) ; =0 if Skin Tests should NOT be included. "RTN","BIRPC",26,0) ; 5 - BIFMT (opt) Format: 0=ASCII Split, 1=ASCII, 3=IMM/SERVE "RTN","BIRPC",27,0) ; "Split" means the components of a combination vaccine "RTN","BIRPC",28,0) ; will be split out as if they were given individually. "RTN","BIRPC",29,0) ; "RTN","BIRPC",30,0) ;---> Delimiter to pass error with result to GUI. "RTN","BIRPC",31,0) N BI31,BIERR S BI31=$C(31)_$C(31) "RTN","BIRPC",32,0) S BIHX="",BIERR="" "RTN","BIRPC",33,0) ; "RTN","BIRPC",34,0) ;---> If DFN not provided, set Error Code and quit. "RTN","BIRPC",35,0) ;I $G(BIDFN) D Q ;---> Use this line to test error handling. "RTN","BIRPC",36,0) I '$G(BIDFN) D Q "RTN","BIRPC",37,0) .D ERRCD^BIUTL2(306,.BIERR) S BIHX=BI31_BIERR "RTN","BIRPC",38,0) ; "RTN","BIRPC",39,0) ;---> Set required variables, kill ^BITMP($J). "RTN","BIRPC",40,0) D SETVARS^BIUTL5 K ^BITMP($J) "RTN","BIRPC",41,0) ; "RTN","BIRPC",42,0) ;---> Set the Patient TEMP global. "RTN","BIRPC",43,0) S ^BITMP($J,1,BIDFN)="" "RTN","BIRPC",44,0) ; "RTN","BIRPC",45,0) ;---> If BIDE local array (Data Elements to be returned) is not "RTN","BIRPC",46,0) ;---> passed, then set the following default Data Elements. "RTN","BIRPC",47,0) ;---> The following are IEN's in ^BIEXPDD(. "RTN","BIRPC",48,0) ;---> IEN PC DATA "RTN","BIRPC",49,0) ;---> --- -- ---- "RTN","BIRPC",50,0) ;---> 1 = Visit Type: "I"=Immunization, "S"=Skin Test. "RTN","BIRPC",51,0) ;---> 4 2 = Vaccine Name, Short. "RTN","BIRPC",52,0) ;---> 8 3 = Vaccine Component IEN'S. ;v8.0 "RTN","BIRPC",53,0) ;---> 24 4 = IEN, V File Visit. "RTN","BIRPC",54,0) ;---> 26 5 = Location (or Outside Location) where Imm was given. "RTN","BIRPC",55,0) ;---> 27 6 = Vaccine Group (Series Type) for grouping of vaccines. "RTN","BIRPC",56,0) ;---> 29 7 = Date of Visit (DD-Mmm-YYYY @HH:MM). "RTN","BIRPC",57,0) ;---> 38 8 = Skin Test Result. "RTN","BIRPC",58,0) ;---> 39 9 = Skin Test Reading. "RTN","BIRPC",59,0) ;---> 40 10 = Skin Test date read. "RTN","BIRPC",60,0) ;---> 41 11 = Skin Test Name. "RTN","BIRPC",61,0) ;---> 42 12 = Skin Test Name IEN. "RTN","BIRPC",62,0) ;---> 44 13 = Reaction to Immunization, text. "RTN","BIRPC",63,0) ;---> 51 14 = Release/Revision Date of VIS (DD-Mmm-YYYY). "RTN","BIRPC",64,0) ;---> 61 15 = Encounter Provider. "RTN","BIRPC",65,0) ;---> 65 16 = Dose Override. "RTN","BIRPC",66,0) ;---> 66 17 = Date of Visit (MM/DD/YY). "RTN","BIRPC",67,0) ;---> 69 18 = Vaccine Component CVX Code. "RTN","BIRPC",68,0) ;---> 74 19 = CPT-Coded Visit. "RTN","BIRPC",69,0) ;---> 78 20 = Imported from Outside Registry (if = 1). "RTN","BIRPC",70,0) ;---> 80 21 = NDC Code pointer IEN. "RTN","BIRPC",71,0) ;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR "RTN","BIRPC",72,0) ;---> Add NDC and Eligibility Codes, plus Date of Event to default Hx string. "RTN","BIRPC",73,0) ;---> 82 22 = Elilgibility Code Text. "RTN","BIRPC",74,0) ;---> 84 23 = NDC Code text. "RTN","BIRPC",75,0) ;---> 85 24 = Date of Event/Administer shot (1201 field of V File) in MM/DD/YY "RTN","BIRPC",76,0) ; "RTN","BIRPC",77,0) ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR "RTN","BIRPC",78,0) ;---> Add Admin Note to default Hx string. "RTN","BIRPC",79,0) ;---> 87 25 = Administrative Note. "RTN","BIRPC",80,0) ; "RTN","BIRPC",81,0) ;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR "RTN","BIRPC",82,0) ;---> Add Date VIS Presented to Patient (MM/DD/YY). "RTN","BIRPC",83,0) ;---> 90 26 = Date VIS Presented to Patient. "RTN","BIRPC",84,0) ; "RTN","BIRPC",85,0) D:'$D(BIDE) "RTN","BIRPC",86,0) .;N I F I=4,8,24,26,27,29,38,39,40,41,42,44,51,61,65,66,69,74,78,80,82,84,85,87 S BIDE(I)="" "RTN","BIRPC",87,0) .N I F I=4,8,24,26,27,29,38,39,40,41,42,44,51,61,65,66,69,74,78,80,82,84,85,87,90 S BIDE(I)="" "RTN","BIRPC",88,0) ;********** "RTN","BIRPC",89,0) N BIMM S BIMM("ALL")="" "RTN","BIRPC",90,0) ; "RTN","BIRPC",91,0) ;---> Next, gather Immunization History for this patient. "RTN","BIRPC",92,0) ; 1 - BIFMT (req) Format: 0=ASCII Split, 1=ASCII, 2=HL7, 3=IMM/SERVE "RTN","BIRPC",93,0) ; 2 - BIDE (req) Data Elements array (null if HL7) "RTN","BIRPC",94,0) ; 3 - BIMM (req) Array of Vaccine Types "RTN","BIRPC",95,0) ; 4 - BIFDT (opt) Forecast Date (not needed for history only). "RTN","BIRPC",96,0) ; 5 - BISKIN (opt) =1 if Skin Tests should be included. "RTN","BIRPC",97,0) ; "RTN","BIRPC",98,0) S:'$D(BISKIN) BISKIN=1 "RTN","BIRPC",99,0) S:'$D(BIFMT) BIFMT=0 "RTN","BIRPC",100,0) D HISTORY^BIEXPRT3(BIFMT,.BIDE,.BIMM,,BISKIN) "RTN","BIRPC",101,0) ; "RTN","BIRPC",102,0) ; "RTN","BIRPC",103,0) ;---> Next, set parameters for writing data as a string in BIHX. "RTN","BIRPC",104,0) ;---> Parameters: "RTN","BIRPC",105,0) ; 1 - BIEXP (req) Export: 0=screen, 1=host file, 2=string "RTN","BIRPC",106,0) ; 2 - BIFMT (req) Format: 1=ASCII, 2=HL7, 3=IMM/SERVE "RTN","BIRPC",107,0) ; 3 - BIFLNM (opt) File name "RTN","BIRPC",108,0) ; 4 - BIPATH (opt) BI Path name for host files "RTN","BIRPC",109,0) ; 5 - BIHX (ret) Immunization History in "^"-delimited string "RTN","BIRPC",110,0) ; "RTN","BIRPC",111,0) D WRITE^BIEXPRT4(2,1,,,.BIHX) "RTN","BIRPC",112,0) ; "RTN","BIRPC",113,0) ;W !,BIHX,!,"IMMHX^BIRPC" R ZZZ "RTN","BIRPC",114,0) S BIHX=BIHX_BI31 "RTN","BIRPC",115,0) Q "RTN","BIRPC",116,0) ; "RTN","BIRPC",117,0) ; "RTN","BIRPC",118,0) ;---------- "RTN","BIRPC",119,0) IMMFORC(BIFORC,BIDFN,BIFDT,BIUPD,BIDUZ2,BIPDSS,BIHR) ;PEP - Return Immunization Forecast. "RTN","BIRPC",120,0) ;---> Return Immserve Patient Forecast in one string. "RTN","BIRPC",121,0) ;---> Lines delimited by "^". "RTN","BIRPC",122,0) ;---> Called by RPC: BI IMMSERVE PT PROFILE "RTN","BIRPC",123,0) ;---> Parameters: "RTN","BIRPC",124,0) ; 1 - BIFORC (ret) String of patient's forecast_||_Error. "RTN","BIRPC",125,0) ; 2 - BIDFN (req) DFN of patient. "RTN","BIRPC",126,0) ; 3 - BIFDT (opt) Forecast Date (date used for forecast). "RTN","BIRPC",127,0) ; 4 - BIUPD (opt) If BIUPD=1, do NOT update Immserve Forecast. "RTN","BIRPC",128,0) ; Default $G(BIUPD)="", forecast gets updated. "RTN","BIRPC",129,0) ; 5 - BIDUZ2 (opt) User's DUZ(2) to indicate Immserve Forecasting "RTN","BIRPC",130,0) ; Rules in Patient History data string. "RTN","BIRPC",131,0) ; 6 - BIPDSS (ret) Returned string of V IMM IEN's that are "RTN","BIRPC",132,0) ; Problem Doses, according to TCH. "RTN","BIRPC",133,0) ; 7 - BIHR (opt) If BIHR=1 include '*RB*' flag if imm due is "RTN","BIRPC",134,0) ; High Risk/Risk Based "RTN","BIRPC",135,0) ; "RTN","BIRPC",136,0) ;---> Define delimiter to pass error and error variable. "RTN","BIRPC",137,0) N BI31,BIERR S BI31=$C(31)_$C(31),BIERR="" "RTN","BIRPC",138,0) ; "RTN","BIRPC",139,0) ;---> If the Vaccine Table is not standard, set Error Code and quit. "RTN","BIRPC",140,0) I $D(^BISITE(-1)) D Q "RTN","BIRPC",141,0) .D ERRCD^BIUTL2(503,.BIERR) S BIFORC=BI31_BIERR "RTN","BIRPC",142,0) ; "RTN","BIRPC",143,0) I '$G(BIDFN) D ERRCD^BIUTL2(301,.BIERR) S BIFORC=BI31_BIERR Q "RTN","BIRPC",144,0) ; "RTN","BIRPC",145,0) ;---> If patient is deceased, report it as error (in msgbox). "RTN","BIRPC",146,0) I $$DECEASED^BIUTL1(BIDFN) D Q "RTN","BIRPC",147,0) .D ERRCD^BIUTL2(205,.BIERR) S BIFORC=BI31_BIERR Q "RTN","BIRPC",148,0) ; "RTN","BIRPC",149,0) ;---> If no Forecast Date passed, set it equal to today. "RTN","BIRPC",150,0) S:'$G(BIFDT) BIFDT=DT "RTN","BIRPC",151,0) ; "RTN","BIRPC",152,0) ;---> If Forecast Date is before Patient's DOB, set Error Code and quit. "RTN","BIRPC",153,0) I BIFDT<$$DOB^BIUTL1(BIDFN) D Q "RTN","BIRPC",154,0) .D ERRCD^BIUTL2(315,.BIERR) S BIFORC=BI31_BIERR "RTN","BIRPC",155,0) ; "RTN","BIRPC",156,0) ; "RTN","BIRPC",157,0) ;********** PATCH 19, v8.5, JUN 01,2020, IHS/CMI/MWR "RTN","BIRPC",158,0) ;---> Using Reminders variable PXRMAGE to avoid redundant calls in <59 seconds. "RTN","BIRPC",159,0) ; "RTN","BIRPC",160,0) D:($D(PXRMAGE)&$D(^BIPDUE("B",BIDFN))&'$G(BIUPD)) "RTN","BIRPC",161,0) .N %,BID,BIT,N,X "RTN","BIRPC",162,0) .S N=$O(^BIPDUE("B",BIDFN,0)) "RTN","BIRPC",163,0) .Q:'N "RTN","BIRPC",164,0) .S BID=$P($G(^BIPDUE(N,0)),U,6) "RTN","BIRPC",165,0) .D NOW^%DTC S BIT=% "RTN","BIRPC",166,0) .;W !,BID," ",BIT," TIME DIFF: ",(BIT-BID) "RTN","BIRPC",167,0) .S:((BIT-BID)<.000059) BIUPD=1 "RTN","BIRPC",168,0) ;********** "RTN","BIRPC",169,0) ; "RTN","BIRPC",170,0) ;---> Update patient's forecast (in ^BIPDUE). "RTN","BIRPC",171,0) D:'$G(BIUPD) UPDATE^BIPATUP(BIDFN,BIFDT,.BIERR,1,$G(BIDUZ2),.BIPDSS) "RTN","BIRPC",172,0) I BIERR]"" S BIFORC=BI31_BIERR Q "RTN","BIRPC",173,0) ; "RTN","BIRPC",174,0) ;---> If no Immunizations are due for this patient, return message. "RTN","BIRPC",175,0) I '$D(^BIPDUE("B",BIDFN))&('$D(^BIPERR("B",BIDFN))) D Q "RTN","BIRPC",176,0) .S BIFORC="No immunizations due."_BI31 "RTN","BIRPC",177,0) .;---> NOTE! The above text is specifically checked for in ^BIPATVW1. "RTN","BIRPC",178,0) ; "RTN","BIRPC",179,0) ;---> Copy Immserve Patient Forecast (stored in ^BIPDUE) to string. "RTN","BIRPC",180,0) N A,B,C,N,U,V,X,Z,IDA,VG "RTN","BIRPC",181,0) S:'$D(BIFORC) BIFORC="" S U="^",V="|" "RTN","BIRPC",182,0) S N=0 "RTN","BIRPC",183,0) F S N=$O(^BIPDUE("B",BIDFN,N)) Q:'N D "RTN","BIRPC",184,0) .S Z=$G(^BIPDUE(N,0)) "RTN","BIRPC",185,0) .I $P(Z,U)'=BIDFN K ^BIPDUE(N),^BIPDUE("B",BIDFN,N) Q "RTN","BIRPC",186,0) .; "RTN","BIRPC",187,0) .;---> A=Date Due, B=Date Past Due. "RTN","BIRPC",188,0) .S IDA=+$P(Z,U,2) "RTN","BIRPC",189,0) .S VG=+$P($G(^AUTTIMM(IDA,0)),U,9) "RTN","BIRPC",190,0) .S VGO=+$P($G(^BISERT(VG,0)),U,2) "RTN","BIRPC",191,0) .S A=$P(Z,U,4),B=$P(Z,U,5) "RTN","BIRPC",192,0) .S X=" "_$$VNAME^BIUTL2(IDA) ;v8.0 "RTN","BIRPC",193,0) .; "RTN","BIRPC",194,0) .;---> Concatenate due by/past due appropriate text and date. "RTN","BIRPC",195,0) .S X=X_V_$S(B:" past due",1:" due") "RTN","BIRPC",196,0) .I $G(BIHR),$D(^BITMP($J,BIDFN,"BIRPROF",VGO)) D "RTN","BIRPC",197,0) ..;I $G(INP)]"",INP["F" Q "RTN","BIRPC",198,0) ..S X=X_$S(B:" ",1:" ")_"*RB*" "RTN","BIRPC",199,0) ..K ^BITMP($J,BIDFN,"BIRPROF",VGO) "RTN","BIRPC",200,0) .S BIFORC=BIFORC_X_U "RTN","BIRPC",201,0) ; "RTN","BIRPC",202,0) ; "RTN","BIRPC",203,0) ;---> Copy any Forecasting Errors (stored in ^BIPERR) to string. "RTN","BIRPC",204,0) S N=0 "RTN","BIRPC",205,0) F S N=$O(^BIPERR("B",BIDFN,N)) Q:'N D "RTN","BIRPC",206,0) .S Z=$G(^BIPERR(N,0)) "RTN","BIRPC",207,0) .I $P(Z,U)'=BIDFN K ^BIPERR(N),^BIPERR("B",BIDFN,N) Q "RTN","BIRPC",208,0) .S X=$P(Z,U,2) S:'X X=999 "RTN","BIRPC",209,0) .; "RTN","BIRPC",210,0) .S X=$P(Z,U,3)_" ERROR: "_$P((^BIERR(X,0)),"^",2) "RTN","BIRPC",211,0) .S BIFORC=BIFORC_X_U "RTN","BIRPC",212,0) ; "RTN","BIRPC",213,0) S BIFORC=BIFORC_BI31 "RTN","BIRPC",214,0) Q "RTN","BIRPC",215,0) ; "RTN","BIRPC",216,0) ; "RTN","BIRPC",217,0) ; "RTN","BIRPC",218,0) ;---------- "RTN","BIRPC",219,0) IMMPROF(BIGBL,BIDFN,BIFDT,BIDUZ2) ;PEP - Return ImmServe Profile in global array. "RTN","BIRPC",220,0) ;---> Return ImmServe Profile in global array, ^BITEMP($J,"PROF". "RTN","BIRPC",221,0) ;---> Lines delimited by "^". "RTN","BIRPC",222,0) ;---> Called by RPC: BI PATIENT PROFILE GET "RTN","BIRPC",223,0) ;---> Parameters: "RTN","BIRPC",224,0) ; 1 - BIGBL (ret) Name of result global containing patient's "RTN","BIRPC",225,0) ; ImmServe Profile, passed to Broker. "RTN","BIRPC",226,0) ; 2 - BIDFN (req) DFN of patient. "RTN","BIRPC",227,0) ; 3 - BIFDT (opt) Forecast Date (date used to calc Imms due). "RTN","BIRPC",228,0) ; 4 - BIDUZ2 (opt) User's DUZ(2) to indicate Immserve Forecasting "RTN","BIRPC",229,0) ; Rules in Patient History data string. "RTN","BIRPC",230,0) ; "RTN","BIRPC",231,0) ;---> Delimiters to pass error with result to GUI. "RTN","BIRPC",232,0) N BI30,BI31,BIERR,X "RTN","BIRPC",233,0) S BI30=$C(30),BI31=$C(31)_$C(31) "RTN","BIRPC",234,0) S BIGBL="^BITEMP("_$J_",""PROF"")",BIERR="" "RTN","BIRPC",235,0) K ^BITEMP($J,"PROF") "RTN","BIRPC",236,0) ; "RTN","BIRPC",237,0) I '$G(BIDFN) D Q "RTN","BIRPC",238,0) .D ERRCD^BIUTL2(305,.BIERR) S ^BITEMP($J,"PROF",1)=BI31_BIERR "RTN","BIRPC",239,0) ; "RTN","BIRPC",240,0) ;---> If patient is deceased, report it as error (in msgbox). "RTN","BIRPC",241,0) I $$DECEASED^BIUTL1(BIDFN) D Q "RTN","BIRPC",242,0) .D ERRCD^BIUTL2(205,.BIERR) S ^BITEMP($J,"PROF",1)=BI31_BIERR "RTN","BIRPC",243,0) ; "RTN","BIRPC",244,0) ;---> If the Patient is not in the Immunization Register, "RTN","BIRPC",245,0) ;---> report the fact in the Profile (instead of as an error). "RTN","BIRPC",246,0) I '$D(^BIP(BIDFN)) D Q "RTN","BIRPC",247,0) .N X "RTN","BIRPC",248,0) .S X="This patient is not in the Immunization Register." "RTN","BIRPC",249,0) .S ^BITEMP($J,"PROF",1)=X_BI30 "RTN","BIRPC",250,0) .S X="The Immserve Profile cannot be stored and displayed" "RTN","BIRPC",251,0) .S ^BITEMP($J,"PROF",2)=X_BI30 "RTN","BIRPC",252,0) .S X="if the patient is not in the Register." "RTN","BIRPC",253,0) .S ^BITEMP($J,"PROF",3)=X_BI30 "RTN","BIRPC",254,0) .S ^BITEMP($J,"PROF",4)=BI31 "RTN","BIRPC",255,0) ; "RTN","BIRPC",256,0) ;---> If no Forecast Date passed, set it equal to today. "RTN","BIRPC",257,0) S:'$G(BIFDT) BIFDT=DT "RTN","BIRPC",258,0) ; "RTN","BIRPC",259,0) ;---> Update patient's profile with Immserve Utility. "RTN","BIRPC",260,0) D UPDATE^BIPATUP(BIDFN,BIFDT,.BIERR,,$G(BIDUZ2)) "RTN","BIRPC",261,0) ; "RTN","BIRPC",262,0) ;---> Copy Immserve Patient Profile to string. "RTN","BIRPC",263,0) N I,N,U,X S U="^" "RTN","BIRPC",264,0) S N=0 "RTN","BIRPC",265,0) F I=1:1 S N=$O(^BIP(BIDFN,1,N)) Q:'N D "RTN","BIRPC",266,0) .;---> Set null lines (line breaks) equal to one space, so that "RTN","BIRPC",267,0) .;---> Windows reader will quit only at the final "null" line. "RTN","BIRPC",268,0) .S X=^BIP(BIDFN,1,N,0) S:X="" X=" " "RTN","BIRPC",269,0) .S ^BITEMP($J,"PROF",I)=X_BI30 "RTN","BIRPC",270,0) ; "RTN","BIRPC",271,0) ;---> If no ImmServe Profile produced, report it as an error. "RTN","BIRPC",272,0) I '$O(^BITEMP($J,"PROF",0)) D ERRCD^BIUTL2(307,.BIERR) "RTN","BIRPC",273,0) ; "RTN","BIRPC",274,0) ;---> Tack on Error Delimiter and any error. "RTN","BIRPC",275,0) S ^BITEMP($J,"PROF",I)=BI31_BIERR "RTN","BIRPC",276,0) Q "RTN","BIRPC",277,0) ; "RTN","BIRPC",278,0) ; "RTN","BIRPC",279,0) ;---------- "RTN","BIRPC",280,0) FORCALL ;PEP - Update Forecast for all Immunization Patients. "RTN","BIRPC",281,0) ;---> Can be called by RPC: BI FORECAST ALL "RTN","BIRPC",282,0) ;---> Can be called by OPTION: BI FORECAST ALL (may be queued in Taskman) "RTN","BIRPC",283,0) ;---> This subroutine updates the immunization forecast for all patients in "RTN","BIRPC",284,0) ;---> the File BI PATIENT IMMUNIZATIONS DUE File #9002084.1 for today. "RTN","BIRPC",285,0) D ^XBKVAR "RTN","BIRPC",286,0) N ZTIO S ZTIO="" "RTN","BIRPC",287,0) N BIN S BIN=0 "RTN","BIRPC",288,0) F S BIN=$O(^BIP(BIN)) Q:'BIN D IMMFORC(,BIN,,,,,1) "RTN","BIRPC",289,0) Q "RTN","BISITE1") 0^26^B46451942 "RTN","BISITE1",1,0) BISITE1 ;IHS/CMI/MWR - EDIT SITE PARAMETERS; MAY 10, 2010 [ 06/24/2025 10:15 PM ] ; 03 Jul 2025 12:45 AM "RTN","BISITE1",2,0) ;;8.5;IMMUNIZATION;**22,29,30,31**;OCT 24,2011;Build 137 "RTN","BISITE1",3,0) ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS * "RTN","BISITE1",4,0) ;; INIT FOR EDIT SITE PARAMETERS. "RTN","BISITE1",5,0) ; PATCH 2: Fix display of default Low Supply Alert. INIT+72 "RTN","BISITE1",6,0) ; Provide call to retrieve Site's Low Alert default. LOTSDEF "RTN","BISITE1",7,0) ;; PATCH 8: Changes to accommodate new TCH Forecaster INIT+55,+66,+92,+132 "RTN","BISITE1",8,0) ;; PATCH 9: Return the IP Address used for the TCH Forecaster. INIT+139 "RTN","BISITE1",9,0) ;; Update display of selected High Risk parameters. INIT+165 "RTN","BISITE1",10,0) ;; PATCH 13: Add Flu Season Date Range parameter. INIT+197 "RTN","BISITE1",11,0) ;; PATCH 14: Update display of selected High Risk parameters. INIT+164 "RTN","BISITE1",12,0) ;; PATCH 22: Changes to include COVID. RISKTX+0 "RTN","BISITE1",13,0) ;; PATCH 31: Show numbers for risk included if text string too long "RTN","BISITE1",14,0) ; "RTN","BISITE1",15,0) ; "RTN","BISITE1",16,0) ;---------- "RTN","BISITE1",17,0) INIT ;EP "RTN","BISITE1",18,0) ;---> Initialize variables and list array. "RTN","BISITE1",19,0) ;---> If BISITE not supplied, set Error Code and quit. "RTN","BISITE1",20,0) I '$G(BISITE) D ERRCD^BIUTL2(109,,1) S VALMQUIT="" Q "RTN","BISITE1",21,0) I '$D(^BISITE(BISITE,0)) D ERRCD^BIUTL2(110,,1) S VALMQUIT="" Q "RTN","BISITE1",22,0) ; "RTN","BISITE1",23,0) K ^TMP("BISITE",$J) "RTN","BISITE1",24,0) S VALM("TITLE")=$$LMVER^BILOGO "RTN","BISITE1",25,0) S VALMSG="Select a left column number to change an item." "RTN","BISITE1",26,0) N BILINE,X,Y S BILINE=0 "RTN","BISITE1",27,0) ; "RTN","BISITE1",28,0) ;---> Default Case Manager. "RTN","BISITE1",29,0) D WRITE(.BILINE) "RTN","BISITE1",30,0) S X=" 1) Default Case Manager.........: "_$$CMGRDEF^BIUTL2(BISITE,1) "RTN","BISITE1",31,0) D WRITE(.BILINE,X) "RTN","BISITE1",32,0) K X "RTN","BISITE1",33,0) ; "RTN","BISITE1",34,0) ;---> Other Location. "RTN","BISITE1",35,0) N BIOTH S BIOTH=$$OTHERLOC^BIUTL6(BISITE),X="" "RTN","BISITE1",36,0) D:BIOTH "RTN","BISITE1",37,0) .S X=$P(^AUTTLOC(BIOTH,0),U,4) "RTN","BISITE1",38,0) .I $G(X) S:$D(^AUTTAREA(X,0)) X=$P(^(0),U) "RTN","BISITE1",39,0) .S X=$$INSTTX^BIUTL6(BIOTH)_" "_X "RTN","BISITE1",40,0) S X=$E(" 2) Other Location...............: "_X,1,79) "RTN","BISITE1",41,0) D WRITE(.BILINE,X) "RTN","BISITE1",42,0) K X "RTN","BISITE1",43,0) ; "RTN","BISITE1",44,0) ;---> Standard Immunizations Due Letter. "RTN","BISITE1",45,0) S X=" 3) Standard Imm Due Letter .....: "_$$DEFLET^BIUTL2(BISITE,1) "RTN","BISITE1",46,0) D WRITE(.BILINE,X) "RTN","BISITE1",47,0) K X "RTN","BISITE1",48,0) ; "RTN","BISITE1",49,0) ;---> Official Immunization Record. "RTN","BISITE1",50,0) S X=" 4) Official Imm Record Letter...: "_$$DEFLET^BIUTL2(BISITE,1,1) "RTN","BISITE1",51,0) D WRITE(.BILINE,X) "RTN","BISITE1",52,0) K X "RTN","BISITE1",53,0) ; "RTN","BISITE1",54,0) ;---> Facility Record/Report Header. "RTN","BISITE1",55,0) S X=" 5) Facility Report Header.......: "_$$REPHDR^BIUTL6(BISITE) "RTN","BISITE1",56,0) D WRITE(.BILINE,X) "RTN","BISITE1",57,0) K X "RTN","BISITE1",58,0) ; "RTN","BISITE1",59,0) ;---> Host File Server Path. "RTN","BISITE1",60,0) S X=" 6) Host File Server Path........: "_$$HFSPATH^BIUTL8(BISITE) "RTN","BISITE1",61,0) D WRITE(.BILINE,X) "RTN","BISITE1",62,0) K X "RTN","BISITE1",63,0) ; "RTN","BISITE1",64,0) ;---> Minimum Days Last Letter. "RTN","BISITE1",65,0) S X=$$MINDAYS^BIUTL2(BISITE)_" day" S:+X'=1 X=X_"s" "RTN","BISITE1",66,0) S X=" 7) Minimum Days Last Letter.....: "_X "RTN","BISITE1",67,0) D WRITE(.BILINE,X) "RTN","BISITE1",68,0) K X "RTN","BISITE1",69,0) ; "RTN","BISITE1",70,0) ;---> Forecast Minimum Age vs Recommended Age. "RTN","BISITE1",71,0) S X=$$MINAGE^BIUTL2(BISITE) "RTN","BISITE1",72,0) ;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR "RTN","BISITE1",73,0) ;---> Change parameter prompt to just Min vs Rec. "RTN","BISITE1",74,0) S X=$S(X=1:"Minimum Acceptable Age",1:"Recommended Age") "RTN","BISITE1",75,0) ;********** "RTN","BISITE1",76,0) S X=" 8) Minimum vs Recommended Age...: "_X "RTN","BISITE1",77,0) D WRITE(.BILINE,X) "RTN","BISITE1",78,0) K X "RTN","BISITE1",79,0) ; "RTN","BISITE1",80,0) ;---> ImmServe Forecasting Option. "RTN","BISITE1",81,0) D "RTN","BISITE1",82,0) .N G,H,Y,Z S Z=$G(^BISITE(BISITE,0)) "RTN","BISITE1",83,0) .;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR "RTN","BISITE1",84,0) .;---> Change parameter prompt to just Grace Period. "RTN","BISITE1",85,0) .;S Y=$P(Z,U,8),G=$P(Z,U,21),H=$P(Z,U,24) "RTN","BISITE1",86,0) .;S X="#"_Y_", "_$S(G:"WITH",1:"NO")_" 4-Day Grace" "RTN","BISITE1",87,0) .;S X=X_", HPV through "_$S(H=2:26,1:18) "RTN","BISITE1",88,0) .S Y=$P($G(^BISITE(BISITE,0)),U,21) "RTN","BISITE1",89,0) .S X="4-Day Grace Period "_$S(Y=1:"",1:"NOT ")_"Used" "RTN","BISITE1",90,0) S X=" 9) 4-Day Grace Period option....: "_X "RTN","BISITE1",91,0) ;********** "RTN","BISITE1",92,0) D WRITE(.BILINE,X) "RTN","BISITE1",93,0) K X "RTN","BISITE1",94,0) ; "RTN","BISITE1",95,0) ;---> Lot Numbers required. "RTN","BISITE1",96,0) S X=$S($$LOTREQ^BIUTL2(BISITE):"Required",1:"NOT Required") "RTN","BISITE1",97,0) ; "RTN","BISITE1",98,0) ;********** PATCH 2, v8.5, MAY 15,2012, IHS/CMI/MWR "RTN","BISITE1",99,0) ;---> Fix display of default Low Supply Alert. "RTN","BISITE1",100,0) ;S X=X_", Default Low Supply Alert="_$$LOTLOW^BIUTL2(BISITE) "RTN","BISITE1",101,0) S X=X_", Default Low Supply Alert="_$$LOTSDEF(BISITE) "RTN","BISITE1",102,0) ;********** "RTN","BISITE1",103,0) ; "RTN","BISITE1",104,0) S X=" 10) Lot Number Options...........: "_X "RTN","BISITE1",105,0) D WRITE(.BILINE,X) "RTN","BISITE1",106,0) K X "RTN","BISITE1",107,0) ; "RTN","BISITE1",108,0) ;---> Pneumo, Flu, Zostervax Site Parameters. v8.5 "RTN","BISITE1",109,0) ;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR "RTN","BISITE1",110,0) ;---> Change parameter prompt to just Pneumo. "RTN","BISITE1",111,0) D "RTN","BISITE1",112,0) .N Y,Z "RTN","BISITE1",113,0) .S Y=$$PNMAGE^BIPATUP2(BISITE) "RTN","BISITE1",114,0) .;S Y=$P(X,U),Z=$P(X,U,2) "RTN","BISITE1",115,0) .;S X=Y_" years old, "_$S(Z:"every 6 years.",1:"one time only.") "RTN","BISITE1",116,0) .S X="Begin Pneumo at "_Y_" years" "RTN","BISITE1",117,0) .;S Y=$$FLUALL^BIPATUP2(BISITE) "RTN","BISITE1",118,0) .;S X=X_$S(Y:"All ages",1:"6m-18y,50y+") "RTN","BISITE1",119,0) .;S X=X_" Zoster: " "RTN","BISITE1",120,0) .;S Y=$$ZOSTER^BIPATUP2(BISITE) "RTN","BISITE1",121,0) .;S X=X_$S(Y:"Yes",1:"No") "RTN","BISITE1",122,0) ;S X=" 11) Pneumo, Flu, Zoster Options..: "_X "RTN","BISITE1",123,0) S X=" 11) Pneumo routine age to begin..: "_X "RTN","BISITE1",124,0) ;********** "RTN","BISITE1",125,0) D WRITE(.BILINE,X) "RTN","BISITE1",126,0) K X "RTN","BISITE1",127,0) ; "RTN","BISITE1",128,0) ;---> Forecasting enabled. "RTN","BISITE1",129,0) S X=$S($$FORECAS^BIUTL2(BISITE):"Enabled",1:"Disabled") "RTN","BISITE1",130,0) S X=" 12) Forecasting (Imms Due).......: "_X "RTN","BISITE1",131,0) D WRITE(.BILINE,X) "RTN","BISITE1",132,0) K X "RTN","BISITE1",133,0) ; "RTN","BISITE1",134,0) ;---> Include dashes in Chart# display. "RTN","BISITE1",135,0) D "RTN","BISITE1",136,0) .I $$DASH^BIUTL1(BISITE) S X="Dashes Included (12-34-56)" Q "RTN","BISITE1",137,0) .S X="No Dashes (123456)" "RTN","BISITE1",138,0) S X=" 13) Chart# with dashes...........: "_X "RTN","BISITE1",139,0) D WRITE(.BILINE,X) "RTN","BISITE1",140,0) K X "RTN","BISITE1",141,0) ; "RTN","BISITE1",142,0) ;---> User as Default Provider. "RTN","BISITE1",143,0) S X=$S($$DEFPROV^BIUTL6(BISITE):"Yes",1:"No") "RTN","BISITE1",144,0) S X=" 14) User as Default Provider.....: "_X "RTN","BISITE1",145,0) D WRITE(.BILINE,X) "RTN","BISITE1",146,0) K X "RTN","BISITE1",147,0) ; "RTN","BISITE1",148,0) ; "RTN","BISITE1",149,0) ;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR "RTN","BISITE1",150,0) ;---> IP Address for TCH Forecaster. "RTN","BISITE1",151,0) S X=$$IPTCH^BIUTL8(BISITE) "RTN","BISITE1",152,0) S X=" 15) IP Address for ICE Forecaster: "_X "RTN","BISITE1",153,0) ;********** "RTN","BISITE1",154,0) D WRITE(.BILINE,X) "RTN","BISITE1",155,0) K X "RTN","BISITE1",156,0) ; "RTN","BISITE1",157,0) ;---> GPRA Communities. "RTN","BISITE1",158,0) D "RTN","BISITE1",159,0) .N BIGPRA D GETGPRA^BISITE4(.BIGPRA,BISITE) "RTN","BISITE1",160,0) .I '$O(BIGPRA(0)) S X="No" Q "RTN","BISITE1",161,0) .N N S (N,X)=0 F S N=$O(BIGPRA(N)) Q:'N S X=X+1 "RTN","BISITE1",162,0) S X=X_" Communities selected for GPRA." "RTN","BISITE1",163,0) S X=" 16) GPRA Communities.............: "_X "RTN","BISITE1",164,0) D WRITE(.BILINE,X) "RTN","BISITE1",165,0) K X "RTN","BISITE1",166,0) ; "RTN","BISITE1",167,0) ;---> Inpatient Check enabled. "RTN","BISITE1",168,0) S X=$S($$INPTCHK^BIUTL2(BISITE):"Enabled",1:"Disabled") "RTN","BISITE1",169,0) S X=" 17) Inpatient Visit Check........: "_X "RTN","BISITE1",170,0) D WRITE(.BILINE,X) "RTN","BISITE1",171,0) K X "RTN","BISITE1",172,0) ; "RTN","BISITE1",173,0) ; "RTN","BISITE1",174,0) ;********** PATCH 14, v8.5, AUG 01,2017, IHS/CMI/MWR "RTN","BISITE1",175,0) ;---> Update display of selected High Risk parameters. "RTN","BISITE1",176,0) ;---> Risk Check enabled. "RTN","BISITE1",177,0) N Z "RTN","BISITE1",178,0) S Z=$$RISKP^BIUTL2(BISITE) "RTN","BISITE1",179,0) D "RTN","BISITE1",180,0) .I 'Z S X="High Risk Disabled" Q "RTN","BISITE1",181,0) .S X=$$RISKTX(Z) "RTN","BISITE1",182,0) .;V8.5 P31 "RTN","BISITE1",183,0) .S:$L(X)>33 X="(Risk Factors: "_Z_")" "RTN","BISITE1",184,0) .S X="Enabled: "_X "RTN","BISITE1",185,0) ;********** "RTN","BISITE1",186,0) ; "RTN","BISITE1",187,0) S X=" 18) High Risk Factor Check.......: "_X "RTN","BISITE1",188,0) D WRITE(.BILINE,X) "RTN","BISITE1",189,0) K X,Z "RTN","BISITE1",190,0) ; "RTN","BISITE1",191,0) ;---> CPT-coded Visits enabled. "RTN","BISITE1",192,0) S X=$S($$IMPCPT^BIUTL2(BISITE):"Enabled",1:"Disabled") "RTN","BISITE1",193,0) S X=" 19) Import CPT-coded Visits......: "_X "RTN","BISITE1",194,0) D WRITE(.BILINE,X) "RTN","BISITE1",195,0) K X "RTN","BISITE1",196,0) ; "RTN","BISITE1",197,0) ;---> Visit Selection Menu enabled. "RTN","BISITE1",198,0) D "RTN","BISITE1",199,0) .I $$VISMNU^BIUTL2(BISITE) S X="Enabled (Display Visit Selection Menu)" Q "RTN","BISITE1",200,0) .S X="Disabled (Link Visits automatically)" "RTN","BISITE1",201,0) S X=" 20) Visit Selection Menu.........: "_X "RTN","BISITE1",202,0) D WRITE(.BILINE,X) "RTN","BISITE1",203,0) K X "RTN","BISITE1",204,0) ; "RTN","BISITE1",205,0) ; "RTN","BISITE1",206,0) ;********** PATCH 13, v8.5, AUG 01,2016, IHS/CMI/MWR "RTN","BISITE1",207,0) ;---> Flu Season Date Range. "RTN","BISITE1",208,0) S X=$$FLUDATS^BIUTL8(BISITE) "RTN","BISITE1",209,0) S X=" 21) Flu Season Start & End Dates.: "_$P(X,"%")_" to "_$P(X,"%",2) "RTN","BISITE1",210,0) D WRITE(.BILINE,X) "RTN","BISITE1",211,0) K X "RTN","BISITE1",212,0) ;********** "RTN","BISITE1",213,0) ; "RTN","BISITE1",214,0) S VALMSG="Scroll down to view more Parameters." "RTN","BISITE1",215,0) S VALMCNT=BILINE "RTN","BISITE1",216,0) Q "RTN","BISITE1",217,0) ; "RTN","BISITE1",218,0) ; "RTN","BISITE1",219,0) ;---------- "RTN","BISITE1",220,0) WRITE(BILINE,BIVAL,BIBLNK) ;EP "RTN","BISITE1",221,0) ;---> Write lines to ^TMP (see documentation in ^BIW). "RTN","BISITE1",222,0) ;---> Parameters: "RTN","BISITE1",223,0) ; 1 - BILINE (ret) Last line# written. "RTN","BISITE1",224,0) ; 2 - BIVAL (opt) Value/text of line (Null=blank line). "RTN","BISITE1",225,0) ; "RTN","BISITE1",226,0) Q:'$D(BILINE) "RTN","BISITE1",227,0) D WL^BIW(.BILINE,"BISITE",$G(BIVAL),$G(BIBLNK)) "RTN","BISITE1",228,0) Q "RTN","BISITE1",229,0) ; "RTN","BISITE1",230,0) ; "RTN","BISITE1",231,0) ;********** PATCH 2, v8.5, MAY 15,2012, IHS/CMI/MWR "RTN","BISITE1",232,0) ;---------- "RTN","BISITE1",233,0) LOTSDEF(BIDUZ2) ;EP "RTN","BISITE1",234,0) ;---> Return Site's Default Low Alert for Lot Numbers. "RTN","BISITE1",235,0) ;---> Parameters: "RTN","BISITE1",236,0) ; 1 - BIDUZ2 (req) User's DUZ(2) "RTN","BISITE1",237,0) ; "RTN","BISITE1",238,0) Q:'$D(^BISITE(+$G(BIDUZ2),0)) 50 "RTN","BISITE1",239,0) Q:($P($G(^BISITE(+$G(BIDUZ2),0)),U,25)="") 50 "RTN","BISITE1",240,0) Q $P($G(^BISITE(+$G(BIDUZ2),0)),U,25) "RTN","BISITE1",241,0) ;********** "RTN","BISITE1",242,0) ; "RTN","BISITE1",243,0) ;********** PATCH 22, v8.5, OCT 24,2011, IHS/CMI/MWR "RTN","BISITE1",244,0) ;---> Update display of selected High Risk parameters to include COVID. "RTN","BISITE1",245,0) ;---------- "RTN","BISITE1",246,0) RISKTX(Z) ;EP "RTN","BISITE1",247,0) ;---> Return text of Risk Factors. "RTN","BISITE1",248,0) ;---> Parameters: "RTN","BISITE1",249,0) ; 1 - Z (req) Number representing High Risk. "RTN","BISITE1",250,0) ; "RTN","BISITE1",251,0) N I,SP,X "RTN","BISITE1",252,0) S SP=", " "RTN","BISITE1",253,0) S I(1)="Pneumo" "RTN","BISITE1",254,0) S I(2)="HepB-DM" "RTN","BISITE1",255,0) S I(3)="HepA&B" "RTN","BISITE1",256,0) S I(4)="COVID" "RTN","BISITE1",257,0) S I(5)="MenB" "RTN","BISITE1",258,0) S I(6)="RSV" "RTN","BISITE1",259,0) S I(7)="HPV" "RTN","BISITE1",260,0) S I(8)="RecombZV" "RTN","BISITE1",261,0) S I("S")="Smoking" "RTN","BISITE1",262,0) N X "RTN","BISITE1",263,0) S X="" "RTN","BISITE1",264,0) F J=1:1 S Y=$E(Z,J) Q:Y="" I $D(I(Y)) S X=X_I(Y)_SP "RTN","BISITE1",265,0) S:X="" X="ERROR: Unable to determine." "RTN","BISITE1",266,0) I $E(X,$L(X)-1)="," S X=$E(X,1,$L(X)-2) "RTN","BISITE1",267,0) Q X "RTN","BISITE1",268,0) ;===== "RTN","BISITE1",269,0) ; "RTN","BISITE4") 0^27^B206800435 "RTN","BISITE4",1,0) BISITE4 ;IHS/CMI/MWR - SELECT GPRA COMMUNITIES.; MAY 10, 2010 [ 06/24/2025 10:16 PM ] ; 19 Aug 2025 11:21 AM "RTN","BISITE4",2,0) ;;8.5;IMMUNIZATION;**22,29,30,31**;OCT 24,2011;Build 137 "RTN","BISITE4",3,0) ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS * "RTN","BISITE4",4,0) ;; SELECT COMMUNITIES TO BE INCLUDED IN GPRA GROUPS AND REPORTS. "RTN","BISITE4",5,0) ;; PATCH 8: Update Help Text to exclude influenza. TEXT2+3 "RTN","BISITE4",6,0) ;; PATCH 9: Update options to include Hep B. TEXT1+24 "RTN","BISITE4",7,0) ;; PATCH 12: Use BIDUZ2. GETGPRA+9 "RTN","BISITE4",8,0) ;; PATCH 13: Add Flu Season Date Range parameter. FLUDATS+0 "RTN","BISITE4",9,0) ;; PATCH 14: Update options and Help TEXT2 to include Hep A&B RISKP+0 "RTN","BISITE4",10,0) ;; PATCH 21: Correct call to TEXT1 at INPTCHK+6 "RTN","BISITE4",11,0) ;; PATCH 22: Changes to include COVID. RISKP+0 "RTN","BISITE4",12,0) ;; PATCH 31 - FID-98855 RZV 19-49 yrs "RTN","BISITE4",13,0) ; "RTN","BISITE4",14,0) ; "RTN","BISITE4",15,0) ;---------- "RTN","BISITE4",16,0) GPRA ;EP "RTN","BISITE4",17,0) ;---> Select Communities for GPRA. "RTN","BISITE4",18,0) ;---> Called by Protocol BI SITE GPRA COMS. "RTN","BISITE4",19,0) ; "RTN","BISITE4",20,0) Q:$$BISITE^BISITE2 "RTN","BISITE4",21,0) N BIITEM S BIITEM="Community" "RTN","BISITE4",22,0) N BITITEM S BITITEM="GPRA Community" "RTN","BISITE4",23,0) N BICOL S BICOL=" # Community State" "RTN","BISITE4",24,0) N BIID S BIID="3;I $G(X) S:$D(^DIC(5,X,0)) X=$P(^(0),U);32" "RTN","BISITE4",25,0) N BIGPRA,BIGPRAD,BIPOP "RTN","BISITE4",26,0) ; "RTN","BISITE4",27,0) ;---> Use previous GPRA List for this site as default. "RTN","BISITE4",28,0) D GETGPRA(.BIGPRAD,DUZ(2)) "RTN","BISITE4",29,0) D SEL^BISELECT(9999999.05,"BIGPRA",BIITEM,,,,BIID,BICOL,.BIPOP,1,,.BIGPRAD,BITITEM) "RTN","BISITE4",30,0) ; "RTN","BISITE4",31,0) ;---> Now replace the previous list for this site with the newly selected list. "RTN","BISITE4",32,0) D "RTN","BISITE4",33,0) .Q:$G(BIPOP) "RTN","BISITE4",34,0) .;---> If user tried to select ALL Communities for GPRA, don't change. "RTN","BISITE4",35,0) .I $D(BIGPRA("ALL")) D Q "RTN","BISITE4",36,0) ..W !!," * GPRA Communities *" "RTN","BISITE4",37,0) ..W !!!," You may not select ""ALL"" for your set of GPRA Communities." "RTN","BISITE4",38,0) ..D DIRZ^BIUTL3() "RTN","BISITE4",39,0) .; "RTN","BISITE4",40,0) .N BIK S BIK="^BISITE("_DUZ(2)_",2)" K @BIK "RTN","BISITE4",41,0) .S ^BISITE(DUZ(2),2,0)="^9002084.04PA" "RTN","BISITE4",42,0) .N N S N=0 "RTN","BISITE4",43,0) .F S N=$O(BIGPRA(N)) Q:'N D "RTN","BISITE4",44,0) ..S ^BISITE(DUZ(2),2,N,0)=N,^BISITE(DUZ(2),2,"B",N,N)="" "RTN","BISITE4",45,0) ..N X S X=$P($G(^BISITE(DUZ(2),2,0)),U,4)+1 "RTN","BISITE4",46,0) ..S ^BISITE(DUZ(2),2,0)="^9002084.04PA^"_N_U_X "RTN","BISITE4",47,0) ; "RTN","BISITE4",48,0) D RESET^BISITE "RTN","BISITE4",49,0) Q "RTN","BISITE4",50,0) ; "RTN","BISITE4",51,0) ; "RTN","BISITE4",52,0) ;---------- "RTN","BISITE4",53,0) GETGPRA(BIGPRA,BIDUZ2,BIERR) ;PEP - Return GPRA Communities Array. "RTN","BISITE4",54,0) ;---> Retrieve GPRA Communities Array of IEN's for this DUZ(2). "RTN","BISITE4",55,0) ;---> Parameters: "RTN","BISITE4",56,0) ; 1 - BIGPRA (ret) Array of GPRA IEN's in the COMMUNITY file - ^AUTTCOM(. "RTN","BISITE4",57,0) ; 2 - BIDUZ2 (req) Site IEN or DUZ(2). "RTN","BISITE4",58,0) ; 3 - BIERR (ret) Error text, if any. "RTN","BISITE4",59,0) ; "RTN","BISITE4",60,0) I '$G(BIDUZ2) S BIDUZ2=$G(DUZ(2)) "RTN","BISITE4",61,0) I '$G(BIDUZ2) D ERRCD^BIUTL2(109,.BIERR) Q "RTN","BISITE4",62,0) ;********** PATCH 12, v8.5, OCT 24,2011, IHS/CMI/MWR "RTN","BISITE4",63,0) ;---> Use BIZUZ2 as passed rather than DUZ(2). "RTN","BISITE4",64,0) ;I '$O(^BISITE(DUZ(2),2,0)) D ERRCD^BIUTL2(110,.BIERR) Q "RTN","BISITE4",65,0) I '$O(^BISITE(BIDUZ2,2,0)) D ERRCD^BIUTL2(110,.BIERR) Q "RTN","BISITE4",66,0) N N S N=0 "RTN","BISITE4",67,0) ;F S N=$O(^BISITE(DUZ(2),2,N)) Q:'N S BIGPRA(N)="" "RTN","BISITE4",68,0) F S N=$O(^BISITE(BIDUZ2,2,N)) Q:'N S BIGPRA(N)="" "RTN","BISITE4",69,0) Q "RTN","BISITE4",70,0) ; "RTN","BISITE4",71,0) ; "RTN","BISITE4",72,0) ;---------- "RTN","BISITE4",73,0) INPTCHK ;EP "RTN","BISITE4",74,0) ;---> Edit the parameter that determines whether Inpatient Status "RTN","BISITE4",75,0) ;---> is checked (and changed, if necessary) when storing Visits. "RTN","BISITE4",76,0) ;---> Called by Protocol BI SITE INPATIENT CHECK ENABLE. "RTN","BISITE4",77,0) ; "RTN","BISITE4",78,0) Q:$$BISITE^BISITE2 "RTN","BISITE4",79,0) D FULL^VALM1,TITLE^BIUTL5("ENABLE/DISABLE INPATIENT VISIT CHECK"),TEXT1 "RTN","BISITE4",80,0) N BIDFLT,DIR,DIRUT,Y "RTN","BISITE4",81,0) S DIR(0)="SOA^E:Enable;D:Disable" "RTN","BISITE4",82,0) S DIR("A")=" Please select either Enable or Disable: " "RTN","BISITE4",83,0) S DIR("B")=$S($$INPTCHK^BIUTL2(BISITE):"Enable",1:"Disable") "RTN","BISITE4",84,0) D ^DIR "RTN","BISITE4",85,0) D:'$D(DIRUT) "RTN","BISITE4",86,0) .N BIFLD,BIERR S BIFLD(.23)=Y "RTN","BISITE4",87,0) .D FDIE^BIFMAN(9002084.02,BISITE,.BIFLD,.BIERR,1) "RTN","BISITE4",88,0) .I BIERR]"" W !!?3,BIERR D DIRZ^BIUTL3() "RTN","BISITE4",89,0) D RESET^BISITE "RTN","BISITE4",90,0) Q "RTN","BISITE4",91,0) ; "RTN","BISITE4",92,0) ; "RTN","BISITE4",93,0) ;********** PATCH 13, v8.5, AUG 01,2016, IHS/CMI/MWR "RTN","BISITE4",94,0) ;---> Flu Season Date Range. "RTN","BISITE4",95,0) ;---------- "RTN","BISITE4",96,0) FLUDATS ;EP "RTN","BISITE4",97,0) ;---> Edit the parameters that determines the start and end of the Flu "RTN","BISITE4",98,0) ;---> forecasting season. "RTN","BISITE4",99,0) ; "RTN","BISITE4",100,0) Q:$$BISITE^BISITE2 "RTN","BISITE4",101,0) D FULL^VALM1,TITLE^BIUTL5("FLU SEASON START & END DATES"),TEXT5 "RTN","BISITE4",102,0) ; "RTN","BISITE4",103,0) N BIDATES,BISTART,BIEND "RTN","BISITE4",104,0) S BIDATES=$$FLUDATS^BIUTL8(BISITE) "RTN","BISITE4",105,0) N BIPOP,DIRUT "RTN","BISITE4",106,0) ;---> Edit Start Date. "RTN","BISITE4",107,0) D FLUDATS1("START",BIDATES,.BISTART,.DIRUT) "RTN","BISITE4",108,0) ; "RTN","BISITE4",109,0) ;---> If user ^'d out, quit. "RTN","BISITE4",110,0) I $G(DIRUT) D Q "RTN","BISITE4",111,0) .W !!?10,"No changes made." D DIRZ^BIUTL3(),RESET^BISITE "RTN","BISITE4",112,0) ; "RTN","BISITE4",113,0) ;---> Edit End Date. "RTN","BISITE4",114,0) D FLUDATS1("END",BIDATES,.BIEND,.DIRUT) "RTN","BISITE4",115,0) ; "RTN","BISITE4",116,0) ;---> If user ^'d out, quit. "RTN","BISITE4",117,0) I $G(DIRUT) D Q "RTN","BISITE4",118,0) .W !!?10,"No changes made." D DIRZ^BIUTL3(),RESET^BISITE "RTN","BISITE4",119,0) ; "RTN","BISITE4",120,0) ;---> Save new (or unchanged) values for this site. "RTN","BISITE4",121,0) N BIFLD,BIERR S BIFLD(.31)=BISTART,BIFLD(.32)=BIEND "RTN","BISITE4",122,0) D FDIE^BIFMAN(9002084.02,BISITE,.BIFLD,.BIERR,1) "RTN","BISITE4",123,0) I BIERR]"" W !!?3,BIERR D DIRZ^BIUTL3(),RESET^BISITE Q "RTN","BISITE4",124,0) ; "RTN","BISITE4",125,0) W !!?5,"Flu Season dates are now: ",BISTART," to ",BIEND "RTN","BISITE4",126,0) D DIRZ^BIUTL3() "RTN","BISITE4",127,0) D RESET^BISITE "RTN","BISITE4",128,0) Q "RTN","BISITE4",129,0) ; "RTN","BISITE4",130,0) ; "RTN","BISITE4",131,0) ;---------- "RTN","BISITE4",132,0) FLUDATS1(BIMODE,BIDATES,BIRESULT,DIRUT) ;EP "RTN","BISITE4",133,0) ;---> Edit Start/End date. "RTN","BISITE4",134,0) ; 1 - BIMODE (req) Equals START or END. "RTN","BISITE4",135,0) ; 2 - BIDATES (req) Default Start & End Dates from Site Parmeter. "RTN","BISITE4",136,0) ; 3 - BIRESULT (ret) Selected date in the form mm/dd. "RTN","BISITE4",137,0) ; 4 - DIRUT (RET) =1 if user ^'d out. "RTN","BISITE4",138,0) ; "RTN","BISITE4",139,0) F D Q:BIPOP "RTN","BISITE4",140,0) .N DIR,Y S BIPOP=0 "RTN","BISITE4",141,0) .S DIR("?")=" Enter the "_BIMODE_" Date of the Flu Season as mm/dd" "RTN","BISITE4",142,0) .S DIR(0)="FA^3:5",DIR("A")=" Enter "_BIMODE_" Date: " "RTN","BISITE4",143,0) .N BIDEFLT S BIDFLT=$S(BIMODE="START":$P(BIDATES,"%"),1:$P(BIDATES,"%",2)) "RTN","BISITE4",144,0) .S DIR("B")=BIDFLT "RTN","BISITE4",145,0) .D ^DIR "RTN","BISITE4",146,0) .I $D(DIRUT) S BIPOP=1 Q "RTN","BISITE4",147,0) .; "RTN","BISITE4",148,0) .;---> Add leading zeros if necessary. "RTN","BISITE4",149,0) .I $L($P(Y,"/"))=1,$P(Y,"/")>0 S Y="0"_Y "RTN","BISITE4",150,0) .I $L($P(Y,"/",2))=1,$P(Y,"/",2)>0 S Y=$P(Y,"/")_"/"_"0"_$P(Y,"/",2) "RTN","BISITE4",151,0) .; "RTN","BISITE4",152,0) .;---> Check pattern match. "RTN","BISITE4",153,0) .I Y'?2N1"/"2N D S BIPOP=0 Q "RTN","BISITE4",154,0) ..W !!?10,"Using numbers, please enter the month, then a slash, then the day.",! "RTN","BISITE4",155,0) .; "RTN","BISITE4",156,0) .;---> Check valid month. "RTN","BISITE4",157,0) .I (+$P(Y,"/")<1)!(+$P(Y,"/")>12) D S BIPOP=0 Q "RTN","BISITE4",158,0) ..W !!?10,$P(Y,"/")," is not a valid MONTH." "RTN","BISITE4",159,0) ..W !?10,"Using numbers, please enter the month, then a slash, then the day.",! "RTN","BISITE4",160,0) .; "RTN","BISITE4",161,0) .;---> Check valid day. "RTN","BISITE4",162,0) .I (+$P(Y,"/",2)<1)!(+$P(Y,"/",2)>31) D S BIPOP=0 Q "RTN","BISITE4",163,0) ..W !!?10,$P(Y,"/",2)," is not a valid DAY." "RTN","BISITE4",164,0) ..W !?10,"Using numbers, please enter the month, then a slash, then the day.",! "RTN","BISITE4",165,0) .; "RTN","BISITE4",166,0) .;---> Check for legit day, given the month. "RTN","BISITE4",167,0) .I +$P(Y,"/")=2,+$P(Y,"/",2)>29 D S BIPOP=0 Q "RTN","BISITE4",168,0) ..W !!?10,Y," is not a valid date",! "RTN","BISITE4",169,0) .N Z S Z=+$P(Y,"/") I (Z=4)!(Z=6)!(Z=9)!(Z=11) I +$P(Y,"/",2)>30 D S BIPOP=0 Q "RTN","BISITE4",170,0) ..W !!?10,Y," is not a valid date",! "RTN","BISITE4",171,0) .; "RTN","BISITE4",172,0) .;---> If START is earlier than 07/01 or the END is later than 6/30, reject. "RTN","BISITE4",173,0) .I BIMODE="START",+$P(Y,"/")<7 D S BIPOP=0 Q "RTN","BISITE4",174,0) ..W !!?10,"START Date cannot be before 07/01.",! "RTN","BISITE4",175,0) .I BIMODE="END",+$P(Y,"/")>6 D S BIPOP=0 Q "RTN","BISITE4",176,0) ..W !?5,"END Date cannot be after 06/30.",! "RTN","BISITE4",177,0) .; "RTN","BISITE4",178,0) .;---> Set new Date. "RTN","BISITE4",179,0) .S BIRESULT=Y,BIPOP=1 "RTN","BISITE4",180,0) Q "RTN","BISITE4",181,0) ; "RTN","BISITE4",182,0) ; "RTN","BISITE4",183,0) ;---------- "RTN","BISITE4",184,0) TEXT5 ;EP "RTN","BISITE4",185,0) ;;Please select the Start and End Dates for the Influenza Season. "RTN","BISITE4",186,0) ;; "RTN","BISITE4",187,0) ;;Enter the dates in the numeric form: mm/dd "RTN","BISITE4",188,0) ;;For example, August 15 would be entered as 08/15. "RTN","BISITE4",189,0) ;; April 1st would be entered as 04/01. "RTN","BISITE4",190,0) ;; "RTN","BISITE4",191,0) D PRINTX("TEXT5") "RTN","BISITE4",192,0) Q "RTN","BISITE4",193,0) ;********** "RTN","BISITE4",194,0) ; "RTN","BISITE4",195,0) ; "RTN","BISITE4",196,0) ;---------- "RTN","BISITE4",197,0) TEXT1 ;EP "RTN","BISITE4",198,0) ;;When an Immunization Visit or Skin Test Visit is stored, the default "RTN","BISITE4",199,0) ;;Category of Visit is "Ambulatory" (Outpatient). "RTN","BISITE4",200,0) ;;However, if the RPMS PIMS (Patient Information Management System) or "RTN","BISITE4",201,0) ;;various Billing applications are in use, the patient may have the "RTN","BISITE4",202,0) ;;Status of "Inpatient" at the time of the visit. "RTN","BISITE4",203,0) ;; "RTN","BISITE4",204,0) ;;In order to avoid conflicts that might arise from Inpatient and "RTN","BISITE4",205,0) ;;Ambulatory Visits being listed for the same day, this software "RTN","BISITE4",206,0) ;;can check the Inpatient Status of the patient at the time of the "RTN","BISITE4",207,0) ;;immunization or skin test. If the patient is listed as an Inpatient "RTN","BISITE4",208,0) ;;at the time of the immunization, the software can automatically "RTN","BISITE4",209,0) ;;change the Category from Ambulatory to Inpatient for the immunization. "RTN","BISITE4",210,0) ;; "RTN","BISITE4",211,0) ;;This feature is turned on by setting "Inpatient Visit Check" to ENABLE. "RTN","BISITE4",212,0) ;;If the "Inpatient Visit Check" feature is causing problems, however, "RTN","BISITE4",213,0) ;;(such as conflicts with third-party Billing software), then set the "RTN","BISITE4",214,0) ;;parameter to DISABLE and no Inpatient check will occur. "RTN","BISITE4",215,0) ;; "RTN","BISITE4",216,0) D PRINTX("TEXT1") "RTN","BISITE4",217,0) Q "RTN","BISITE4",218,0) ; "RTN","BISITE4",219,0) ; "RTN","BISITE4",220,0) ; "RTN","BISITE4",221,0) ;********** PATCH 22, v8.5, OCT 24,2011, IHS/CMI/MWR "RTN","BISITE4",222,0) ;---> Update options to include COVID. "RTN","BISITE4",223,0) ;---------- "RTN","BISITE4",224,0) RISKP ;EP "RTN","BISITE4",225,0) ;V8.5 PATCH 29 - FID-106359 Relocate MenB to site parameter "RTN","BISITE4",226,0) ;V8.5 PATCH 31 - FID-118921 Nirsevimab for 9-18 mts "RTN","BISITE4",227,0) ;V8.5 PATCH 31 - FID-98855 RZV 19-49 mts "RTN","BISITE4",228,0) ;---> Edit the parameter that determines whether the Risk Status "RTN","BISITE4",229,0) ;---> for patients with regard to Flu and Pneumo should be checked "RTN","BISITE4",230,0) ;---> (in the Visit files) when forecasting those vaccines. "RTN","BISITE4",231,0) ;---> Called by Protocol BI SITE INPATIENT CHECK ENABLE. "RTN","BISITE4",232,0) ; "RTN","BISITE4",233,0) Q:$$BISITE^BISITE2 "RTN","BISITE4",234,0) D FULL^VALM1,TITLE^BIUTL5("ENABLE/DISABLE RISK FACTOR CHECKS"),TEXT2 "RTN","BISITE4",235,0) N BIERR,BIDFLT,BIDFLT1,BISEL,DIR,DIRUT,X,Y,J "RTN","BISITE4",236,0) S BIDFLT=$$RISKP^BIUTL2(BISITE),BISEL="",X="" "RTN","BISITE4",237,0) F J=1:1 S Y=$E(BIDFLT,J) Q:Y="" I Y?1N S:X="" X=Y I X'=Y S X=X_","_Y "RTN","BISITE4",238,0) S DIR("B")=X "RTN","BISITE4",239,0) S DIR(0)="LOA^0:8",DIR("A")=" Select one or more of the above, separated by commas: " "RTN","BISITE4",240,0) ; "RTN","BISITE4",241,0) S DIR("?",1)=" Enter each of the numbers for risk factors to include." "RTN","BISITE4",242,0) S DIR("?")=" For example, enter 2-4,8 or 3,5,7 to specify the risk factor(s) to include." "RTN","BISITE4",243,0) D ^DIR "RTN","BISITE4",244,0) I $D(DIRUT) D RESET^BISITE Q "RTN","BISITE4",245,0) ; "RTN","BISITE4",246,0) ;---> Save user selection. "RTN","BISITE4",247,0) S BISEL=$TR(Y,",") "RTN","BISITE4",248,0) I BISEL[0,BISEL S BISEL=$TR(BISEL,0) "RTN","BISITE4",249,0) I 'BISEL S BISEL=0 "RTN","BISITE4",250,0) ; "RTN","BISITE4",251,0) ;********** "RTN","BISITE4",252,0) ; "RTN","BISITE4",253,0) ;---> If selection includes Pneumo, then ask about Smoking Factors. "RTN","BISITE4",254,0) D:(BISEL[1) "RTN","BISITE4",255,0) .D FULL^VALM1,TITLE^BIUTL5("INCLUDE SMOKING AS A PNEUMO RISK FACTOR"),TEXT21 "RTN","BISITE4",256,0) .W !!," Do you wish to include a history of SMOKING in the criteria for" "RTN","BISITE4",257,0) .W !," the High Risk Pneumo group?",! "RTN","BISITE4",258,0) .S DIR("?",1)=" Enter YES to include SMOKING as a Pneumo High Risk Factor, " "RTN","BISITE4",259,0) .S DIR("?")=" enter NO to disregard it as a High Risk Factor." "RTN","BISITE4",260,0) .S DIR(0)="Y",DIR("A")=" Enter Yes or No" "RTN","BISITE4",261,0) .S DIR("B")=$S(BIDFLT[9:"YES",1:"NO") "RTN","BISITE4",262,0) .D ^DIR "RTN","BISITE4",263,0) .I Y S BISEL=BISEL_"S" "RTN","BISITE4",264,0) ; "RTN","BISITE4",265,0) N BIFLD,BIERR "RTN","BISITE4",266,0) S BIFLD(.19)=BISEL "RTN","BISITE4",267,0) D FDIE^BIFMAN(9002084.02,BISITE,.BIFLD,.BIERR,1) "RTN","BISITE4",268,0) I BIERR]"" W !!?3,BIERR D DIRZ^BIUTL3() "RTN","BISITE4",269,0) ; "RTN","BISITE4",270,0) D RESET^BISITE "RTN","BISITE4",271,0) Q "RTN","BISITE4",272,0) ; "RTN","BISITE4",273,0) ; "RTN","BISITE4",274,0) ;---------- "RTN","BISITE4",275,0) ;V8.5 PATCH 29 - FID-106359 Relocate MenB to site parameter "RTN","BISITE4",276,0) TEXT2 ;EP "RTN","BISITE4",277,0) ;;When forecasting immunizations for a patient, this program is able "RTN","BISITE4",278,0) ;;to look at the patient's medical history of visits and attempt to "RTN","BISITE4",279,0) ;;determine if the patient has an increased risk for pneumococcal "RTN","BISITE4",280,0) ;;disease, hepatitis B due to Diabetes, or hepatitis A and B due to "RTN","BISITE4",281,0) ;;chronic liver disease (CLD) or hepatitis C. If the patient fits the "RTN","BISITE4",282,0) ;;High Risk criteria, the program will forecast the patient as due for "RTN","BISITE4",283,0) ;;those immunizations. "RTN","BISITE4",284,0) ;;COVID Immunocompromised option will forecast the patient as due for "RTN","BISITE4",285,0) ;;an additional dose of COVID vaccine. "RTN","BISITE4",286,0) ;; "RTN","BISITE4",287,0) ;;This parameter allows you to select which High Risk forecasting "RTN","BISITE4",288,0) ;;is enabled on your system. The choices are as follows: "RTN","BISITE4",289,0) ;; "RTN","BISITE4",290,0) ;; 0 - None "RTN","BISITE4",291,0) ;; 1 - Pneumo for High Risk history "RTN","BISITE4",292,0) ;; 2 - Hep B for Diabetes Mellitus "RTN","BISITE4",293,0) ;; 3 - Hep A and Hep B for CLD/Hep C "RTN","BISITE4",294,0) ;; 4 - COVID Immunocompromised "RTN","BISITE4",295,0) ;; 5 - Men B for 16 to 23 yrs "RTN","BISITE4",296,0) ;; 6 - RSV for 60 to 74 yrs "RTN","BISITE4",297,0) ;; 7 - HPV for 9 to 10 yrs "RTN","BISITE4",298,0) ;; 8 - RecombZV for 19 to 49 yrs "RTN","BISITE4",299,0) ;; "RTN","BISITE4",300,0) D PRINTX("TEXT2") "RTN","BISITE4",301,0) Q "RTN","BISITE4",302,0) ;********** "RTN","BISITE4",303,0) ; "RTN","BISITE4",304,0) ; "RTN","BISITE4",305,0) ;---------- "RTN","BISITE4",306,0) TEXT21 ;EP "RTN","BISITE4",307,0) ;;You have the option to include smoking in the High Risk factors for "RTN","BISITE4",308,0) ;;Pneumococcal disease. Specifically, the Health Factors looked for will "RTN","BISITE4",309,0) ;;be either "Current Smoker" or "Current Smoker and Smokeless" within "RTN","BISITE4",310,0) ;;the last two years. "RTN","BISITE4",311,0) ;; "RTN","BISITE4",312,0) D PRINTX("TEXT21") "RTN","BISITE4",313,0) Q "RTN","BISITE4",314,0) ; "RTN","BISITE4",315,0) ; "RTN","BISITE4",316,0) ;---------- "RTN","BISITE4",317,0) IMPCPT ;EP "RTN","BISITE4",318,0) ;---> Edit the parameter that determines whether the CPT-coded Visits "RTN","BISITE4",319,0) ;---> should be imported into the V Immunization File if they have "RTN","BISITE4",320,0) ;---> not already been entered. "RTN","BISITE4",321,0) ;---> Called by Protocol BI SITE CPT VISITS IMPORT. "RTN","BISITE4",322,0) ; "RTN","BISITE4",323,0) Q:$$BISITE^BISITE2 "RTN","BISITE4",324,0) D FULL^VALM1,TITLE^BIUTL5("ENABLE/DISABLE IMPORT OF CPT-CODED VISITS"),TEXT3 "RTN","BISITE4",325,0) N BIDFLT,DIR,DIRUT,Y "RTN","BISITE4",326,0) S DIR(0)="SOA^E:Enable;D:Disable" "RTN","BISITE4",327,0) S DIR("A")=" Please select either Enable or Disable: " "RTN","BISITE4",328,0) S DIR("B")=$S($$IMPCPT^BIUTL2(BISITE):"Enable",1:"Disable") "RTN","BISITE4",329,0) D ^DIR "RTN","BISITE4",330,0) D:'$D(DIRUT) "RTN","BISITE4",331,0) .N BIFLD,BIERR S BIFLD(.2)=$G(Y) "RTN","BISITE4",332,0) .D FDIE^BIFMAN(9002084.02,BISITE,.BIFLD,.BIERR,1) "RTN","BISITE4",333,0) .I BIERR]"" W !!?3,BIERR D DIRZ^BIUTL3() "RTN","BISITE4",334,0) D RESET^BISITE "RTN","BISITE4",335,0) Q "RTN","BISITE4",336,0) ; "RTN","BISITE4",337,0) ; "RTN","BISITE4",338,0) ;---------- "RTN","BISITE4",339,0) TEXT3 ;EP "RTN","BISITE4",340,0) ;;In RPMS it is possible for some immunizations to be entered by "RTN","BISITE4",341,0) ;;CPT Code into the CPT Visit File, rather than into the true "RTN","BISITE4",342,0) ;;Immunization Visit File. These "CPT-coded immunizations" "RTN","BISITE4",343,0) ;;do NOT appear on the patient's Immunization Profile, nor are "RTN","BISITE4",344,0) ;;they always included in the Immunization Package Reports. "RTN","BISITE4",345,0) ;; "RTN","BISITE4",346,0) ;;When the "Import CPT-coded Visits" site parameter is enabled, "RTN","BISITE4",347,0) ;;those immunizations that are entered only as CPT Visits will be "RTN","BISITE4",348,0) ;;checked and automatically entered into the proper Immunization "RTN","BISITE4",349,0) ;;Visits File if they do not already exist there. "RTN","BISITE4",350,0) ;; "RTN","BISITE4",351,0) ;;If this parameter is disabled, the program will make no attempt "RTN","BISITE4",352,0) ;;to bring CPT-coded Visits into the Immunization files. "RTN","BISITE4",353,0) ;; "RTN","BISITE4",354,0) D PRINTX("TEXT3") "RTN","BISITE4",355,0) Q "RTN","BISITE4",356,0) ; "RTN","BISITE4",357,0) ; "RTN","BISITE4",358,0) ;---------- "RTN","BISITE4",359,0) VISMNU ;EP "RTN","BISITE4",360,0) ;---> Edit the parameter that determines whether the Risk Status "RTN","BISITE4",361,0) ;---> for patients with regard to Flu and Pneumo should be checked "RTN","BISITE4",362,0) ;---> (in the Visit files) when forecasting those vaccines. "RTN","BISITE4",363,0) ;---> Called by Protocol BI SITE INPATIENT CHECK ENABLE. "RTN","BISITE4",364,0) ; "RTN","BISITE4",365,0) Q:$$BISITE^BISITE2 "RTN","BISITE4",366,0) D FULL^VALM1,TITLE^BIUTL5("ENABLE/DISABLE VISIT SELECTION MENU"),TEXT4 "RTN","BISITE4",367,0) N BIDFLT,DIR,DIRUT,Y "RTN","BISITE4",368,0) S DIR(0)="SOA^E:Enable;D:Disable" "RTN","BISITE4",369,0) S DIR("A")=" Please select either Enable or Disable: " "RTN","BISITE4",370,0) S DIR("B")=$S($$VISMNU^BIUTL2(BISITE):"Enable",1:"Disable") "RTN","BISITE4",371,0) D ^DIR "RTN","BISITE4",372,0) D:'$D(DIRUT) "RTN","BISITE4",373,0) .N BIFLD,BIERR S BIFLD(.28)=$G(Y) "RTN","BISITE4",374,0) .D FDIE^BIFMAN(9002084.02,BISITE,.BIFLD,.BIERR,1) "RTN","BISITE4",375,0) .I BIERR]"" W !!?3,BIERR D DIRZ^BIUTL3() "RTN","BISITE4",376,0) D RESET^BISITE "RTN","BISITE4",377,0) Q "RTN","BISITE4",378,0) ; "RTN","BISITE4",379,0) ; "RTN","BISITE4",380,0) ;---------- "RTN","BISITE4",381,0) TEXT4 ;EP "RTN","BISITE4",382,0) ;;When adding or editing immunizations, this program will either "RTN","BISITE4",383,0) ;;create a NEW Visit or link the immunization to an EXISTING Visit. "RTN","BISITE4",384,0) ;;This process can be occur automatically, or it can be controlled "RTN","BISITE4",385,0) ;;by the user at the time the immunization is being entered. "RTN","BISITE4",386,0) ;; "RTN","BISITE4",387,0) ;;If the Visit Selection Menu is DISABLED, the program will look for "RTN","BISITE4",388,0) ;;similar Visits for the patient on that day and attempt to link with "RTN","BISITE4",389,0) ;;one if enough information matches. If no such Visits exist, a new "RTN","BISITE4",390,0) ;;Visit will be created automatically. (This can sometimes lead to "RTN","BISITE4",391,0) ;;Visits that are incorrectly linked and must be corrected manually.) "RTN","BISITE4",392,0) ;; "RTN","BISITE4",393,0) ;;If the Visit Selection Menu is ENABLED, the program will look for "RTN","BISITE4",394,0) ;;similar Visits--and if any exist--a Visit Selection Menu will pop up. "RTN","BISITE4",395,0) ;;The Visit Selection Menu will allow the user to either create a new "RTN","BISITE4",396,0) ;;Visit or select from existing Visits for that day. (If there are no "RTN","BISITE4",397,0) ;;existing Visits, a new Visit will be created automatically.) "RTN","BISITE4",398,0) ;; "RTN","BISITE4",399,0) D PRINTX("TEXT4") "RTN","BISITE4",400,0) Q "RTN","BISITE4",401,0) ; "RTN","BISITE4",402,0) ; "RTN","BISITE4",403,0) ;---------- "RTN","BISITE4",404,0) PRINTX(BILINL,BITAB) ;EP "RTN","BISITE4",405,0) Q:$G(BILINL)="" "RTN","BISITE4",406,0) N I,T,X "RTN","BISITE4",407,0) S T="" "RTN","BISITE4",408,0) S:'$D(BITAB) BITAB=5 "RTN","BISITE4",409,0) F I=1:1:BITAB S T=T_" " "RTN","BISITE4",410,0) F I=1:1 S X=$T(@BILINL+I) Q:X'[";;" W !,T,$P(X,";;",2) "RTN","BISITE4",411,0) Q "RTN","BIUTL2") 0^18^B68598191 "RTN","BIUTL2",1,0) BIUTL2 ;IHS/CMI/MWR - UTIL: ZIS, PATH, ERRCODE; MAY 10, 2010 ; 03 Jul 2025 12:02 PM "RTN","BIUTL2",2,0) ;;8.5;IMMUNIZATION;**21,29,30,31**;OCT 24,2011;Build 137 "RTN","BIUTL2",3,0) ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS * "RTN","BIUTL2",4,0) ; "RTN","BIUTL2",5,0) ;---------- "RTN","BIUTL2",6,0) ERRCD(BIIEN,BITEXT,BIDISPL,BIABBRV) ;EP "RTN","BIUTL2",7,0) ;---> Display Error Code from BI TABLE ERROR CODE File. "RTN","BIUTL2",8,0) ;---> Parameters: "RTN","BIUTL2",9,0) ; 1 - BIIEN (req) IEN of Error Code in ^BIERR(. "RTN","BIUTL2",10,0) ; 2 - BITEXT (ret) Text of Error Code. "RTN","BIUTL2",11,0) ; 3 - BIDISPL (opt) BIDISPL=1 if Error Code Text SHOULD BE displayed here. "RTN","BIUTL2",12,0) ; 4 - BIABBRV (opt) BIABBRV=1 return Abbreviated Error Text (<20 chars). "RTN","BIUTL2",13,0) ; "RTN","BIUTL2",14,0) ;---> Set BITEXT=Text of Error Code. "RTN","BIUTL2",15,0) D "RTN","BIUTL2",16,0) .I '$G(BIIEN) D Q "RTN","BIUTL2",17,0) ..I $G(BIABBRV) S BITEXT="No Error Code" Q "RTN","BIUTL2",18,0) ..S BITEXT="Error Code not provided by software." "RTN","BIUTL2",19,0) .; "RTN","BIUTL2",20,0) .I '$D(^BIERR(BIIEN,0)) D Q "RTN","BIUTL2",21,0) ..I $G(BIABBRV) S BITEXT="No Error Code" Q "RTN","BIUTL2",22,0) ..S BITEXT="Error Code does not exist in BI TABLE ERROR CODE File." "RTN","BIUTL2",23,0) .; "RTN","BIUTL2",24,0) .I $G(BIABBRV) S BITEXT=$P(^BIERR(BIIEN,0),"^",3) Q "RTN","BIUTL2",25,0) .S BITEXT=$P(^BIERR(BIIEN,0),"^",2)_" #"_BIIEN "RTN","BIUTL2",26,0) ; "RTN","BIUTL2",27,0) ;---> Display Error Code Text. "RTN","BIUTL2",28,0) D:$G(BIDISPL) "RTN","BIUTL2",29,0) .N BICRT S BICRT=$S(($E($G(IOST))="C")!($G(IOST)["BROWSER"):1,1:0) "RTN","BIUTL2",30,0) .W !!?3,BITEXT "RTN","BIUTL2",31,0) .W:'BICRT @IOF D:BICRT DIRZ^BIUTL3() "RTN","BIUTL2",32,0) ; "RTN","BIUTL2",33,0) ;---> Not used for now. "RTN","BIUTL2",34,0) Q "RTN","BIUTL2",35,0) ; "RTN","BIUTL2",36,0) ;---------- "RTN","BIUTL2",37,0) VNAME(IEN,LONG) ;EP "RTN","BIUTL2",38,0) ;---> Return the Short, Long, or Full Name for a Vaccine. "RTN","BIUTL2",39,0) ;---> Parameters: "RTN","BIUTL2",40,0) ; 1 - IEN (req) IEN of Vaccine. "RTN","BIUTL2",41,0) ; 2 - LONG (opt) 0/null=Short Name; 1=Long Name; 2=Full Name; "RTN","BIUTL2",42,0) ; 3="ShortName (LongName)." "RTN","BIUTL2",43,0) ; "RTN","BIUTL2",44,0) Q:'$G(IEN) "NO IEN" "RTN","BIUTL2",45,0) Q:'$D(^AUTTIMM(IEN,0)) "UNKNOWN" "RTN","BIUTL2",46,0) Q:$G(LONG)=1 $P(^AUTTIMM(IEN,0),"^") "RTN","BIUTL2",47,0) Q:$G(LONG)=2 $P($G(^AUTTIMM(IEN,1)),"^",14) "RTN","BIUTL2",48,0) Q:$G(LONG)=3 " "_$P(^AUTTIMM(IEN,0),"^",2)_" ("_$P(^AUTTIMM(IEN,0),"^")_") " "RTN","BIUTL2",49,0) Q $P(^AUTTIMM(IEN,0),"^",2) "RTN","BIUTL2",50,0) ; "RTN","BIUTL2",51,0) ;---------- "RTN","BIUTL2",52,0) MNAME(IEN,MVX) ;EP "RTN","BIUTL2",53,0) ;---> Return Manufacturer Name or MVX Code. "RTN","BIUTL2",54,0) ;---> Parameters: "RTN","BIUTL2",55,0) ; 1 - IEN (req) IEN of Manufacturer. "RTN","BIUTL2",56,0) ; 2 - MVX (opt) If MVX=1, return MVX Code, MVX=2, return SYNONYM #1. "RTN","BIUTL2",57,0) ; "RTN","BIUTL2",58,0) Q:'$G(IEN) "NO IEN" "RTN","BIUTL2",59,0) Q:'$D(^AUTTIMAN(IEN,0)) $S($G(MVX):"UNK",1:"UNKNOWN") "RTN","BIUTL2",60,0) Q:$G(MVX)=1 $P(^AUTTIMAN(IEN,0),"^",2) "RTN","BIUTL2",61,0) ;********** PATCH 21, v8.5, APR 01,2021, IHS/CMI/MWR "RTN","BIUTL2",62,0) ;---> Return Synonym #1 for prompts in DTS call. "RTN","BIUTL2",63,0) Q:$G(MVX)=2 $P(^AUTTIMAN(IEN,0),"^",5) "RTN","BIUTL2",64,0) Q $P(^AUTTIMAN(IEN,0),"^") "RTN","BIUTL2",65,0) ; "RTN","BIUTL2",66,0) ;---------- "RTN","BIUTL2",67,0) CODE(IEN,TYPE) ;EP "RTN","BIUTL2",68,0) ;---> Return the HL7-CVX, CPT, ICD Diagnosis, or ICD Procedure Code "RTN","BIUTL2",69,0) ;---> for a Vaccine. "RTN","BIUTL2",70,0) ;---> Parameters: "RTN","BIUTL2",71,0) ; 1 - IEN (req) IEN of Vaccine. "RTN","BIUTL2",72,0) ; 2 - TYPE (opt) TYPE of Code to return: "RTN","BIUTL2",73,0) ; 1=HL7-CVX (also default) "RTN","BIUTL2",74,0) ; 2=CPT "RTN","BIUTL2",75,0) ; 3=ICD Diagnosis "RTN","BIUTL2",76,0) ; 4=ICD Procedure "RTN","BIUTL2",77,0) ; 5=Volume Default "RTN","BIUTL2",78,0) ; 6=HL7-CVX w/leading zero "RTN","BIUTL2",79,0) ; "RTN","BIUTL2",80,0) Q:'$G(IEN) "NO IEN" "RTN","BIUTL2",81,0) Q:'$D(^AUTTIMM(IEN,0)) "UNKNOWN" "RTN","BIUTL2",82,0) ; "RTN","BIUTL2",83,0) Q:$G(TYPE)=2 $P(^AUTTIMM(IEN,0),"^",11) "RTN","BIUTL2",84,0) Q:$G(TYPE)=3 $P(^AUTTIMM(IEN,0),"^",14) "RTN","BIUTL2",85,0) Q:$G(TYPE)=4 $P(^AUTTIMM(IEN,0),"^",15) "RTN","BIUTL2",86,0) Q:$G(TYPE)=5 $P(^AUTTIMM(IEN,0),"^",18) "RTN","BIUTL2",87,0) N X S X=$P(^AUTTIMM(IEN,0),"^",3) "RTN","BIUTL2",88,0) I $G(TYPE)=6,$L(X)=1 S X=0_X "RTN","BIUTL2",89,0) Q X "RTN","BIUTL2",90,0) ; "RTN","BIUTL2",91,0) ;---------- "RTN","BIUTL2",92,0) IMMVG(BIIEN,Z) ;EP "RTN","BIUTL2",93,0) ;---> For a particular Vaccine, return its Vaccine Group Information. "RTN","BIUTL2",94,0) ;---> (Note: Vaccine Group is also called "Series Type." "RTN","BIUTL2",95,0) ;---> . "RTN","BIUTL2",96,0) ;---> Parameters: "RTN","BIUTL2",97,0) ; 1 - BIIEN (req) IEN in of Vaccine in IMMUNIZATION File #9999999.14. "RTN","BIUTL2",98,0) ; 2 - Z (opt) If Z=1, return Vaccine Group FULL NAME. "RTN","BIUTL2",99,0) ; If Z=2, return Vaccine Group IEN (default if no Z). "RTN","BIUTL2",100,0) ; If Z=3, return Vaccine Group Forecast indicator: "RTN","BIUTL2",101,0) ; 1=ON, 0=OFF "RTN","BIUTL2",102,0) ; If Z=4, return Display Order for reports. "RTN","BIUTL2",103,0) ; If Z=5, return SHORT NAME of Vaccine Group. "RTN","BIUTL2",104,0) ; "RTN","BIUTL2",105,0) ;---> Default: Return IEN of Vaccine Group. "RTN","BIUTL2",106,0) S:'$G(Z) Z=2 "RTN","BIUTL2",107,0) N BIVG,BIVG0 "RTN","BIUTL2",108,0) ; "RTN","BIUTL2",109,0) ;---> If any values or pointers are null, set Vaccine Group IEN=12: "Other". "RTN","BIUTL2",110,0) D "RTN","BIUTL2",111,0) .I '$G(BIIEN) S BIVG=12 Q "RTN","BIUTL2",112,0) .I '$D(^AUTTIMM(BIIEN,0)) S BIVG=12 Q "RTN","BIUTL2",113,0) .S BIVG=$P(^AUTTIMM(BIIEN,0),U,9) "RTN","BIUTL2",114,0) .S:'BIVG BIVG=12 "RTN","BIUTL2",115,0) ; "RTN","BIUTL2",116,0) I Z=2 Q BIVG "RTN","BIUTL2",117,0) Q $$VGROUP(BIVG,Z) "RTN","BIUTL2",118,0) ; "RTN","BIUTL2",119,0) ;---------- "RTN","BIUTL2",120,0) VGROUP(BIVG,Z) ;EP "RTN","BIUTL2",121,0) ;---> Return Vaccine Group or ("Series Type") or Information "RTN","BIUTL2",122,0) ;---> for a particular Vaccine Group. "RTN","BIUTL2",123,0) ;---> Parameters: "RTN","BIUTL2",124,0) ; 1 - BIVG (req) IEN in BI TABLE VACCINE GROUP File #9002084.93. "RTN","BIUTL2",125,0) ; 2 - Z (opt) If Z=1, return Vaccine Group FULL NAME (default if no Z). "RTN","BIUTL2",126,0) ; If Z=3, return Vaccine Group Forecast indicator: "RTN","BIUTL2",127,0) ; 1=ON, 0=OFF "RTN","BIUTL2",128,0) ; If Z=4, return Display Order for reports. "RTN","BIUTL2",129,0) ; If Z=5, return SHORT NAME of Vaccine Group. "RTN","BIUTL2",130,0) ; If Z=6, return max doses in Quarterly/Two-Yr-Old Reports. "RTN","BIUTL2",131,0) ; If Z=7, return max doses in Adolescent Report. "RTN","BIUTL2",132,0) ; If Z=8, return Vaccine Group Two-Yr-Old Report indicator: "RTN","BIUTL2",133,0) ; 1=Yes,include; 0=No, exclude. "RTN","BIUTL2",134,0) ; If Z=9, return representative CVX for this VMR Vaccine Group Number. "RTN","BIUTL2",135,0) ; If Z=10, return NOS EQUIVALENT CVX of Vaccine Group. "RTN","BIUTL2",136,0) ; "RTN","BIUTL2",137,0) ;---> If null, set Vaccine Group IEN=12: "Other". "RTN","BIUTL2",138,0) S:'$G(BIVG) BIVG=12 "RTN","BIUTL2",139,0) S BIVG0=$G(^BISERT(BIVG,0)) "RTN","BIUTL2",140,0) S:BIVG0="" BIVG=12,BIVG0=$G(^BISERT(BIVG,0)) "RTN","BIUTL2",141,0) ; "RTN","BIUTL2",142,0) S:('$G(Z)) Z=1 "RTN","BIUTL2",143,0) I Z=3 Q +$P(BIVG0,U,5) "RTN","BIUTL2",144,0) I Z=4 Q +$P(BIVG0,U,2) "RTN","BIUTL2",145,0) I Z=5 Q $P(BIVG0,U,3) "RTN","BIUTL2",146,0) I Z=6 Q $P(BIVG0,U,4) "RTN","BIUTL2",147,0) I Z=7 Q $P(BIVG0,U,7) "RTN","BIUTL2",148,0) I Z=8 Q $P(BIVG0,U,8) "RTN","BIUTL2",149,0) ; "RTN","BIUTL2",150,0) ;********** PATCH 19, v8.5, JUN 01,2020, IHS/CMI/MWR "RTN","BIUTL2",151,0) ;---> Add param to return NOS EQUIVALENT CVX for Vaccine Group. "RTN","BIUTL2",152,0) I Z=10 Q $P(BIVG0,U,11) "RTN","BIUTL2",153,0) ; "RTN","BIUTL2",154,0) ;********** PATCH 18, v8.5, JUL 01,2019, IHS/CMI/MWR "RTN","BIUTL2",155,0) ;---> Add param to return representative CVX for VMR Vaccine Group Number. "RTN","BIUTL2",156,0) I Z=9 Q $$CODE($P(BIVG0,U,10)) "RTN","BIUTL2",157,0) ; "RTN","BIUTL2",158,0) Q $P(BIVG0,U) "RTN","BIUTL2",159,0) ; "RTN","BIUTL2",160,0) ;;********** PATCH 18, v8.5, JUL 01,2019, IHS/CMI/MWR "RTN","BIUTL2",161,0) ;---> Return representative CVX for this VMR Vaccine Group Number. "RTN","BIUTL2",162,0) ; "RTN","BIUTL2",163,0) VMRVG(BIVMR) ;EP "RTN","BIUTL2",164,0) ;---> Return representative CVX for this VMR Vaccine Group Number. "RTN","BIUTL2",165,0) ;---> Parameters: "RTN","BIUTL2",166,0) ; 1 - BIVMR (req) VMR Vaccine Group Number "RTN","BIUTL2",167,0) ; "RTN","BIUTL2",168,0) Q:('$G(BIVMR)) 999 "RTN","BIUTL2",169,0) N BIVG S BIVG=$O(^BISERT("VMR",BIVMR,0)) "RTN","BIUTL2",170,0) Q:('$G(BIVG)) 999 "RTN","BIUTL2",171,0) Q $$VGROUP(BIVG,9) "RTN","BIUTL2",172,0) ; "RTN","BIUTL2",173,0) ;---------- "RTN","BIUTL2",174,0) HL7TX(BICVX,BIGRP) ;EP "RTN","BIUTL2",175,0) ;---> Return the IEN of a Vaccine, given its HL7 Code. "RTN","BIUTL2",176,0) ;---> If lookup fails, return 137 for "OTHER". "RTN","BIUTL2",177,0) ;---> Parameters: "RTN","BIUTL2",178,0) ; 1 - BICVX (req) CVX Code for this vaccine. "RTN","BIUTL2",179,0) ; 2 - BIGRP (opt) If BIGRP=1, return Vaccine Group IEN for this CVX. "RTN","BIUTL2",180,0) ; If BIGRP=2, return Vaccine Name for this CVX. "RTN","BIUTL2",181,0) ; "RTN","BIUTL2",182,0) I '$G(BICVX) S BICVX=999 "RTN","BIUTL2",183,0) ;---> For lookups where a leading zero CVX has been passed. "RTN","BIUTL2",184,0) S BICVX=+BICVX "RTN","BIUTL2",185,0) I '$D(^AUTTIMM("C",BICVX)) S BICVX=999 "RTN","BIUTL2",186,0) N BIVIEN "RTN","BIUTL2",187,0) S BIVIEN=$O(^AUTTIMM("C",BICVX,0)) "RTN","BIUTL2",188,0) S:'BIVIEN BIVIEN=137 "RTN","BIUTL2",189,0) ;---> Return Vaccine IEN for this CVX. "RTN","BIUTL2",190,0) Q:'$G(BIGRP) BIVIEN "RTN","BIUTL2",191,0) ; "RTN","BIUTL2",192,0) ;---> Return Vaccine Name for this CVX. "RTN","BIUTL2",193,0) I BIGRP=2 Q ($$VNAME(BIVIEN)) "RTN","BIUTL2",194,0) ; "RTN","BIUTL2",195,0) ;---> Return Vaccine Group IEN for this CVX. "RTN","BIUTL2",196,0) N X "RTN","BIUTL2",197,0) S X=$P(^AUTTIMM(BIVIEN,0),"^",9) "RTN","BIUTL2",198,0) S:'X X=12 "RTN","BIUTL2",199,0) Q X "RTN","BIUTL2",200,0) ; "RTN","BIUTL2",201,0) ; "RTN","BIUTL2",202,0) ;---------- "RTN","BIUTL2",203,0) VCOMPS(IEN) ;EP v8.0 "RTN","BIUTL2",204,0) ;---> Return string of components IEN's for a Vaccine. "RTN","BIUTL2",205,0) ;---> Parameters: "RTN","BIUTL2",206,0) ; 1 - IEN (req) IEN of Vaccine. "RTN","BIUTL2",207,0) ; "RTN","BIUTL2",208,0) Q:'$G(IEN) "" "RTN","BIUTL2",209,0) Q:'$D(^AUTTIMM(IEN,0)) "" "RTN","BIUTL2",210,0) N X S X=$P(^AUTTIMM(IEN,0),"^",21,26) "RTN","BIUTL2",211,0) S X=$TR(X,"^",";") "RTN","BIUTL2",212,0) Q X "RTN","BIUTL2",213,0) ; "RTN","BIUTL2",214,0) ;---------- "RTN","BIUTL2",215,0) LOTDEF(IEN) ;EP "RTN","BIUTL2",216,0) ;---> Return the IEN of the Default Lot# for a Vaccine. "RTN","BIUTL2",217,0) ;---> Parameters: "RTN","BIUTL2",218,0) ; 1 - IEN (req) IEN of Vaccine in IMMUNIZATION File (9999999.14). "RTN","BIUTL2",219,0) ; "RTN","BIUTL2",220,0) Q:'$G(IEN) "" "RTN","BIUTL2",221,0) Q:'$D(^AUTTIMM(IEN,0)) "" "RTN","BIUTL2",222,0) N X,Y S X=$P(^AUTTIMM(IEN,0),"^",4) "RTN","BIUTL2",223,0) ; "RTN","BIUTL2",224,0) ;---> Quit if no Default Lot# stored. "RTN","BIUTL2",225,0) Q:'X "" "RTN","BIUTL2",226,0) ;---> Quit if pointed to Lot# does not exist. "RTN","BIUTL2",227,0) S Y=$G(^AUTTIML(X,0)) "RTN","BIUTL2",228,0) Q:Y="" "" "RTN","BIUTL2",229,0) ;---> Quit if this Lot# does NOT point back to this Vaccine. "RTN","BIUTL2",230,0) Q:$P(Y,U,4)'=IEN "" "RTN","BIUTL2",231,0) ;---> Quit if this Lot# is INACTIVE. "RTN","BIUTL2",232,0) Q:$P(Y,U,3) "" "RTN","BIUTL2",233,0) ; "RTN","BIUTL2",234,0) ;********** PATCH 1, v8.2.1, FEB 01,2008, IHS/CMI/MWR "RTN","BIUTL2",235,0) ;---> Quit if this Lot# has a Facility and User's DUZ(2) does not match. "RTN","BIUTL2",236,0) Q:(($P(Y,U,14))&($P(Y,U,14)'=$G(DUZ(2)))) "" "RTN","BIUTL2",237,0) ;********** "RTN","BIUTL2",238,0) ; "RTN","BIUTL2",239,0) ;---> Return Default Lot# IEN. "RTN","BIUTL2",240,0) Q X "RTN","BIUTL2",241,0) ; "RTN","BIUTL2",242,0) ;---------- "RTN","BIUTL2",243,0) LOTREQ(BIDUZ2) ;EP "RTN","BIUTL2",244,0) ;---> Return 1 if Lot#'s are required, 0 if not. "RTN","BIUTL2",245,0) ;---> Parameters: "RTN","BIUTL2",246,0) ; 1 - BIDUZ2 (req) User's DUZ(2) "RTN","BIUTL2",247,0) ; "RTN","BIUTL2",248,0) Q $P($G(^BISITE(+$G(BIDUZ2),0)),U,9) "RTN","BIUTL2",249,0) ; "RTN","BIUTL2",250,0) ;---------- "RTN","BIUTL2",251,0) LOTLOW(BILIEN,BIDUZ2) ;EP "RTN","BIUTL2",252,0) ;---> Return the number of (remaining) doses of a Lot Number "RTN","BIUTL2",253,0) ;---> that will trigger a Low Supply Alert. "RTN","BIUTL2",254,0) ;---> If not set for this site, 50 will be returned. "RTN","BIUTL2",255,0) ;---> Parameters: "RTN","BIUTL2",256,0) ; 1 - BILIEN (req) IEN of Lot Number in ^AUTTIML. "RTN","BIUTL2",257,0) ; 2 - BIDUZ2 (req) User's DUZ(2) "RTN","BIUTL2",258,0) ; "RTN","BIUTL2",259,0) N X "RTN","BIUTL2",260,0) D "RTN","BIUTL2",261,0) .S X=$P($G(^AUTTIML(+BILIEN,0)),U,15) Q:X "RTN","BIUTL2",262,0) .S X=$P($G(^BISITE(+$G(BIDUZ2),0)),U,25) "RTN","BIUTL2",263,0) S:(X="") X=50 "RTN","BIUTL2",264,0) Q X "RTN","BIUTL2",265,0) ; "RTN","BIUTL2",266,0) ;---------- "RTN","BIUTL2",267,0) FORECAS(BIDUZ2) ;EP "RTN","BIUTL2",268,0) ;---> Return 1 if Forecasting is enabled. "RTN","BIUTL2",269,0) ;---> Parameters: "RTN","BIUTL2",270,0) ; 1 - BIDUZ2 (req) User's DUZ(2) "RTN","BIUTL2",271,0) ; "RTN","BIUTL2",272,0) Q $P($G(^BISITE(+$G(BIDUZ2),0)),U,11) "RTN","BIUTL2",273,0) ; "RTN","BIUTL2",274,0) ;---------- "RTN","BIUTL2",275,0) INPTCHK(BIDUZ2) ;EP "RTN","BIUTL2",276,0) ;---> Return 1 if Inpatient Visit Check is enabled. "RTN","BIUTL2",277,0) ;---> Parameters: "RTN","BIUTL2",278,0) ; 1 - BIDUZ2 (req) User's DUZ(2) "RTN","BIUTL2",279,0) ; "RTN","BIUTL2",280,0) Q $P($G(^BISITE(+$G(BIDUZ2),0)),U,23) "RTN","BIUTL2",281,0) ; "RTN","BIUTL2",282,0) ;********** PATCH 14, v8.5, AUG 01,2017, IHS/CMI/MWR "RTN","BIUTL2",283,0) ;---> Update notes below. "RTN","BIUTL2",284,0) ;---------- "RTN","BIUTL2",285,0) RISKP(BIDUZ2) ;EP - Risk Factor check (and smoking). "RTN","BIUTL2",286,0) ;V8.5 PATCH 29 - FID-106359 Relocate MenB to site parameter "RTN","BIUTL2",287,0) ;---> Risk Parameter: "RTN","BIUTL2",288,0) ; 0 - None "RTN","BIUTL2",289,0) ; 1 - Pneumo for High Risk history "RTN","BIUTL2",290,0) ; 2 - Hep B for Diabetes Mellitus "RTN","BIUTL2",291,0) ; 3 - Hep A and Hep B for CLD/Hep C "RTN","BIUTL2",292,0) ; 4 - COVID Immunocompromised "RTN","BIUTL2",293,0) ; 5 - Men B for 16 to 18 yrs "RTN","BIUTL2",294,0) ; 6 - RSV for 60 to 74 yrs "RTN","BIUTL2",295,0) ; 7 - HPV Early forecast at 9 "RTN","BIUTL2",296,0) ; 8 - RZV "RTN","BIUTL2",297,0) ; S - add smoking "RTN","BIUTL2",298,0) ; "RTN","BIUTL2",299,0) ;---> Parameters: "RTN","BIUTL2",300,0) ; 1 - BIDUZ2 (req) User's DUZ(2) "RTN","BIUTL2",301,0) ; "RTN","BIUTL2",302,0) Q $P($G(^BISITE(+$G(BIDUZ2),0)),U,19) "RTN","BIUTL2",303,0) ;********** "RTN","BIUTL2",304,0) ; "RTN","BIUTL2",305,0) ;---------- "RTN","BIUTL2",306,0) IMPCPT(BIDUZ2) ;EP "RTN","BIUTL2",307,0) ;---> Return 1 if Import of CPT-coded Visits is enabled. "RTN","BIUTL2",308,0) ;---> Parameters: "RTN","BIUTL2",309,0) ; 1 - BIDUZ2 (req) User's DUZ(2) "RTN","BIUTL2",310,0) ; "RTN","BIUTL2",311,0) Q $P($G(^BISITE(+$G(BIDUZ2),0)),U,20) "RTN","BIUTL2",312,0) ; "RTN","BIUTL2",313,0) ;---------- "RTN","BIUTL2",314,0) VISMNU(BIDUZ2) ;EP "RTN","BIUTL2",315,0) ;---> Visit Selection Menu Parameter: Return 1 to display a menu of matching "RTN","BIUTL2",316,0) ;---> Visits, if any; return 0 to automatically create or link Visits. "RTN","BIUTL2",317,0) ;---> Parameters: "RTN","BIUTL2",318,0) ; 1 - BIDUZ2 (req) User's DUZ(2) "RTN","BIUTL2",319,0) ; "RTN","BIUTL2",320,0) Q +$P($G(^BISITE(+$G(BIDUZ2),0)),U,28) "RTN","BIUTL2",321,0) ; "RTN","BIUTL2",322,0) ;---------- "RTN","BIUTL2",323,0) CMGRACT(BICMGR) ;EP "RTN","BIUTL2",324,0) ;---> Return 1 if the Case Manager is INACTIVE. "RTN","BIUTL2",325,0) ;---> Parameters: "RTN","BIUTL2",326,0) ; 1 - BICMGR (req) IEN of Case Manager. "RTN","BIUTL2",327,0) ; "RTN","BIUTL2",328,0) Q:'$G(BICMGR) 1 "RTN","BIUTL2",329,0) Q:'$D(^BIMGR(BICMGR,0)) 1 "RTN","BIUTL2",330,0) Q $P(^BIMGR(BICMGR,0),U,2) "RTN","BIUTL2",331,0) ; "RTN","BIUTL2",332,0) ;---------- "RTN","BIUTL2",333,0) CMGRDEF(DUZ2,X) ;EP "RTN","BIUTL2",334,0) ;---> Return Default Case Manager for this site. "RTN","BIUTL2",335,0) ;---> Parameters: "RTN","BIUTL2",336,0) ; 1 - DUZ2 (req) User's DUZ(2) "RTN","BIUTL2",337,0) ; 2 - X (opt) X=1 to return TEXT of default Case Manager name. "RTN","BIUTL2",338,0) ; "RTN","BIUTL2",339,0) Q:'$G(DUZ2) "" "RTN","BIUTL2",340,0) N Y S Y=$P($G(^BISITE(DUZ2,0)),U,2) "RTN","BIUTL2",341,0) Q:'Y "" "RTN","BIUTL2",342,0) Q:'$D(^BIMGR(Y,0)) "" "RTN","BIUTL2",343,0) Q:'$G(X) Y "RTN","BIUTL2",344,0) Q:$$CMGRACT(Y) $E($$PERSON^BIUTL1(Y),1,20)_" * INACTIVE!" "RTN","BIUTL2",345,0) Q $$PERSON^BIUTL1(Y) "RTN","BIUTL2",346,0) ; "RTN","BIUTL2",347,0) ;---------- "RTN","BIUTL2",348,0) DEFLET(DUZ2,X,Z) ;EP "RTN","BIUTL2",349,0) ;---> Return Default Letters (Standard Due Letter, "RTN","BIUTL2",350,0) ;---> Official Imm Record). "RTN","BIUTL2",351,0) ;---> Parameters: "RTN","BIUTL2",352,0) ; 1 - DUZ2 (req) User's DUZ(2) "RTN","BIUTL2",353,0) ; 2 - X (opt) X=1 to return TEXT of default Due Letter. "RTN","BIUTL2",354,0) ; 3 - Z (opt) Z="" returns Standard Due Letter. "RTN","BIUTL2",355,0) ; Z=1 returns Official Immunization Record. "RTN","BIUTL2",356,0) ; "RTN","BIUTL2",357,0) Q:'$G(DUZ2) "" "RTN","BIUTL2",358,0) N Y S Y=$P($G(^BISITE(DUZ2,0)),U,$S($G(Z):13,1:4)) "RTN","BIUTL2",359,0) Q:'$G(X) Y "RTN","BIUTL2",360,0) Q:'Y "" "RTN","BIUTL2",361,0) Q $P($G(^BILET(Y,0)),U) "RTN","BIUTL2",362,0) ; "RTN","BIUTL2",363,0) ;---------- "RTN","BIUTL2",364,0) MINDAYS(DUZ2) ;EP "RTN","BIUTL2",365,0) ;---> Return Default Minimum Days Since Last Letter sent "RTN","BIUTL2",366,0) ;---> for this site. "RTN","BIUTL2",367,0) ;---> Parameters: "RTN","BIUTL2",368,0) ; 1 - DUZ2 (req) User's DUZ(2) "RTN","BIUTL2",369,0) ; "RTN","BIUTL2",370,0) Q:'$G(DUZ2) 60 "RTN","BIUTL2",371,0) N Y S Y=$P($G(^BISITE(DUZ2,0)),U,5) "RTN","BIUTL2",372,0) Q:Y="" 60 "RTN","BIUTL2",373,0) Q Y "RTN","BIUTL2",374,0) ; "RTN","BIUTL2",375,0) ;---------- "RTN","BIUTL2",376,0) MINAGE(DUZ2) ;EP "RTN","BIUTL2",377,0) ;---> Return parameter to forecast immunizations due at either the "RTN","BIUTL2",378,0) ;---> Minimum Acceptable Age or at the Recommended Age for this site. "RTN","BIUTL2",379,0) ;---> 1=Minimum Acceptable, 0=Recommended. "RTN","BIUTL2",380,0) ;---> Parameters: "RTN","BIUTL2",381,0) ; 1 - DUZ2 (req) User's DUZ(2) "RTN","BIUTL2",382,0) ; "RTN","BIUTL2",383,0) Q:'$G(DUZ2) 0 "RTN","BIUTL2",384,0) Q:($P($G(^BISITE(DUZ2,0)),U,7)="A") 1 "RTN","BIUTL2",385,0) Q 0 "RTN","BIUTL2",386,0) ; "RTN","BIUTL2",387,0) ; "RTN","BIUTL2",388,0) ;---------- "RTN","BIUTL2",389,0) VISDEF(IEN) ;EP "RTN","BIUTL2",390,0) ;---> Return the Default Date of the Vaccine Information Statement "RTN","BIUTL2",391,0) ;---> (VIS) for this vaccine (Fileman format). "RTN","BIUTL2",392,0) ;---> Parameters: "RTN","BIUTL2",393,0) ; 1 - IEN (req) IEN of Vaccine in IMMUNIZATION File (9999999.14). "RTN","BIUTL2",394,0) ; "RTN","BIUTL2",395,0) Q:'$G(IEN) "" "RTN","BIUTL2",396,0) Q:'$D(^AUTTIMM(IEN,0)) "" "RTN","BIUTL2",397,0) Q $P(^AUTTIMM(IEN,0),"^",13) "RTN","BIUTL2",398,0) ; "RTN","BIUTL2",399,0) ;---------- "RTN","BIUTL2",400,0) ZIS(BIPOP,BIQUE,BIDEF,BIPRMPT,BIMES) ;EP "RTN","BIUTL2",401,0) ;---> Call to ^%ZIS "RTN","BIUTL2",402,0) ;---> Parameters: "RTN","BIUTL2",403,0) ; 1 - BIPOP (ret) BIPOP=1 if POP=1 (fail or quit). "RTN","BIUTL2",404,0) ; 2 - BIQUE=1 (opt) SET=1 if job should be queueable. "RTN","BIUTL2",405,0) ; 3 - BIDEF=DEFAULT (opt) If exists, equals Default DEVICE. "RTN","BIUTL2",406,0) ; 4 - BIPRMPT (opt) If exists, equals PROMPT. "RTN","BIUTL2",407,0) ; 5 - BIMES (opt) A message to display if QUEUED. "RTN","BIUTL2",408,0) ; "RTN","BIUTL2",409,0) ;---> Example: D ZIS^BIUTL2(.BIPOP,1,"HOME") "RTN","BIUTL2",410,0) ; "RTN","BIUTL2",411,0) ZIS1 ;EP for loop back from failed BIQUE. "RTN","BIUTL2",412,0) S BIPOP=0 "RTN","BIUTL2",413,0) ; "RTN","BIUTL2",414,0) ;---> BIPRMPT=BIPRMPT. "RTN","BIUTL2",415,0) S %ZIS("A")=$S($D(BIPRMPT):BIPRMPT,1:" Select DEVICE: ") "RTN","BIUTL2",416,0) ; "RTN","BIUTL2",417,0) ;---> BIDEF=DEFAULT PRINTER. "RTN","BIUTL2",418,0) ;---> IF NO BIDEF, SET BIDEF="P" FOR CLOSEST PRINTER. "RTN","BIUTL2",419,0) D "RTN","BIUTL2",420,0) .I '$D(BIDEF) S %ZIS="P" Q "RTN","BIUTL2",421,0) .S %ZIS("B")=BIDEF,%ZIS="" "RTN","BIUTL2",422,0) ; "RTN","BIUTL2",423,0) ;---> If BIQUE=1,job may be queued. "RTN","BIUTL2",424,0) I $G(BIQUE)]"" I BIQUE S %ZIS=%ZIS_"Q" "RTN","BIUTL2",425,0) ; "RTN","BIUTL2",426,0) W ! D ^%ZIS S:POP BIPOP=1 "RTN","BIUTL2",427,0) ;---> Quit if BIPOP (DUOUT or DTOUT) or if not queued. "RTN","BIUTL2",428,0) G:BIPOP!('$D(IO("Q"))) ZISEXIT "RTN","BIUTL2",429,0) ; "RTN","BIUTL2",430,0) I IO=IO(0) W !?5,"Cannot queue to screen or slave printer!",! G ZIS1 "RTN","BIUTL2",431,0) ; "RTN","BIUTL2",432,0) ;---> NEXT LINE: Line Label "ZISQ" added for entry where Device "RTN","BIUTL2",433,0) ;---> Info has already been adked and User queued output. "RTN","BIUTL2",434,0) ZISQ ;EP "RTN","BIUTL2",435,0) ;---> NEXT LINES: Job was queued, therefore set BIPOP=1 so that the "RTN","BIUTL2",436,0) ;---> calling routine will quit (and let Taskman finish this job). "RTN","BIUTL2",437,0) S BIPOP=1 "RTN","BIUTL2",438,0) I '$D(ZTRTN) D G ZISEXIT "RTN","BIUTL2",439,0) .W !?5,*7,"NO ROUTINE NAMED FOR QUEUEING -- CONTACT PROGRAMMER." "RTN","BIUTL2",440,0) I '$D(ZTDESC) S ZTDESC=ZTRTN "RTN","BIUTL2",441,0) S BIMES=$S($D(BIMES):BIMES,1:"W !?5,""Request Queued."",!") "RTN","BIUTL2",442,0) ; "RTN","BIUTL2",443,0) S ZTIO=$S($D(ION):ION,1:"") "RTN","BIUTL2",444,0) I ZTIO]"" D "RTN","BIUTL2",445,0) .I $D(IO("DOC")) S ZTIO=ZTIO_";"_IOST_";"_IO("DOC") Q "RTN","BIUTL2",446,0) .S ZTIO=ZTIO_";"_IOST_";"_IOM_";"_IOSL "RTN","BIUTL2",447,0) ; "RTN","BIUTL2",448,0) ;---> Uncomment next line to suppress "Requested Start Time" question. "RTN","BIUTL2",449,0) D ^%ZTLOAD,^%ZISC "RTN","BIUTL2",450,0) X:$D(ZTQUEUED) BIMES H 2 "RTN","BIUTL2",451,0) ; "RTN","BIUTL2",452,0) ZISEXIT ;EP "RTN","BIUTL2",453,0) K BIMES,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK "RTN","BIUTL2",454,0) Q "RTN","BIUTL2",455,0) ; "RTN","BIUTL2",456,0) ;---------- "RTN","BIUTL2",457,0) DFNCHECK() ;EP "RTN","BIUTL2",458,0) ;---> If BIDFN not supplied, set Error Code and quit. "RTN","BIUTL2",459,0) I '$G(BIDFN) D ERRCD^BIUTL2(201,,1) Q 1 "RTN","BIUTL2",460,0) Q 0 "RTN","BIUTL2",461,0) ; "RTN","BIUTL2",462,0) ;---------- "RTN","BIUTL2",463,0) DUZCHECK() ;EP "RTN","BIUTL2",464,0) ;---> If no BIDUZ2 (Site IEN), Set it equal to User's DUZ(2). "RTN","BIUTL2",465,0) ;---> If User's DUZ(2) fails, set Error Code and quit. "RTN","BIUTL2",466,0) S:'$G(BIDUZ2) BIDUZ2=$G(DUZ(2)) "RTN","BIUTL2",467,0) I '$G(BIDUZ2) D ERRCD^BIUTL2(105,,1) Q 1 "RTN","BIUTL2",468,0) Q 0 "RTN","BIUTL2",469,0) ; "RTN","BIUTL2",470,0) VMAX(IEN) ;EP ;MWRZZZ REMOVE? "RTN","BIUTL2",471,0) ;---> Return the Maximum Dose# for a Vaccine. "RTN","BIUTL2",472,0) ;---> Parameters: "RTN","BIUTL2",473,0) ; 1 - IEN (req) IEN of Vaccine. "RTN","BIUTL2",474,0) ; "RTN","BIUTL2",475,0) Q "" "RTN","BIUTL2",476,0) Q $P(^AUTTIMM(IEN,0),"^",5) "RTN","BIUTL3") 0^17^B106069830 "RTN","BIUTL3",1,0) BIUTL3 ;IHS/CMI/MWR - UTIL: ZTSAVE, ASKDATE, DIRZ.; MAY 10, 2010 ; 09 Jun 2025 10:51 PM [ 06/12/2025 11:12 AM ] "RTN","BIUTL3",2,0) ;;8.5;IMMUNIZATION;**21,29,30,31**;OCT 24,2011;Build 137 "RTN","BIUTL3",3,0) ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS * "RTN","BIUTL3",4,0) ;; UTILITY: SAVE ANY AND ALL BI VARIABLES FOR QUEUEING TO TASKMAN, "RTN","BIUTL3",5,0) ;; ASK DATE RANGE, DIRZ (PROMPT TO CONTINUE). "RTN","BIUTL3",6,0) ;; PATCH 2: Add more variables to save: BIDELIM, BIU19. "RTN","BIUTL3",7,0) ;; PATCH 5: Add more variables to save: BITOTPTS, BITOTFPT, BITOTMPT ZSAVES+77 "RTN","BIUTL3",8,0) ;; PATCH 21: Add "A" to DIR(0) DIRZ+19 "RTN","BIUTL3",9,0) ; "RTN","BIUTL3",10,0) ; "RTN","BIUTL3",11,0) ;---------- "RTN","BIUTL3",12,0) ZSAVES ;EP "RTN","BIUTL3",13,0) ;---> Single central calling point for saving BI local "RTN","BIUTL3",14,0) ;---> variables and arrays in ZTSAVE for queuing to Taskman. "RTN","BIUTL3",15,0) ;---> Any of the BI variables listed below, if defined, "RTN","BIUTL3",16,0) ;---> will be stored in the ZTSAVE array. "RTN","BIUTL3",17,0) ;---> To add additional variables or arrays, simply document "RTN","BIUTL3",18,0) ;---> in the list and add to appropriate FOR loop below. "RTN","BIUTL3",19,0) ; "RTN","BIUTL3",20,0) ;---> Variables: "RTN","BIUTL3",21,0) ; "RTN","BIUTL3",22,0) ; ZTSAVE (ret) Taskman array of saved variables and arrays. "RTN","BIUTL3",23,0) ; "RTN","BIUTL3",24,0) ; Single: "RTN","BIUTL3",25,0) ; ------- "RTN","BIUTL3",26,0) ; BIACT (opt) All or ACTIVE Only in Patient Errors. "RTN","BIUTL3",27,0) ; BIAG (opt) Age Range in months. "RTN","BIUTL3",28,0) ; BIAGRP (opt) Node/number for this Age Group. "RTN","BIUTL3",29,0) ; BIAGRPS (opt) Age Groups in Two-Year-Old Report. "RTN","BIUTL3",30,0) ; BIBEGDT (opt) Begin date of report. "RTN","BIUTL3",31,0) ; BICOLL (opt) Order of Lot Number listing, 1-4. "RTN","BIUTL3",32,0) ; BICPTI (opt) 1=Include CPT Coded Visits, 0=Ignore CPT (default). "RTN","BIUTL3",33,0) ; BIDAR (opt) Adolescent Report Age Range: "11-18^1" (years). "RTN","BIUTL3",34,0) ; BIDED (opt) Include Deceased Patients (0=no, 1=yes). "RTN","BIUTL3",35,0) ; BIDELIM (opt) Delimiter (1="^", 2="2 spaces"). "RTN","BIUTL3",36,0) ; BIDFN (opt) Patient's IEN in VA PATIENT File #2. "RTN","BIUTL3",37,0) ; BIDLOC (opt) Date-Location Line of letter. "RTN","BIUTL3",38,0) ; BIDLOT (opt) Display report by Lot Number (VAC). "RTN","BIUTL3",39,0) ; BIENDDT (opt) End date of report. "RTN","BIUTL3",40,0) ; BIFDT (opt) Forecast/Clinic date. "RTN","BIUTL3",41,0) ; BIFH (opt) F=report on Flu Vaccine Group, H=H1N1 group. "RTN","BIUTL3",42,0) ; BIHIST (opt) Include Historical (Vac Acct Report). "RTN","BIUTL3",43,0) ; BIHPV (opt) 1=include HepA, Pneumo & Var, 0=exclude. "RTN","BIUTL3",44,0) ; BILET (opt) IEN of Letter in BI LETTER File. "RTN","BIUTL3",45,0) ; BIMD (opt) Minimum Interval days since last letter. "RTN","BIUTL3",46,0) ; BINFO (opt) Additional Information for each patient (no longer used). "RTN","BIUTL3",47,0) ; BIORD (opt) Order of listing. "RTN","BIUTL3",48,0) ; BIPG (opt) Patient Group (see calling routine). "RTN","BIUTL3",49,0) ; BIQDT (opt) Quarter Ending Date. "RTN","BIUTL3",50,0) ; BIRDT (opt) Date Range for Received Imms (form BEGDATE:ENDDATE). "RTN","BIUTL3",51,0) ; BIRPDT (opt) Report Date in View List (if passed from reports). "RTN","BIUTL3",52,0) ; BISITE (opt) IEN of Site. "RTN","BIUTL3",53,0) ; BISUBT (opt) Subtitle String for Lot Order in BILOT. "RTN","BIUTL3",54,0) ; BITAR (opt) Two-Yr-Old Report Age Range. "RTN","BIUTL3",55,0) ; BITOTPTS(opt) Total Number of Patients. "RTN","BIUTL3",56,0) ; BITOTFPT(opt) Total Number of Female Patients. "RTN","BIUTL3",57,0) ; BITOTMPT(opt) Total Number of Male Patients. "RTN","BIUTL3",58,0) ; BIU19 (opt) Include Adults (19 yrs & over). "RTN","BIUTL3",59,0) ; BIUP (opt) User Population/Group (Registered, User, Active). "RTN","BIUTL3",60,0) ; BIVFC (opt) VFC Eligibility for Imm Visits. "RTN","BIUTL3",61,0) ; BIYEAR (opt) Report Year. "RTN","BIUTL3",62,0) ; "RTN","BIUTL3",63,0) ; Arrays: "RTN","BIUTL3",64,0) ; ------- "RTN","BIUTL3",65,0) ; BIBEN (opt) Beneficiary Type array. "RTN","BIUTL3",66,0) ; BICC (opt) Current Community array. "RTN","BIUTL3",67,0) ; BICM (opt) Case Manager array. "RTN","BIUTL3",68,0) ; BIDPRV (opt) Designated Provider array. "RTN","BIUTL3",69,0) ; BIHCF (opt) Health Care Facility array. "RTN","BIUTL3",70,0) ; BILOT (opt) Lot Number array. "RTN","BIUTL3",71,0) ; BIMMD (opt) Immunization Due array. "RTN","BIUTL3",72,0) ; BIMMR (opt) Immunization Received array. "RTN","BIUTL3",73,0) ; BIMMRF (opt) Immunization Received Filter array. "RTN","BIUTL3",74,0) ; BIMMLF (opt) Lot Number Filter array. "RTN","BIUTL3",75,0) ; BINFO (opt) Additional Information for each patient. "RTN","BIUTL3",76,0) ; BIVT (opt) Visit Type array. "RTN","BIUTL3",77,0) ; "RTN","BIUTL3",78,0) ;---> Save local variables for queueing Due List/Letters. "RTN","BIUTL3",79,0) K ZTSAVE N BISV "RTN","BIUTL3",80,0) ; "RTN","BIUTL3",81,0) F BISV="ACT","AG","AGRP","AGRPS","BEGDT","COLL","CPTI","DAR","DED","DELIM","DFN" D "RTN","BIUTL3",82,0) .S BISV="BI"_BISV "RTN","BIUTL3",83,0) .I $D(@(BISV)) S ZTSAVE(BISV)="" "RTN","BIUTL3",84,0) ; "RTN","BIUTL3",85,0) F BISV="DLOC","DLOT","ENDDT","FDT","FH","HIST","HPV","LET","MD","NFO","ORD" D "RTN","BIUTL3",86,0) .S BISV="BI"_BISV "RTN","BIUTL3",87,0) .I $D(@(BISV)) S ZTSAVE(BISV)="" "RTN","BIUTL3",88,0) ; "RTN","BIUTL3",89,0) F BISV="PG","QDT","RDT","RPDT","SITE","SUBT","T","TAR","TOTPTS","TOTFPT","TOTFMPT" D "RTN","BIUTL3",90,0) .S BISV="BI"_BISV "RTN","BIUTL3",91,0) .I $D(@(BISV)) S ZTSAVE(BISV)="" "RTN","BIUTL3",92,0) ; "RTN","BIUTL3",93,0) F BISV="U19","UP","VFC","YEAR" D "RTN","BIUTL3",94,0) .S BISV="BI"_BISV "RTN","BIUTL3",95,0) .I $D(@(BISV)) S ZTSAVE(BISV)="" "RTN","BIUTL3",96,0) ; "RTN","BIUTL3",97,0) ;---> Save local arrays for queueing Due List/Letters. "RTN","BIUTL3",98,0) F BISV="BEN","CC","CM","DPRV","HCF","LOT","MMD","MMLF","MMR","MMRF","VT" D "RTN","BIUTL3",99,0) .S BISV="BI"_BISV "RTN","BIUTL3",100,0) .D:$D(@BISV) "RTN","BIUTL3",101,0) ..N N S N=0 F S N=$O(@(BISV_"("""_N_""")")) Q:N="" D "RTN","BIUTL3",102,0) ...S ZTSAVE(BISV_"("""_N_""")")="" "RTN","BIUTL3",103,0) Q "RTN","BIUTL3",104,0) ; "RTN","BIUTL3",105,0) ; "RTN","BIUTL3",106,0) ;---------- "RTN","BIUTL3",107,0) ASKDATES(BIB,BIE,BIPOP,BIBDF,BIEDF,BISAME,BITIME) ;EP "RTN","BIUTL3",108,0) ;---> Ask date range. "RTN","BIUTL3",109,0) ;---> Parameters: "RTN","BIUTL3",110,0) ; 1 - BIB (ret) Begin Date, Fileman format. "RTN","BIUTL3",111,0) ; 2 - BIE (ret) End Date, Fileman format. "RTN","BIUTL3",112,0) ; 3 - BIPOP (ret) BIPOP=1 If quit, fail, DTOUT, DUOUT. "RTN","BIUTL3",113,0) ; 4 - BIBDF (opt) Begin Date default, Fileman format. "RTN","BIUTL3",114,0) ; 5 - BIEDF (opt) End Date default, Fileman format. "RTN","BIUTL3",115,0) ; 6 - BISAME (opt) Force End Date default=Begin Date. "RTN","BIUTL3",116,0) ; 7 - BITIME (opt) Ask times. "RTN","BIUTL3",117,0) ; "RTN","BIUTL3",118,0) ;---> Example: "RTN","BIUTL3",119,0) ; D ASKDATES^BIUTL3(.BIBEGDT,.BIENDDT,.BIPOP,"T-365","T") "RTN","BIUTL3",120,0) ; "RTN","BIUTL3",121,0) S BIPOP=0 N %DT,Y "RTN","BIUTL3",122,0) W !!," *** Date Range Selection ***" "RTN","BIUTL3",123,0) ; "RTN","BIUTL3",124,0) ;---> Begin Date. "RTN","BIUTL3",125,0) S %DT="APEX"_$S($G(BITIME):"T",1:"") "RTN","BIUTL3",126,0) S %DT("A")=" Begin with DATE: " "RTN","BIUTL3",127,0) I $G(BIBDF)]"" S Y=BIBDF D DD^%DT S %DT("B")=Y "RTN","BIUTL3",128,0) D ^%DT K %DT "RTN","BIUTL3",129,0) I Y<0 S BIPOP=1 Q "RTN","BIUTL3",130,0) ; "RTN","BIUTL3",131,0) ;---> End Date. "RTN","BIUTL3",132,0) S (%DT(0),BIB)=Y K %DT("B") "RTN","BIUTL3",133,0) S %DT="APEX"_$S($D(BITIME):"T",1:"") "RTN","BIUTL3",134,0) S %DT("A")=" End with DATE: " "RTN","BIUTL3",135,0) I $G(BIEDF)]"" S Y=BIEDF D DD^%DT S %DT("B")=Y "RTN","BIUTL3",136,0) I $D(BISAME) S Y=BIB D DD^%DT S %DT("B")=Y "RTN","BIUTL3",137,0) D ^%DT K %DT "RTN","BIUTL3",138,0) I Y<0 S BIPOP=1 Q "RTN","BIUTL3",139,0) S BIE=Y "RTN","BIUTL3",140,0) Q "RTN","BIUTL3",141,0) ; "RTN","BIUTL3",142,0) ; "RTN","BIUTL3",143,0) ;---------- "RTN","BIUTL3",144,0) DATE(BIDT,BIPOP,BIDFLT,BIPRMPT,BITIME) ;EP "RTN","BIUTL3",145,0) ;---> Ask Date. "RTN","BIUTL3",146,0) ;---> Parameters: "RTN","BIUTL3",147,0) ; 1 - BIDT (ret) Selected Date, Fileman format. "RTN","BIUTL3",148,0) ; 2 - BIPOP (ret) BIPOP=1 If quit, fail, DTOUT, DUOUT. "RTN","BIUTL3",149,0) ; 3 - BIDFLT (opt) Default, Fileman format. "RTN","BIUTL3",150,0) ; 4 - BIPRMPT (opt) Prompt. "RTN","BIUTL3",151,0) ; 5 - BITIME (opt) Ask times. "RTN","BIUTL3",152,0) ; "RTN","BIUTL3",153,0) ;---> EXAMPLE: "RTN","BIUTL3",154,0) ; D DATE^BIUTL3(.BIDT,.BIPOP,DT) "RTN","BIUTL3",155,0) ; "RTN","BIUTL3",156,0) S BIPOP=0 N %DT,Y "RTN","BIUTL3",157,0) S %DT="APEX"_$S($G(BITIME):"T",1:"") "RTN","BIUTL3",158,0) S:$G(BIPRMPT)="" BIPRMPT=" Enter DATE: " "RTN","BIUTL3",159,0) S %DT("A")=BIPRMPT "RTN","BIUTL3",160,0) I $G(BIDFLT)]"" S Y=BIDFLT D DD^%DT S %DT("B")=Y "RTN","BIUTL3",161,0) D ^%DT K %DT "RTN","BIUTL3",162,0) I Y<0 S BIPOP=1 Q "RTN","BIUTL3",163,0) S BIDT=Y "RTN","BIUTL3",164,0) Q "RTN","BIUTL3",165,0) ; "RTN","BIUTL3",166,0) ; "RTN","BIUTL3",167,0) ;---------- "RTN","BIUTL3",168,0) LOCKED ;EP "RTN","BIUTL3",169,0) D EN^DDIOL("Another user is editing this entry. Please, try again later.",,"!?5") "RTN","BIUTL3",170,0) D DIRZ() "RTN","BIUTL3",171,0) Q "RTN","BIUTL3",172,0) ; "RTN","BIUTL3",173,0) ; "RTN","BIUTL3",174,0) ;---------- "RTN","BIUTL3",175,0) DIRZ(BIPOP,BIPRMT,BIPRMT1,BIPRMT2,BIPRMTQ,BINLF) ;EP - Press RETURN to continue. "RTN","BIUTL3",176,0) ;---> Call to ^DIR, to Press RETURN to continue. "RTN","BIUTL3",177,0) ;---> Parameters: "RTN","BIUTL3",178,0) ; 1 - BIPOP (ret) BIPOP=1 if DTOUT or DUOUT "RTN","BIUTL3",179,0) ; 2 - BIPRMT (opt) Prompt other than "Press RETURN..." "RTN","BIUTL3",180,0) ; 3 - BIPRMT1 (opt) Prompt other than "Press RETURN..." "RTN","BIUTL3",181,0) ; 4 - BIPRMT2 (opt) Prompt other than "Press RETURN..." "RTN","BIUTL3",182,0) ; 5 - BIPRMTQ (opt) Response to "?" other than standard "RTN","BIUTL3",183,0) ; 6 - BINLF (opt) If BINLF=1, no linefeed before prompt. "RTN","BIUTL3",184,0) ; "RTN","BIUTL3",185,0) ;---> Example: D DIRZ^BIUTL3(.BIPOP) "RTN","BIUTL3",186,0) ; "RTN","BIUTL3",187,0) N DDS,DIR,DIRUT,X,Y,Z "RTN","BIUTL3",188,0) D "RTN","BIUTL3",189,0) .I $G(BIPRMT)="" D Q "RTN","BIUTL3",190,0) ..S DIR("A")=" Press ENTER/RETURN to continue or ""^"" to exit" "RTN","BIUTL3",191,0) .S DIR("A")=BIPRMT "RTN","BIUTL3",192,0) .I $G(BIPRMT1)]"" S DIR("A",1)=BIPRMT1 "RTN","BIUTL3",193,0) .I $G(BIPRMT2)]"" S DIR("A",2)=BIPRMT2 "RTN","BIUTL3",194,0) I $G(BIPRMTQ)]"" S DIR("?")=BIPRMTQ "RTN","BIUTL3",195,0) ;********** PATCH 21, v8.5, APR 01,2021, IHS/CMI/MWR "RTN","BIUTL3",196,0) ;---> Add "A" to DIR(0) so that nothing is added to the prompt, if supplied. "RTN","BIUTL3",197,0) ;---> Also add "no linefeed" option. "RTN","BIUTL3",198,0) W:('$G(BINLF)=1) ! "RTN","BIUTL3",199,0) S DIR(0)="EA" "RTN","BIUTL3",200,0) D ^DIR W ! "RTN","BIUTL3",201,0) S BIPOP=$S($D(DIRUT):1,Y<1:1,1:0) "RTN","BIUTL3",202,0) Q "RTN","BIUTL3",203,0) ; "RTN","BIUTL3",204,0) ; "RTN","BIUTL3",205,0) ;---------- "RTN","BIUTL3",206,0) NOW1 ;EP "RTN","BIUTL3",207,0) ;---> S BITTTS=Start time. "RTN","BIUTL3",208,0) N %,Y,X D NOW^%DTC S BITTTS=% "RTN","BIUTL3",209,0) Q "RTN","BIUTL3",210,0) ; "RTN","BIUTL3",211,0) ; "RTN","BIUTL3",212,0) ;---------- "RTN","BIUTL3",213,0) NOW2 ;EP "RTN","BIUTL3",214,0) ;---> S BITTTE=End time. "RTN","BIUTL3",215,0) N %,Y,X D NOW^%DTC S BITTTE=% "RTN","BIUTL3",216,0) ; "RTN","BIUTL3",217,0) ;---> Compare times. "RTN","BIUTL3",218,0) S Y=BITTTE X ^DD("DD") W !!?5,"End : ",$P(Y,"@",2) "RTN","BIUTL3",219,0) S Y=BITTTS X ^DD("DD") W !?5,"Begin: ",$P(Y,"@",2) "RTN","BIUTL3",220,0) D DIRZ() "RTN","BIUTL3",221,0) K BITTTE,BITTTS "RTN","BIUTL3",222,0) Q "RTN","BIUTL3",223,0) VARR ;EP;TO CREATE VACCINE CVX ARRAYS FOR IMM/DUE EVALUATION "RTN","BIUTL3",224,0) ;V8.5 PATCH 29 - FID-107546 Adjust Td,NOS forecast "RTN","BIUTL3",225,0) K VARR "RTN","BIUTL3",226,0) N X,Y,Z,CVX,NAM,GRP "RTN","BIUTL3",227,0) S X=0 "RTN","BIUTL3",228,0) F S X=$O(^AUTTIMM(X)) Q:'X S Y=^(X,0) D V1 "RTN","BIUTL3",229,0) Q "RTN","BIUTL3",230,0) ;===== "RTN","BIUTL3",231,0) ; "RTN","BIUTL3",232,0) V1 ;EVAL EACH VACCINE "RTN","BIUTL3",233,0) S NAM=$P(Y,U,1,9) "RTN","BIUTL3",234,0) S CVX=+$P(Y,U,3) "RTN","BIUTL3",235,0) S GRP=+$P(Y,U,9) "RTN","BIUTL3",236,0) I NAM["COV" D "RTN","BIUTL3",237,0) .S ^BIVARR("COV",CVX,GRP,X)=NAM "RTN","BIUTL3",238,0) .S ^BIVARR("GRP",GRP,CVX,"COV",X)=NAM "RTN","BIUTL3",239,0) .S:NAM["NOS" ^BIVARR("COV","NOS",CVX,GRP,X)=NAM "RTN","BIUTL3",240,0) I NAM["DT"!(NAM["Td") D "RTN","BIUTL3",241,0) .I NAM'["Td",NAM'["ADULT" D "RTN","BIUTL3",242,0) ..S ^BIVARR("DT",CVX,GRP,X)=NAM "RTN","BIUTL3",243,0) ..S ^BIVARR("GRP",GRP,CVX,"DT",X)=NAM "RTN","BIUTL3",244,0) ..S:NAM["NOS" ^BIVARR("DT","NOS",CVX,GRP,X)=NAM "RTN","BIUTL3",245,0) .I NAM["Td",NAM'["Tdap" D "RTN","BIUTL3",246,0) ..S ^BIVARR("TD",CVX,GRP,X)=NAM "RTN","BIUTL3",247,0) ..S ^BIVARR("GRP",GRP,CVX,"TD",X)=NAM "RTN","BIUTL3",248,0) ..S:NAM["NOS" ^BIVARR("TD","NOS",CVX,GRP,X)=NAM "RTN","BIUTL3",249,0) .I NAM["Tdap" D "RTN","BIUTL3",250,0) ..S ^BIVARR("TDAP",CVX,GRP,X)=NAM "RTN","BIUTL3",251,0) ..S ^BIVARR("GRP",GRP,CVX,"TDAP",X)=NAM "RTN","BIUTL3",252,0) ..S:NAM["NOS" ^BIVARR("TDAP","NOS",CVX,GRP,X)=NAM "RTN","BIUTL3",253,0) I NAM["HEP A"!(NAM["Hep A")!(NAM["HepA") D "RTN","BIUTL3",254,0) .S ^BIVARR("HEP A",CVX,GRP,X)=NAM "RTN","BIUTL3",255,0) .S ^BIVARR("GRP",GRP,CVX,"HEP A",X)=NAM "RTN","BIUTL3",256,0) .S:NAM["NOS" ^BIVARR("HEP A","NOS",CVX,GRP,X)=NAM "RTN","BIUTL3",257,0) I NAM["HEP B"!(NAM["Hep B")!(NAM["HepB") D "RTN","BIUTL3",258,0) .S ^BIVARR("HEP B",CVX,GRP,X)=NAM "RTN","BIUTL3",259,0) .S ^BIVARR("GRP",GRP,CVX,"HEP B",X)=NAM "RTN","BIUTL3",260,0) .S:NAM["NOS" ^BIVARR("HEP B","NOS",CVX,GRP,X)=NAM "RTN","BIUTL3",261,0) I NAM["HIB" D "RTN","BIUTL3",262,0) .S ^BIVARR("HIB",CVX,GRP,X)=NAM "RTN","BIUTL3",263,0) .S ^BIVARR("GRP",GRP,CVX,"HIB",X)=NAM "RTN","BIUTL3",264,0) .S:NAM["NOS" ^BIVARR("HIB","NOS",CVX,GRP,X)=NAM "RTN","BIUTL3",265,0) I NAM["HPV" D "RTN","BIUTL3",266,0) .S ^BIVARR("HPV",CVX,GRP,X)=NAM "RTN","BIUTL3",267,0) .S ^BIVARR("GRP",GRP,CVX,"HPV",X)=NAM "RTN","BIUTL3",268,0) .S:NAM["NOS" ^BIVARR("HPV","NOS",CVX,GRP,X)=NAM "RTN","BIUTL3",269,0) I NAM["INFLU"!(NAM["Influ")!(NAM["influ")!(NAM["H1N1") D "RTN","BIUTL3",270,0) .S ^BIVARR("INFLU",CVX,GRP,X)=NAM "RTN","BIUTL3",271,0) .S ^BIVARR("GRP",GRP,CVX,"INFLU",X)=NAM "RTN","BIUTL3",272,0) .S:NAM["NOS" ^BIVARR("INFLU","NOS",CVX,GRP,X)=NAM "RTN","BIUTL3",273,0) I NAM["H1N1" D "RTN","BIUTL3",274,0) .S ^BIVARR("H1N1",CVX,GRP,X)=NAM "RTN","BIUTL3",275,0) .S ^BIVARR("GRP",GRP,CVX,"H1N1",X)=NAM "RTN","BIUTL3",276,0) .S:NAM["NOS" ^BIVARR("H1N1","NOS",CVX,GRP,X)=NAM "RTN","BIUTL3",277,0) I NAM["IPV"!(NAM["OPV")!(NAM["POLIO") D "RTN","BIUTL3",278,0) .S ^BIVARR("POLIO",CVX,GRP,X)=NAM "RTN","BIUTL3",279,0) .S ^BIVARR("GRP",GRP,CVX,"POLIO",X)=NAM "RTN","BIUTL3",280,0) .S:NAM["NOS" ^BIVARR("POLIO","NOS",CVX,GRP,X)=NAM "RTN","BIUTL3",281,0) I NAM["MEN"!(NAM["Meni") D "RTN","BIUTL3",282,0) .S ^BIVARR("MEN",CVX,GRP,X)=NAM "RTN","BIUTL3",283,0) .S ^BIVARR("GRP",GRP,CVX,"MEN",X)=NAM "RTN","BIUTL3",284,0) .S:NAM["NOS" ^BIVARR("MEN","NOS",CVX,GRP,X)=NAM "RTN","BIUTL3",285,0) .D:NAM["Men-A" "RTN","BIUTL3",286,0) ..S ^BIVARR("MEN-A",CVX,GRP,X)=NAM "RTN","BIUTL3",287,0) ..S ^BIVARR("GRP",GRP,CVX,"MEN-A",X)=NAM "RTN","BIUTL3",288,0) ..S:NAM["NOS" ^BIVARR("MEN-A","NOS",CVX,GRP,X)=NAM "RTN","BIUTL3",289,0) .D:NAM["Men-B"!(NAM["Men B")!(NAM["Group B,") "RTN","BIUTL3",290,0) ..S ^BIVARR("MEN-B",CVX,GRP,X)=NAM "RTN","BIUTL3",291,0) ..S ^BIVARR("GRP",GRP,CVX,"MEN-B",X)=NAM "RTN","BIUTL3",292,0) ..S:NAM["NOS" ^BIVARR("MEN-B","NOS",CVX,GRP,X)=NAM "RTN","BIUTL3",293,0) I NAM["MM"!(NAM["VARI")!(NAM["MEAS") D "RTN","BIUTL3",294,0) .S ^BIVARR("MMRV",CVX,GRP,X)=NAM "RTN","BIUTL3",295,0) .S ^BIVARR("GRP",GRP,CVX,"MMRV",X)=NAM "RTN","BIUTL3",296,0) .S:NAM["NOS" ^BIVARR("MMRV","NOS",CVX,GRP,X)=NAM "RTN","BIUTL3",297,0) I NAM["PNEU"!(NAM["Pneu") D "RTN","BIUTL3",298,0) .S ^BIVARR("PNEU",CVX,GRP,X)=NAM "RTN","BIUTL3",299,0) .S ^BIVARR("GRP",GRP,CVX,"PNEU",X)=NAM "RTN","BIUTL3",300,0) .S:NAM["NOS" ^BIVARR("PNEU","NOS",CVX,GRP,X)=NAM "RTN","BIUTL3",301,0) I NAM["ROTA" D "RTN","BIUTL3",302,0) .S ^BIVARR("ROTA",CVX,GRP,X)=NAM "RTN","BIUTL3",303,0) .S ^BIVARR("GRP",GRP,CVX,"ROTA",X)=NAM "RTN","BIUTL3",304,0) .S:NAM["NOS" ^BIVARR("ROTA","NOS",CVX,GRP,X)=NAM "RTN","BIUTL3",305,0) I NAM["RSV" D "RTN","BIUTL3",306,0) .S ^BIVARR("RSV",CVX,GRP,X)=NAM "RTN","BIUTL3",307,0) .S ^BIVARR("GRP",GRP,CVX,"RSV",X)=NAM "RTN","BIUTL3",308,0) .S:NAM["NOS" ^BIVARR("RSV","NOS",CVX,GRP,X)=NAM "RTN","BIUTL3",309,0) I NAM["ZOS"!(NAM["Zos") D "RTN","BIUTL3",310,0) .S ^BIVARR("ZOS",CVX,GRP,X)=NAM "RTN","BIUTL3",311,0) .S ^BIVARR("GRP",GRP,CVX,"ZOS",X)=NAM "RTN","BIUTL3",312,0) .S:NAM["NOS" ^BIVARR("ZOS","NOS",CVX,GRP,X)=NAM "RTN","BIUTL3",313,0) I NAM'["COV",NAM'["DT",NAM'["Td",NAM'["HEP A",NAM'["Hep A",NAM'["HepA",NAM'["HEP B",NAM'["Hep B",NAM'["HepB",NAM'["HIB",NAM'["HPV",NAM'["INFLU",NAM'["Influ",NAM'["influ",NAM'["H1N1" D "RTN","BIUTL3",314,0) .I NAM'["H1N1",NAM'["IPV",NAM'["OPV",NAM'["POLIO",NAM'["MEN",NAM'["Meni",NAM'["MM",NAM'["VARI",NAM'["MEAS",NAM'["PNEU",NAM'["Pneu",NAM'["ROTA",NAM'["RSV",NAM'["ZOS",NAM'["Zos" D "RTN","BIUTL3",315,0) ..S ^BIVARR("IEN",X,CVX,GRP)=NAM "RTN","BIUTL3",316,0) Q "RTN","BIUTL3",317,0) Q "RTN","BIUTL3",318,0) ;===== "RTN","BIUTL3",319,0) ; "RTN","BIUTL3",320,0) GR ;FIND PATIENT WITH GREATER THAN IMMUNIZATIONS "RTN","BIUTL3",321,0) K ^BITMP("GR") "RTN","BIUTL3",322,0) S K=0 "RTN","BIUTL3",323,0) S QUIT=0 "RTN","BIUTL3",324,0) ;F GR=70,60,50 Q:QUIT D GR1 "RTN","BIUTL3",325,0) D GR1 "RTN","BIUTL3",326,0) D SHOW "RTN","BIUTL3",327,0) D PAUSE^BYIMIMM6 "RTN","BIUTL3",328,0) Q "RTN","BIUTL3",329,0) ;===== "RTN","BIUTL3",330,0) ; "RTN","BIUTL3",331,0) GR1 ; "RTN","BIUTL3",332,0) S DFN=9999999999 "RTN","BIUTL3",333,0) F S DFN=$O(^AUPNVIMM("AC",DFN),-1) Q:'DFN!QUIT D "RTN","BIUTL3",334,0) .S (J,IDA)=0 "RTN","BIUTL3",335,0) .F S IDA=$O(^AUPNVIMM("AC",DFN,IDA)) Q:'IDA!QUIT D "RTN","BIUTL3",336,0) ..S J=J+1 "RTN","BIUTL3",337,0) ..Q:J<71 "RTN","BIUTL3",338,0) ..S:'$D(^BITMP("GR",DFN)) K=K+1 "RTN","BIUTL3",339,0) ..S ^BITMP("GR",DFN)=J "RTN","BIUTL3",340,0) ..S:K>19 QUIT=1 "RTN","BIUTL3",341,0) Q "RTN","BIUTL3",342,0) ;===== "RTN","BIUTL3",343,0) ; "RTN","BIUTL3",344,0) PCNT(DFN) ;COUNT PATIENT'S IMMUNIZATIONS "RTN","BIUTL3",345,0) N CNT,X "RTN","BIUTL3",346,0) S CNT=0 "RTN","BIUTL3",347,0) S X=0 "RTN","BIUTL3",348,0) F S X=$O(^AUPNVIMM("AC",DFN,X)) Q:'X S CNT=CNT+1 "RTN","BIUTL3",349,0) Q CNT "RTN","BIUTL3",350,0) ;===== "RTN","BIUTL3",351,0) ; "RTN","BIUTL3",352,0) SHOW ;SHOW PTS WITH >70 IMMUNIZATIONS "RTN","BIUTL3",353,0) N NAM,DFN "RTN","BIUTL3",354,0) W @IOF "RTN","BIUTL3",355,0) W !?5,"Patients with greater than 70 immunizations" "RTN","BIUTL3",356,0) W !?5,"-------------------------------------------" "RTN","BIUTL3",357,0) W !!?35,"No. of" "RTN","BIUTL3",358,0) W !?5,"NAME",?35,"Imms" "RTN","BIUTL3",359,0) W !?5,"---------------------------- -----" "RTN","BIUTL3",360,0) N X,Y,Z,DFN "RTN","BIUTL3",361,0) S DFN=0 "RTN","BIUTL3",362,0) F S DFN=$O(^BITMP("GR",DFN)) Q:'DFN D "RTN","BIUTL3",363,0) .S NAM=$P($G(^DPT(DFN,0)),U) "RTN","BIUTL3",364,0) .S NAM(NAM)=DFN "RTN","BIUTL3",365,0) S NAM="" "RTN","BIUTL3",366,0) F S NAM=$O(NAM(NAM)) Q:NAM="" D "RTN","BIUTL3",367,0) .S DFN=NAM(NAM) "RTN","BIUTL3",368,0) .S CNT=$$PCNT(DFN) "RTN","BIUTL3",369,0) .W !?5,NAM,?35,CNT "RTN","BIUTL3",370,0) Q "RTN","BIUTL3",371,0) ;===== "RTN","BIUTL3",372,0) END ; "RTN","BIVWXICE") 0^38^B77066783 "RTN","BIVWXICE",1,0) BIVWXICE ;IHS/CMI/MWR - CALL TO ICE FORECASTER; JUL 01, 2019 [ 06/30/2025 3:01 PM ] ; 27 Aug 2025 11:17 PM "RTN","BIVWXICE",2,0) ;;8.5;IMMUNIZATION;**24,26,29,30,31**;OCT 24,2011;Build 137 "RTN","BIVWXICE",3,0) ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS * "RTN","BIVWXICE",4,0) ;; CALL TO ICE FORCASTING IMMUNIZATIONS. "RTN","BIVWXICE",5,0) ;; Called from ^BIPATUP. "RTN","BIVWXICE",6,0) ;; PATCH 24: Update BIDFN. run+56 "RTN","BIVWXICE",7,0) ;; PATCH 26: Set Supp Text Forecast "RTN","BIVWXICE",8,0) ;; PATCH 31: RZV vacc evaluation "RTN","BIVWXICE",9,0) ;; "RTN","BIVWXICE",10,0) ;---------- "RTN","BIVWXICE",11,0) RUN(BIDFN,BIFDT,BIDUZ2,BINF,BICT,BIFORC,BIPROF,BINORP,BIERR) ;EP "RTN","BIVWXICE",12,0) ;---> Entry point to call ICE Forecaster. "RTN","BIVWXICE",13,0) ;---> Parameters: "RTN","BIVWXICE",14,0) ; 1 - BIDFN (req) Patient's IEN (DFN) "RTN","BIVWXICE",15,0) ; 2 - BIFDT (opt) Forecast Date. "RTN","BIVWXICE",16,0) ; 3 - BIDUZ2 (opt) User's DUZ(2) for site parameters. "RTN","BIVWXICE",17,0) ; 4 - BINF (opt) Array of Vaccine Grp IEN'S that should not be forecast. "RTN","BIVWXICE",18,0) ; 5 - BICT (opt) Array of patient's contraindications BICT(CVX) "RTN","BIVWXICE",19,0) ; 6 - BIFORC (ret) String containing Patient's Imms Due. "RTN","BIVWXICE",20,0) ; 7 - BIPROF (ret) String containing text of Patient's Imm Report. "RTN","BIVWXICE",21,0) ; 8 - BINORP (opt) 1=Do not produce Report/Profile. "RTN","BIVWXICE",22,0) ; 9 - BIERR (ret) String containing text of the error. "RTN","BIVWXICE",23,0) ; "RTN","BIVWXICE",24,0) ;---> Returned: Vaccine Group Code^Earliest Date^Recommended Date^Overdue Date "RTN","BIVWXICE",25,0) ; "RTN","BIVWXICE",26,0) I '$G(BIDFN) D ERRCD^BIUTL2(301,.BIERR) Q "RTN","BIVWXICE",27,0) I '$D(^DPT(BIDFN,0)) D ERRCD^BIUTL2(301,.BIERR) Q "RTN","BIVWXICE",28,0) S:('$G(BIFDT)) BIFDT=DT "RTN","BIVWXICE",29,0) S:'$G(BIDUZ2) BIDUZ2=$G(DUZ(2)) "RTN","BIVWXICE",30,0) ; "RTN","BIVWXICE",31,0) ;---> Check for precise Date of Birth. "RTN","BIVWXICE",32,0) N X S X=$$DOB^BIUTL1(BIDFN) "RTN","BIVWXICE",33,0) I ('$E(X,1,3))!('$E(X,4,5))!('$E(X,6,7)) D ERRCD^BIUTL2(215,.BIERR) Q "RTN","BIVWXICE",34,0) ; "RTN","BIVWXICE",35,0) ;---> Call to the ICE forecaster. "RTN","BIVWXICE",36,0) ; "RTN","BIVWXICE",37,0) N DIQUIET "RTN","BIVWXICE",38,0) N BIEXEC,BIF,BIFF,BIH,BIPARMS,BIXMLV "RTN","BIVWXICE",39,0) ;---> From VA: ; MSC/DKA Make background jobs quiet, foreground verbose "RTN","BIVWXICE",40,0) S BIEXEC="S:'($D(DIQUIET)#10) DIQUIET='($ZJ#2)" X BIEXEC "RTN","BIVWXICE",41,0) S BIPARMS("format")="simple" "RTN","BIVWXICE",42,0) S BIPARMS("patientId")=BIDFN "RTN","BIVWXICE",43,0) ; "RTN","BIVWXICE",44,0) ;---> Check that BI Site Parameters for ICE are set. "RTN","BIVWXICE",45,0) N X,Y,Z S X=$G(^BISITE(BIDUZ2,3)) "RTN","BIVWXICE",46,0) S Y=0 F Z=1:1:5 I $P(X,U,Z)="" S Y=1 "RTN","BIVWXICE",47,0) I Y D ERRCD^BIUTL2(126,.BIERR) Q "RTN","BIVWXICE",48,0) ; "RTN","BIVWXICE",49,0) ;---> Set local url parameters. "RTN","BIVWXICE",50,0) S BIPARMS("url")=$P(X,U)_"://"_$P(X,U,2)_":"_$P(X,U,3)_"/"_$P(X,U,4)_"/"_$P(X,U,5) "RTN","BIVWXICE",51,0) S BIPARMS("ip")=$P(X,U,2) "RTN","BIVWXICE",52,0) S BIPARMS("port")=$P(X,U,5) "RTN","BIVWXICE",53,0) ; "RTN","BIVWXICE",54,0) N WRK,C0IEVAL "RTN","BIVWXICE",55,0) ;---> Create the VMR to be passed to ICE. "RTN","BIVWXICE",56,0) D EN^BIVWVMR(.WRK,BIDFN,.BIPARMS,.C0IEVAL) "RTN","BIVWXICE",57,0) N ICEIN "RTN","BIVWXICE",58,0) S ICEIN=$NA(^TMP("BI_C0IWRK",$J)) "RTN","BIVWXICE",59,0) K @ICEIN "RTN","BIVWXICE",60,0) M @ICEIN=WRK "RTN","BIVWXICE",61,0) ;---------------> LOOK AT THE ABOVE ARRAY & GLOBAL. NECESSARY??? "RTN","BIVWXICE",62,0) ; "RTN","BIVWXICE",63,0) ;---> If BITEST, write the ICE Output XML to a host file. "RTN","BIVWXICE",64,0) I $G(BITEST)=1 D "RTN","BIVWXICE",65,0) .N BID,OK,IOT "RTN","BIVWXICE",66,0) .S BID=$$FMDTOUTC^BIVWUTIL($$NOW^XLFDT) "RTN","BIVWXICE",67,0) .; "RTN","BIVWXICE",68,0) .;********** PATCH 23, v8.5, OCT 24,2011, IHS/CMI/MWR "RTN","BIVWXICE",69,0) .S OK=$$GTF^%ZISH($NA(^TMP("BI_C0IWRK",$J,1)),3,$$DEFDIR^%ZISH,BID_"ice-test"_BIDFN_".xml") "RTN","BIVWXICE",70,0) ; "RTN","BIVWXICE",71,0) S BIPARMS("payload")=ICEIN "RTN","BIVWXICE",72,0) ; "RTN","BIVWXICE",73,0) ;---> BIERRN=BIERR Number in BI TABLE ERROR CODE File. "RTN","BIVWXICE",74,0) ;---> Actual call to ICE Forecaster: "RTN","BIVWXICE",75,0) N BIERRN "RTN","BIVWXICE",76,0) D SOAP^BIVWSOAP(BIFDT,.RETURN,.BIPARMS,,.BIH,.BIF,.BIXMLV,.BIERRN) "RTN","BIVWXICE",77,0) I $G(BIERRN) D ERRCD^BIUTL2(BIERRN,.BIERR) Q "RTN","BIVWXICE",78,0) ; "RTN","BIVWXICE",79,0) D FORECAST(BIDFN,BIFDT,BIDUZ2,.BICT,.BIF,.BIFORC,.BIFF,.BIH) "RTN","BIVWXICE",80,0) ;W !!,BIFORC,! R ZZZ "RTN","BIVWXICE",81,0) ; "RTN","BIVWXICE",82,0) Q:$G(BINORP) "RTN","BIVWXICE",83,0) ; "RTN","BIVWXICE",84,0) D REPORT^BIPATUP2(BIDFN,BIFDT,BIDUZ2,.BINF,.BICT,.BIH,.BIFF,BIXMLV,.BIPROF) "RTN","BIVWXICE",85,0) ;W !!,BIPROF,! R ZZZ "RTN","BIVWXICE",86,0) ; "RTN","BIVWXICE",87,0) Q "RTN","BIVWXICE",88,0) ; "RTN","BIVWXICE",89,0) ; "RTN","BIVWXICE",90,0) FORECAST(BIDFN,BIFDT,BIDUZ2,BICT,BIF,BIFORC,BIFF,BIH) ;EP "RTN","BIVWXICE",91,0) ;---> Format forecast data to match TCH. "RTN","BIVWXICE",92,0) ;---> Parameters: "RTN","BIVWXICE",93,0) ; 1 - BIDFN (req) Patient's IEN (DFN) "RTN","BIVWXICE",94,0) ; 2 - BIFDT (req) Forecast Date (date used for forecast). "RTN","BIVWXICE",95,0) ; 3 - BIDUZ2 (req) User's DUZ(2) indicating site parameters. "RTN","BIVWXICE",96,0) ; 4 - BICT (opt) Array of patient's contraindications BICT(CVX) "RTN","BIVWXICE",97,0) ; 5 - BIF (req) Patient Imm Forecast array from ICE. "RTN","BIVWXICE",98,0) ; 6 - BIFORC (ret) String containing Patient's Imms Due in TCH format. "RTN","BIVWXICE",99,0) ; 7 - BIFF (ret) Patient Imm Forecast collated by Volume Group BIFF(VG,CVX). "RTN","BIVWXICE",100,0) ; 8 - BIH (req) Patient Imm History Evaluation from ICE. "RTN","BIVWXICE",101,0) ; "RTN","BIVWXICE",102,0) ;---> Get BIAGE in YRS, MTH, DYS "RTN","BIVWXICE",103,0) N BIAGE,BIYRS,BIMTH,BIDYS "RTN","BIVWXICE",104,0) S BIAGE=$$AGE^BIUTL1(BIDFN,3,BIFDT) "RTN","BIVWXICE",105,0) S BIYRS=+BIAGE "RTN","BIVWXICE",106,0) S BIMTH=$P(BIAGE,U,2) "RTN","BIVWXICE",107,0) S BIDYS=$P(BIAGE,U,3) "RTN","BIVWXICE",108,0) ; "RTN","BIVWXICE",109,0) ;---> First reprocess Forecast to provide CVX and Volume Group, by VG Order. "RTN","BIVWXICE",110,0) N I S I=0 "RTN","BIVWXICE",111,0) F S I=$O(BIF(I)) Q:'I D "RTN","BIVWXICE",112,0) .N BICVX,BIVG,BIVGO,Y "RTN","BIVWXICE",113,0) .S Y=BIF(I) "RTN","BIVWXICE",114,0) .;---> Set 1st piece=CVX (use VMR Volume Group if necessary). "RTN","BIVWXICE",115,0) .S BICVX=$S($P(Y,U,2):$P(Y,U),1:$$VMRVG^BIUTL2($P(Y,U))) "RTN","BIVWXICE",116,0) .; "RTN","BIVWXICE",117,0) .;---> Get Volume Group Order. "RTN","BIVWXICE",118,0) .S BIVG=$$HL7TX^BIUTL2(BICVX,1),BIVGO=$$VGROUP^BIUTL2(BIVG,4) "RTN","BIVWXICE",119,0) .;V8.5 P31 - FID-98855 quit if RZV complete/not due "RTN","BIVWXICE",120,0) .I BIVGO=87,BIYRS>18,BIYRS<50,$$RZVCOMP^BIPATUP4(BIDFN) Q "RTN","BIVWXICE",121,0) .S BIFF(BIVGO,BICVX)=BICVX_U_$P(BIF(I),U,3,7) "RTN","BIVWXICE",122,0) .;20230209 76219 p26 maw added for supplemental text "RTN","BIVWXICE",123,0) .I $G(BIF(I,"SUPP"))]"" D "RTN","BIVWXICE",124,0) .. S BIFF(BIVGO,BICVX,"SUPP")=$G(BIF(I,"SUPP")) "RTN","BIVWXICE",125,0) .;20230209 end of mods "RTN","BIVWXICE",126,0) .; "RTN","BIVWXICE",127,0) .; "RTN","BIVWXICE",128,0) .;---> Put 6-wk doses in "RECOMMENDED^DUE_NOW" group. At 2 mths ICE can takeover. "RTN","BIVWXICE",129,0) .;---> Duplicated at DDUE2+17^BIPATUP1. "RTN","BIVWXICE",130,0) .I (BIDYS>41)&(BIDYS<66) D "RTN","BIVWXICE",131,0) ..N G "RTN","BIVWXICE",132,0) ..S G=$$HL7TX^BIUTL2(BICVX,1) "RTN","BIVWXICE",133,0) ..Q:((G'=1)&(G'=2)&(G'=3)&(G'=11)&(G'=15)) "RTN","BIVWXICE",134,0) ..S $P(BIFF(BIVGO,BICVX),U,5,6)="RECOMMENDED^DUE_NOW" "RTN","BIVWXICE",135,0) .; "RTN","BIVWXICE",136,0) .;********** PATCH 20, v8.5, NOV 01,2020, IHS/CMI/MWR "RTN","BIVWXICE",137,0) .;---> Fix so that 5th DTaP is not changed to DUE NOW. "RTN","BIVWXICE",138,0) .;---> Put 4th DTaP at 12mths in "RECOMMENDED^DUE_NOW" group. "RTN","BIVWXICE",139,0) .;---> Duplicated at DDUE2+37^BIPATUP1. "RTN","BIVWXICE",140,0) .;I BICVX=107,(BIDYS>364) D "RTN","BIVWXICE",141,0) .;V8.5 PATCH 29 - FID- "RTN","BIVWXICE",142,0) .I BICVX=107,BIDYS>364 D "RTN","BIVWXICE",143,0) ..N C,N,Z "RTN","BIVWXICE",144,0) ..S (C,N,Z)=0 "RTN","BIVWXICE",145,0) ..F S N=$O(BIH(N)) Q:'N D "RTN","BIVWXICE",146,0) ...N P S P=0 "RTN","BIVWXICE",147,0) ...F S P=$O(BIH(N,P)) Q:'P D "RTN","BIVWXICE",148,0) ....N Y S Y=$G(BIH(N,P)) "RTN","BIVWXICE",149,0) ....N I,M S M=+$P(Y,U) "RTN","BIVWXICE",150,0) ....;F I=1,20,22,28,50,102,106,107,110,120,130,132,146,170,195,198 I M=I D Q "RTN","BIVWXICE",151,0) ....D:$D(^BIVARR("DT-PEDS",M)) "RTN","BIVWXICE",152,0) .....;---> If any DTaP dose is Invalid, STOP--do not intervene (Z=1), too complex. "RTN","BIVWXICE",153,0) .....I $P(Y,U,3)'="VALID" S Z=1 Q "RTN","BIVWXICE",154,0) .....S C=C+1 "RTN","BIVWXICE",155,0) ..;W !,C R ZZZ "RTN","BIVWXICE",156,0) ..;---> Quit if already received 4 valid doses. "RTN","BIVWXICE",157,0) ..Q:(C=4) "RTN","BIVWXICE",158,0) ..;---> If this is the 4th dose, and no previous dose was Invalid, and Min is not "RTN","BIVWXICE",159,0) ..;---> after the forecast date, then force Due Now. "RTN","BIVWXICE",160,0) ..I Z=0,C=3,($P(BIFF(BIVGO,BICVX),U,2)'>(BIFDT+17000000)) D "RTN","BIVWXICE",161,0) ...S $P(BIFF(BIVGO,BICVX),U,5,6)="RECOMMENDED^DUE_NOW" "RTN","BIVWXICE",162,0) .; "RTN","BIVWXICE",163,0) .;V8.5 P31 - FID-98855 set RZV due now if pt immune comp and no RZV "RTN","BIVWXICE",164,0) .; "RTN","BIVWXICE",165,0) .;********** "RTN","BIVWXICE",166,0) .; "RTN","BIVWXICE",167,0) .;---> If this CVX is contraindicated, set the 7th pc=1. "RTN","BIVWXICE",168,0) .I $D(BICT(BICVX)) S $P(BIFF(BIVGO,BICVX),U,7)=1 "RTN","BIVWXICE",169,0) ; "RTN","BIVWXICE",170,0) ;ZW BIFF R ZZZ "RTN","BIVWXICE",171,0) ;---> Now build TCH/ICE total forecast string. "RTN","BIVWXICE",172,0) ; "RTN","BIVWXICE",173,0) S $P(BIFORC,"^",9)=$$NAME^BIUTL1(BIDFN,0)_" Chart #"_$$HRCN^BIUTL1(BIDFN)_"^"_BIDFN "RTN","BIVWXICE",174,0) S BIFORC=BIFORC_"~~~~~~" "RTN","BIVWXICE",175,0) ; "RTN","BIVWXICE",176,0) N I S I="" "RTN","BIVWXICE",177,0) F S I=$O(BIFF(I)) Q:(I="") D "RTN","BIVWXICE",178,0) .N J S J=0 "RTN","BIVWXICE",179,0) .F S J=$O(BIFF(I,J)) Q:'J D "RTN","BIVWXICE",180,0) ..N BICODE,BITYPE,BIDATR,BIDATO,BIDATM,BISTATUS,BIREASON,BIDOSE,BIOVRD,Y "RTN","BIVWXICE",181,0) ..S Y=BIFF(I,J) "RTN","BIVWXICE",182,0) ..;W !,Y R ZZZ "RTN","BIVWXICE",183,0) ..Q:($P(Y,U,5)="NOT_RECOMMENDED") "RTN","BIVWXICE",184,0) ..Q:($P(Y,U,5)="CONDITIONAL") "RTN","BIVWXICE",185,0) ..;---> Quit if contraindicated. "RTN","BIVWXICE",186,0) ..Q:$P(Y,U,7) "RTN","BIVWXICE",187,0) ..; "RTN","BIVWXICE",188,0) ..;---> Start with CVX, concat dates below. "RTN","BIVWXICE",189,0) ..S BIDOSE=($P(Y,U)) "RTN","BIVWXICE",190,0) ..; "RTN","BIVWXICE",191,0) ..;---> Get Min, Rec, and Overdue Dates. "RTN","BIVWXICE",192,0) ..S BIDATM=$P(Y,U,2),BIDATR=$P(Y,U,3),BIDATO=$P(Y,U,4) "RTN","BIVWXICE",193,0) ..; "RTN","BIVWXICE",194,0) ..; "RTN","BIVWXICE",195,0) ..;********** PATCH 20, v8.5, NOV 01,2020, IHS/CMI/MWR "RTN","BIVWXICE",196,0) ..;---> For iCare: If Overdue date is null, ignore it. "RTN","BIVWXICE",197,0) ..;---> If Overdue is before the Forecast Date, set Overdue indicator=1. "RTN","BIVWXICE",198,0) ..;S BIOVRD=$S($$TCHFMDT^BIUTL5(BIDATO) To avoid undef below at ENTRY1+32. "RTN","BIVWXICE",219,0) S LINEBUF="" "RTN","BIVWXICE",220,0) ; "RTN","BIVWXICE",221,0) S PAGE=$G(PAGE,"/") I PAGE="" S PAGE="/" "RTN","BIVWXICE",222,0) S HTTPTYPE=$G(HTTPTYPE,"GET") "RTN","BIVWXICE",223,0) S DATA=$G(DATA),PORT=$G(PORT,80) "RTN","BIVWXICE",224,0) D SAVDEV^%ZISUTL("XUSBSE") ;S IO(0)=$P "RTN","BIVWXICE",225,0) D INIT^XWBTCPM "RTN","BIVWXICE",226,0) S TO=$P($G(^BISITE(DUZ(2),15)),"^",5) S:TO="" TO=2 "RTN","BIVWXICE",227,0) D OPEN(SERVER,PORT,TO) "RTN","BIVWXICE",228,0) I POP Q "DIDN'T OPEN CONNECTION" "RTN","BIVWXICE",229,0) S XWBSBUF="" "RTN","BIVWXICE",230,0) U XWBTDEV "RTN","BIVWXICE",231,0) D WRITE^XWBRW(HTTPTYPE_" "_PAGE_" HTTP/1.0"_$C(13,10)) "RTN","BIVWXICE",232,0) I HTTPTYPE="POST" D "RTN","BIVWXICE",233,0) . D WRITE^XWBRW("Referer: http://"_$$KSP^XUPARAM("WHERE")_$C(13,10)) "RTN","BIVWXICE",234,0) . D WRITE^XWBRW("Content-Type: application/x-www-form-urlencoded"_$C(13,10)) "RTN","BIVWXICE",235,0) . D WRITE^XWBRW("Cache-Control: no-cache"_$C(13,10)) "RTN","BIVWXICE",236,0) . D WRITE^XWBRW("Content-Length: "_$L(DATA)_$C(13,10,13,10)) "RTN","BIVWXICE",237,0) . D WRITE^XWBRW(DATA) "RTN","BIVWXICE",238,0) D WRITE^XWBRW($C(13,10)) "RTN","BIVWXICE",239,0) D WBF^XWBRW "RTN","BIVWXICE",240,0) S XWBRBUF="",DONE=0,XWBICNT=0 "RTN","BIVWXICE",241,0) S OVERFLOW="" "RTN","BIVWXICE",242,0) S XVALUE=$$DREAD^XUSBSE2($C(13,10)) I $G(RESULTS(1))'[200 S XVALUE=$P($G(RESULTS(1))," ",2,5) "RTN","BIVWXICE",243,0) D CLOSE ;I IO="|TCP|80" U IO D ^%ZISC "RTN","BIVWXICE",244,0) I LINEBUF'="" S RESLTCNT=RESLTCNT+1,RESULTS(RESLTCNT)=LINEBUF "RTN","BIVWXICE",245,0) I $G(RESULTS(1))[200 F I=1:1 I RESULTS(I)="" S XVALUE=$G(RESULTS(I+1)) Q "RTN","BIVWXICE",246,0) Q XVALUE "RTN","BIVWXICE",247,0) ; "RTN","BIVWXICE",248,0) CLOSE ; "RTN","BIVWXICE",249,0) N TMPD "RTN","BIVWXICE",250,0) D CLOSE^%ZISTCP "RTN","BIVWXICE",251,0) S TMPD=$$FINDEV^%ZISUTL("XUSBSE") "RTN","BIVWXICE",252,0) I TMPD'="" D GETDEV^%ZISUTL(TMPD) I $L(IO),'$D(^%ZISL(3.54,"B",IO)) U IO Q "RTN","BIVWXICE",253,0) Q "RTN","BIVWXICE",254,0) ; "RTN","BIVWXICE",255,0) OPEN(P1,P2,P3) ;Open the device and set the variables "RTN","BIVWXICE",256,0) D CALL^%ZISTCP(P1,P2,P3) Q:POP "RTN","BIVWXICE",257,0) S XWBTDEV=IO "RTN","BIVWXICE",258,0) Q "RTN","BIVWXICE",259,0) RZV(BIDFN) ;CHECK FOR RZV VACCS "RTN","BIVWXICE",260,0) N X,Y,Z,I0,D,CVX "RTN","BIVWXICE",261,0) S BIFLU="" "RTN","BIVWXICE",262,0) S X=0 "RTN","BIVWXICE",263,0) F S X=$O(^AUPNVIMM("AC",BIDFN,X)) Q:'X S I0=$G(^AUPNVIMM(X,0)) D:I0 "RTN","BIVWXICE",264,0) .S Y=+I0 "RTN","BIVWXICE",265,0) .S V=+$P(I0,U,3) "RTN","BIVWXICE",266,0) .Q:'Y!'V "RTN","BIVWXICE",267,0) .S D=$P($P($G(^AUPNVSIT(V,0)),U),".") "RTN","BIVWXICE",268,0) .S CVX=+$P($G(^AUTTIMM(Y,0)),U,3) "RTN","BIVWXICE",269,0) .Q:'CVX!'D "RTN","BIVWXICE",270,0) .S:$D(^BIVARR("ZOS",CVX)) BIFLU(CVX,9999999-D)="" "RTN","BIVWXICE",271,0) Q "RTN","BIVWXICE",272,0) ;===== "RTN","BIVWXICE",273,0) ; "VER") 8.0^22.0 **END** **END**