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

BISITE1.m

Go to the documentation of this file. 
  1. BISITE1 ;IHS/CMI/MWR - EDIT SITE PARAMETERS; MAY 10, 2010
  1.  ;;8.5;IMMUNIZATION;**14**;AUG 01,2017
  1.  ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
  1.  ;;  INIT FOR EDIT SITE PARAMETERS.
  1.  ;   PATCH 2: Fix display of default Low Supply Alert.  INIT+72
  1.  ;            Provide call to retrieve Site's Low Alert default.  LOTSDEF
  1.  ;;  PATCH 8: Changes to accommodate new TCH Forecaster   INIT+55,+66,+92,+132
  1.  ;;  PATCH 9: Return the IP Address used for the TCH Forecaster.  INIT+139
  1.  ;;           Update display of selected High Risk parameters.  INIT+165
  1.  ;;  PATCH 13: Add Flu Season Date Range parameter. INIT+197
  1.  ;;  PATCH 14: Update display of selected High Risk parameters.  INIT+164
  1.  ;
  1.  ;
  1.  ;----------
  1. INIT ;EP
  1.  ;---> Initialize variables and list array.
  1.  ;---> If BISITE not supplied, set Error Code and quit.
  1.  I '$G(BISITE) D ERRCD^BIUTL2(109,,1) S VALMQUIT="" Q
  1.  I '$D(^BISITE(BISITE,0)) D ERRCD^BIUTL2(110,,1) S VALMQUIT="" Q
  1.  ;
  1.  K ^TMP("BISITE",$J)
  1.  S VALM("TITLE")=$$LMVER^BILOGO
  1.  S VALMSG="Select a left column number to change an item."
  1.  N BILINE,X,Y S BILINE=0
  1.  ;
  1.  ;---> Default Case Manager.
  1.  D WRITE(.BILINE)
  1.  S X="   1) Default Case Manager.........: "_$$CMGRDEF^BIUTL2(BISITE,1)
  1.  D WRITE(.BILINE,X)
  1.  K X
  1.  ;
  1.  ;---> Other Location.
  1.  N BIOTH S BIOTH=$$OTHERLOC^BIUTL6(BISITE),X=""
  1.  D:BIOTH
  1.  .S X=$P(^AUTTLOC(BIOTH,0),U,4)
  1.  .I $G(X) S:$D(^AUTTAREA(X,0)) X=$P(^(0),U)
  1.  .S X=$$INSTTX^BIUTL6(BIOTH)_"   "_X
  1.  S X=$E("   2) Other Location...............: "_X,1,79)
  1.  D WRITE(.BILINE,X)
  1.  K X
  1.  ;
  1.  ;---> Standard Immunizations Due Letter.
  1.  S X="   3) Standard Imm Due Letter .....: "_$$DEFLET^BIUTL2(BISITE,1)
  1.  D WRITE(.BILINE,X)
  1.  K X
  1.  ;
  1.  ;---> Official Immunization Record.
  1.  S X="   4) Official Imm Record Letter...: "_$$DEFLET^BIUTL2(BISITE,1,1)
  1.  D WRITE(.BILINE,X)
  1.  K X
  1.  ;
  1.  ;---> Facility Record/Report Header.
  1.  S X="   5) Facility Report Header.......: "_$$REPHDR^BIUTL6(BISITE)
  1.  D WRITE(.BILINE,X)
  1.  K X
  1.  ;
  1.  ;---> Host File Server Path.
  1.  S X="   6) Host File Server Path........: "_$$HFSPATH^BIUTL8(BISITE)
  1.  D WRITE(.BILINE,X)
  1.  K X
  1.  ;
  1.  ;---> Minimum Days Last Letter.
  1.  S X=$$MINDAYS^BIUTL2(BISITE)_" day" S:+X'=1 X=X_"s"
  1.  S X="   7) Minimum Days Last Letter.....: "_X
  1.  D WRITE(.BILINE,X)
  1.  K X
  1.  ;
  1.  ;---> Forecast Minimum Age vs Recommended Age.
  1.  S X=$$MINAGE^BIUTL2(BISITE)
  1.  ;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR
  1.  ;---> Change parameter prompt to just Min vs Rec.
  1.  S X=$S(X=1:"Minimum Acceptable Age",1:"Recommended Age")
  1.  ;**********
  1.  S X="   8) Minimum vs Recommended Age...: "_X
  1.  D WRITE(.BILINE,X)
  1.  K X
  1.  ;
  1.  ;---> ImmServe Forecasting Option.
  1.  D
  1.  .N G,H,Y,Z S Z=$G(^BISITE(BISITE,0))
  1.  .;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR
  1.  .;---> Change parameter prompt to just Grace Period.
  1.  .;S Y=$P(Z,U,8),G=$P(Z,U,21),H=$P(Z,U,24)
  1.  .;S X="#"_Y_", "_$S(G:"WITH",1:"NO")_" 4-Day Grace"
  1.  .;S X=X_", HPV through "_$S(H=2:26,1:18)
  1.  .S Y=$P($G(^BISITE(BISITE,0)),U,21)
  1.  .S X="4-Day Grace Period "_$S(Y=1:"",1:"NOT ")_"Used"
  1.  S X="   9) 4-Day Grace Period option....: "_X
  1.  ;**********
  1.  D WRITE(.BILINE,X)
  1.  K X
  1.  ;
  1.  ;---> Lot Numbers required.
  1.  S X=$S($$LOTREQ^BIUTL2(BISITE):"Required",1:"NOT Required")
  1.  ;
  1.  ;********** PATCH 2, v8.5, MAY 15,2012, IHS/CMI/MWR
  1.  ;---> Fix display of default Low Supply Alert.
  1.  ;S X=X_", Default Low Supply Alert="_$$LOTLOW^BIUTL2(BISITE)
  1.  S X=X_", Default Low Supply Alert="_$$LOTSDEF(BISITE)
  1.  ;**********
  1.  ;
  1.  S X="  10) Lot Number Options...........: "_X
  1.  D WRITE(.BILINE,X)
  1.  K X
  1.  ;
  1.  ;---> Pneumo, Flu, Zostervax Site Parameters. v8.5
  1.  ;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR
  1.  ;---> Change parameter prompt to just Pneumo.
  1.  D
  1.  .N Y,Z
  1.  .S Y=$$PNMAGE^BIPATUP2(BISITE)
  1.  .;S Y=$P(X,U),Z=$P(X,U,2)
  1.  .;S X=Y_" years old, "_$S(Z:"every 6 years.",1:"one time only.")
  1.  .S X="Begin Pneumo at "_Y_" years"
  1.  .;S Y=$$FLUALL^BIPATUP2(BISITE)
  1.  .;S X=X_$S(Y:"All ages",1:"6m-18y,50y+")
  1.  .;S X=X_"  Zoster: "
  1.  .;S Y=$$ZOSTER^BIPATUP2(BISITE)
  1.  .;S X=X_$S(Y:"Yes",1:"No")
  1.  ;S X="  11) Pneumo, Flu, Zoster Options..: "_X
  1.  S X="  11) Pneumo routine age to begin..: "_X
  1.  ;**********
  1.  D WRITE(.BILINE,X)
  1.  K X
  1.  ;
  1.  ;---> Forecasting enabled.
  1.  S X=$S($$FORECAS^BIUTL2(BISITE):"Enabled",1:"Disabled")
  1.  S X="  12) Forecasting (Imms Due).......: "_X
  1.  D WRITE(.BILINE,X)
  1.  K X
  1.  ;
  1.  ;---> Include dashes in Chart# display.
  1.  D
  1.  .I $$DASH^BIUTL1(BISITE) S X="Dashes Included (12-34-56)" Q
  1.  .S X="No Dashes (123456)"
  1.  S X="  13) Chart# with dashes...........: "_X
  1.  D WRITE(.BILINE,X)
  1.  K X
  1.  ;
  1.  ;---> User as Default Provider.
  1.  S X=$S($$DEFPROV^BIUTL6(BISITE):"Yes",1:"No")
  1.  S X="  14) User as Default Provider.....: "_X
  1.  D WRITE(.BILINE,X)
  1.  K X
  1.  ;
  1.  ;---> ImmServe Directory.
  1.  ;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR
  1.  ;---> Leave parameter place keeper on menu, but disable.
  1.  ;S X=$$IMMSVDIR^BIUTL8(BISITE)
  1.  ;S:($L(X)>39) X=$E(X,1,39)_"..."
  1.  ;S X="  15) ImmServe Directory...........: "_X
  1.  ;**********
  1.  ;
  1.  ;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR
  1.  ;---> IP Address for TCH Forecaster.
  1.  S X=$$IPTCH^BIUTL8(BISITE)
  1.  S X="  15) IP Address for TCH Forecaster: "_X
  1.  ;**********
  1.  D WRITE(.BILINE,X)
  1.  K X
  1.  ;
  1.  ;---> GPRA Communities.
  1.  D
  1.  .N BIGPRA D GETGPRA^BISITE4(.BIGPRA,BISITE)
  1.  .I '$O(BIGPRA(0)) S X="No" Q
  1.  .N N S (N,X)=0 F  S N=$O(BIGPRA(N)) Q:'N  S X=X+1
  1.  S X=X_" Communities selected for GPRA."
  1.  S X="  16) GPRA Communities.............: "_X
  1.  D WRITE(.BILINE,X)
  1.  K X
  1.  ;
  1.  ;---> Inpatient Check enabled.
  1.  S X=$S($$INPTCHK^BIUTL2(BISITE):"Enabled",1:"Disabled")
  1.  S X="  17) Inpatient Visit Check........: "_X
  1.  D WRITE(.BILINE,X)
  1.  K X
  1.  ;
  1.  ;
  1.  ;********** PATCH 14, v8.5, AUG 01,2017, IHS/CMI/MWR
  1.  ;---> Update display of selected High Risk parameters.
  1.  ;---> Risk Check enabled.
  1.  N Z S Z=$$RISKP^BIUTL2(BISITE)
  1.  D
  1.  .I 'Z S X="High Risk Disabled" Q
  1.  .S X=$$RISKTX^BISITE1(Z)
  1.  .S X="Enabled: "_X
  1.  .;I Z=1 S X="Enabled: Hep B Only" Q
  1.  .;I Z=2 S X="Enabled: Pneumo Only" Q
  1.  .;I Z=12 S X="Enabled: Hep B and Pneumo" Q
  1.  .;I Z=23 S X="Enabled: Pneumo Only (+Smoking)" Q
  1.  .;I Z=123 S X="Enabled: Hep B and Pneumo (+Smoking)" Q
  1.  ;**********
  1.  ;
  1.  S X="  18) High Risk Factor Check.......: "_X
  1.  D WRITE(.BILINE,X)
  1.  K X,Z
  1.  ;
  1.  ;---> CPT-coded Visits enabled.
  1.  S X=$S($$IMPCPT^BIUTL2(BISITE):"Enabled",1:"Disabled")
  1.  S X="  19) Import CPT-coded Visits......: "_X
  1.  D WRITE(.BILINE,X)
  1.  K X
  1.  ;
  1.  ;---> Visit Selection Menu enabled.
  1.  D
  1.  .I $$VISMNU^BIUTL2(BISITE) S X="Enabled (Display Visit Selection Menu)" Q
  1.  .S X="Disabled (Link Visits automatically)"
  1.  S X="  20) Visit Selection Menu.........: "_X
  1.  D WRITE(.BILINE,X)
  1.  K X
  1.  ;
  1.  ;
  1.  ;********** PATCH 13, v8.5, AUG 01,2016, IHS/CMI/MWR
  1.  ;---> Flu Season Date Range.
  1.  S X=$$FLUDATS^BIUTL8(BISITE)
  1.  S X="  21) Flu Season Start & End Dates.: "_$P(X,"%")_" to "_$P(X,"%",2)
  1.  D WRITE(.BILINE,X)
  1.  K X
  1.  ;**********
  1.  ;
  1.  S VALMSG="Scroll down to view more Parameters."
  1.  S VALMCNT=BILINE
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. WRITE(BILINE,BIVAL,BIBLNK) ;EP
  1.  ;---> Write lines to ^TMP (see documentation in ^BIW).
  1.  ;---> Parameters:
  1.  ;     1 - BILINE (ret) Last line# written.
  1.  ;     2 - BIVAL  (opt) Value/text of line (Null=blank line).
  1.  ;
  1.  Q:'$D(BILINE)
  1.  D WL^BIW(.BILINE,"BISITE",$G(BIVAL),$G(BIBLNK))
  1.  Q
  1.  ;
  1.  ;
  1.  ;********** PATCH 2, v8.5, MAY 15,2012, IHS/CMI/MWR
  1.  ;----------
  1. LOTSDEF(BIDUZ2) ;EP
  1.  ;---> Return Site's Default Low Alert for Lot Numbers.
  1.  ;---> Parameters:
  1.  ;     1 - BIDUZ2 (req) User's DUZ(2)
  1.  ;
  1.  Q:'$D(^BISITE(+$G(BIDUZ2),0)) 50
  1.  Q:($P($G(^BISITE(+$G(BIDUZ2),0)),U,25)="") 50
  1.  Q $P($G(^BISITE(+$G(BIDUZ2),0)),U,25)
  1.  ;**********
  1.  ;
  1.  ;********** PATCH 14, v8.5, AUG 01,2017, IHS/CMI/MWR
  1.  ;---> Update display of selected High Risk parameters.
  1.  ;----------
  1. RISKTX(Z) ;EP
  1.  ;---> Return text of Risk Factors.
  1.  ;---> Parameters:
  1.  ;     1 - Z (req) Number representing High Risk.
  1.  ;
  1.  N X S X=""
  1.  I Z=1 S X="Pneumo"
  1.  I Z=2 S X="HepB for DM"
  1.  I Z=3 S X="HepA & HepB for CLD/HepC"
  1.  I Z=19 S X="Pneumo (+Smoking)"
  1.  I Z=12 S X="Pneumo, HepB for DM"
  1.  I Z=13 S X="Pneumo, HepA & HepB for CLD/HepC"
  1.  I Z=23 S X="HepA & HepB for DM and CLD/HepC"
  1.  I Z=139 S X="Pneumo (+Smoking), HepA & HepB"
  1.  I Z=129 S X="Pneumo (+Smoking), HepB for DM"
  1.  I Z=123 S X="Pneumo, HepB, HepA & HepB"
  1.  I Z=1239 S X="Pneumo(+Smkg), HepB, HepA & HepB"
  1.  I X="" S X="ERROR: Unable to determine."
  1.  Q X