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

BIPATVW3.m

Go to the documentation of this file. 
  1. BIPATVW3 ;IHS/CMI/MWR - ADD OTHER ITEMS, DISPLAY HELP; MAY 10, 2010
  1.  ;;8.5;IMMUNIZATION;**14**;AUG 01,2017
  1.  ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
  1.  ;;  BUILD LISTMANAGER ARRAY FOR DISPLAY AND EDIT OF
  1.  ;;  PATIENT'S IMMUNIZATION DATA, DISPLAY HELP.
  1.  ;;  PATCH 8: Changes to discontinue High Risk forecast for Flu  HADINFO+51,+56
  1.  ;;  PATCH 9: Accommodate new parameter options for HepB (Diabetes).  ADDINFO+51
  1.  ;;  PATCH 14: Code to collect High Risk Pneumo, HepB (DM), HepA&B (CLD/HepC) ADDINFO+64
  1.  ;
  1.  ;
  1.  ;----------
  1. LASTLET(BIDFN,BIRMAX,BIENT) ;EP
  1.  ;---> Retrieve date of last letter sent to this patient and
  1.  ;---> display it just below forecast.
  1.  ;---> Parameters:
  1.  ;     1 - BIDFN  (req) Patient's IEN in VA PATIENT File #2.
  1.  ;     2 - BIRMAX (ret) Maximum Right column line number.
  1.  ;     3 - BIENT  (ret) Entry Number for LM selection in VALMY
  1.  ;
  1.  ;---> Check for BIDFN.
  1.  Q:$$DFNCHECK^BIUTL2()
  1.  ;
  1.  ;---> Call RPC to retrieve date of last letter sent.
  1.  ;     BIRETVAL - Return value of valid data from RPC.
  1.  ;     BIRETERR - Return value (text string) of error from RPC.
  1.  ;
  1.  N BIRETVAL,BIRETERR S BIRETVAL=""
  1.  ;
  1.  ;---> RPC to retrieve date of last letter sent.
  1.  D LASTLET^BIRPC5(.BIRETVAL,BIDFN)
  1.  ;
  1.  ;---> If BIRETERR has a value, display it and quit.
  1.  S BIRETERR=$P(BIRETVAL,BI31,2)
  1.  I BIRETERR]"" D
  1.  .D EN^DDIOL("* "_BIRETERR,"","!!?5"),DIRZ^BIUTL3()
  1.  .S BIRETVAL="ERROR!"
  1.  ;
  1.  ;---> Set BIDATE=to date of last letter sent to this patient.
  1.  N BIDATE S BIDATE=$P(BIRETVAL,BI31,1)
  1.  ;
  1.  ;---> Set formatted Last Letter Date line and index in ^TMP.
  1.  D RTCOL^BIPATVW1(.BIRMAX,,BIENT)
  1.  D RTCOL^BIPATVW1(.BIRMAX,"   Last Letter: "_BIDATE,BIENT)
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. CONTRAS(BIDFN,BILMAX,BIRMAX,BIENT) ;EP
  1.  ;---> Now retrieve Patient's Contraindications and append to
  1.  ;---> right half of screen, below Forecast.
  1.  ;---> Parameters:
  1.  ;     1 - BIDFN  (req) Patient's IEN in VA PATIENT File #2.
  1.  ;     2 - BILMAX (ret) Maximum Left column line number.
  1.  ;     3 - BIRMAX (ret) Maximum Right column line number.
  1.  ;     4 - BIENT  (ret) Entry Number for LM selection in VALMY
  1.  ;
  1.  ;---> Check for BIDFN.
  1.  Q:$$DFNCHECK^BIUTL2()
  1.  ;
  1.  ;---> Call RPC to retrieve Contraindications.
  1.  ;     BIRETVAL - Return value of valid data from RPC.
  1.  ;     BIRETERR - Return value (text string) of error from RPC.
  1.  ;
  1.  N BIRETVAL,BIRETERR S BIRETVAL=""
  1.  ;
  1.  ;---> RPC to retrieve Contraindications.
  1.  D CONTRAS^BIRPC5(.BIRETVAL,BIDFN)
  1.  ;
  1.  ;---> If BIRETERR has a value, display it and quit.
  1.  S BIRETERR=$P(BIRETVAL,BI31,2)
  1.  I BIRETERR]"" D EN^DDIOL("* "_BIRETERR,"","!!?5"),DIRZ^BIUTL3() Q
  1.  ;
  1.  ;---> Set BICONT=to a string of Contraindications for this patient.
  1.  N BICONT,BILINE S BICONT=$P(BIRETVAL,BI31,1)
  1.  S BILINE=BIRMAX S:BILINE<1 BILINE=1
  1.  ;
  1.  ;---> Write Contraindications Header.
  1.  D:BICONT]""
  1.  .D RTCOL^BIPATVW1(.BILINE,,BIENT)
  1.  .N X S X="-----------------------------------"
  1.  .D RTCOL^BIPATVW1(.BILINE,X,BIENT)
  1.  .D RTCOL^BIPATVW1(.BILINE,"   * CONTRAINDICATIONS/REFUSALS *",BIENT)
  1.  .D RTCOL^BIPATVW1(.BILINE,,BIENT)
  1.  ;
  1.  ;---> Build Listmanager array from BICONT string.
  1.  ;
  1.  F I=1:1 S Y=$P(BICONT,U,I) Q:Y=""  D
  1.  .;---> Build display line for this Contraindication.
  1.  .N V S V="|"
  1.  .;S X="  "_$P(Y,V,2)_":",X=$$PAD^BIUTL5(X,14)_$P(Y,V,3),X=$E(X,1,40)
  1.  .S X="  "_$P(Y,V,2)_": "_$P(Y,V,3),X=$E(X,1,36)
  1.  .;---> Set formatted Contraindication line and index in ^TMP.
  1.  .D RTCOL^BIPATVW1(.BILINE,X,BIENT)
  1.  ;
  1.  ;---> Save maximum right column line number.
  1.  S BIRMAX=BILINE
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. ADDINFO(BIDFN,BILINE,BIENT,BIDUZ2,BIFDT) ;EP
  1.  ;---> Display Additional Information from Patient Edit screen.
  1.  ;---> Parameters:
  1.  ;     1 - BIDFN  (req) Patient's IEN in VA PATIENT File #2.
  1.  ;     2 - BIRMAX (req) Last Line# (last node in ^TMP array).
  1.  ;     3 - BIENT  (ret) Entry Number for LM selection in VALMY
  1.  ;     5 - BIDUZ2 (req) DUZ(2) (for forecasting parameter display).
  1.  ;     4 - BIFDT  (req) Forecast date (for High Risk display).
  1.  ;
  1.  ;---> Check for BIDFN.
  1.  Q:$$DFNCHECK^BIUTL2()
  1.  S:'$G(BIDUZ2) BIDUZ2=$G(DUZ(2))
  1.  S:'$G(BIFDT) BIFDT=$G(DT)
  1.  ;
  1.  N X,Z S Z=BIENT
  1.  D WRITE^BIPATVW1(.BILINE,,1,Z)
  1.  D WRITE^BIPATVW1(.BILINE,"   ADDITIONAL PATIENT INFORMATION",,Z)
  1.  D WRITE^BIPATVW1(.BILINE,"   ------------------------------",,Z)
  1.  S X=$$DECEASED^BIUTL1(BIDFN,1)
  1.  D:X
  1.  .S X="   DECEASED on..........: "_$$TXDT1^BIUTL5(X)
  1.  .D WRITE^BIPATVW1(.BILINE,X,,Z)
  1.  I '$D(^BIP(BIDFN,0)) D  Q
  1.  .S X="   This Patient is not in the Register."
  1.  .D WRITE^BIPATVW1(.BILINE,X,1,Z)
  1.  ;
  1.  S X="   Case Manager.........: "_$$CMGR^BIUTL1(BIDFN,1)
  1.  D WRITE^BIPATVW1(.BILINE,X,,Z)
  1.  S X="   Designated Provider..: "_$$DPRV^BIUTL1(BIDFN,1)
  1.  D WRITE^BIPATVW1(.BILINE,X,,Z)
  1.  S X="   Parent/Guardian......: "_$$PARENT^BIUTL1(BIDFN)
  1.  D WRITE^BIPATVW1(.BILINE,X,,Z)
  1.  S X="   Current Community....: "_$$CURCOM^BIUTL11(BIDFN,1)
  1.  D WRITE^BIPATVW1(.BILINE,X,,Z)
  1.  S X="   Date First Entered...: "_$$ENTERED^BIUTL1(BIDFN,,1)
  1.  S X=X_" ("_$$ENTERED^BIUTL1(BIDFN,1,1)_")"
  1.  D WRITE^BIPATVW1(.BILINE,X,,Z)
  1.  D
  1.  .N Y S Y=$$INACT^BIUTL1(BIDFN,1)
  1.  .Q:'Y
  1.  .S X="   Inactive Date........: "_Y
  1.  .I Z]"" S X=X_" (Reason: "_$$INACTRE^BIUTL1(BIDFN)_")"
  1.  .D WRITE^BIPATVW1(.BILINE,X,,Z)
  1.  .S X="   Made Inactive by.....: "_$$INACTUSR^BIUTL1(BIDFN)
  1.  .D WRITE^BIPATVW1(.BILINE,X,,Z)
  1.  ;
  1.  S X=$$MOVEDLOC^BIUTL1(BIDFN)
  1.  I X]"" S X="   Moved to/Tx Elsewhere: "_X D WRITE^BIPATVW1(.BILINE,X,,Z)
  1.  S X="" D
  1.  .Q:'$G(DT)  N BIRISKI,BIRISKP
  1.  .;
  1.  .;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR
  1.  .;---> Accommodate new parameter options for HepB (Diabetes).
  1.  .;---> Set risk parameter equal to 12 = Hep B & Pneumo (this is NOT forecasting,
  1.  .;---> merely displaying Additional Patient Info).
  1.  .N BIRSK,BIRISKH S BIRSK=12
  1.  .;
  1.  .;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR
  1.  .;---> Collect only Pneumo High Risk.
  1.  .;D RISK^BIDX(BIDFN,BIFDT,0,.BIRISKI,.BIRISKP)
  1.  .;
  1.  .;---> New parameter to return Hep B risk. (No longer include Flu.)
  1.  .;D RISK^BIDX(BIDFN,BIFDT,2,.BIRISKI,.BIRISKP)
  1.  .;
  1.  .;********** PATCH 14, v8.5, AUG 01,2017, IHS/CMI/MWR
  1.  .;---> Code to collect High Risk Pneumo, HepB (DM), HepA&B (CLD/HepC)
  1.  .;D RISK^BIDX(BIDFN,BIFDT,BIRSK,,.BIRISKP,.BIRISKH)
  1.  .;
  1.  .;---> Set Patient Age in years for this Forecast Date.
  1.  .N BIAGE S BIAGE=$$AGE^BIUTL1(BIDFN,1,BIFDT)
  1.  .N BIRISKF S BIRISKF="",BIRSK=""
  1.  .D RISKP^BIDX(BIDFN,BIFDT,BIAGE,1,.BIRISKF) S:BIRISKF BIRSK=BIRSK_1
  1.  .D RISKB^BIDX(BIDFN,BIFDT,BIAGE,.BIRISKF) S:BIRISKF BIRSK=BIRSK_2
  1.  .D RISKAB^BIDX(BIDFN,BIFDT,.BIRISKF) S:BIRISKF BIRSK=BIRSK_3
  1.  .I 'BIRSK S X="None on record" Q
  1.  .S X=$$RISKTX^BISITE1(BIRSK)
  1.  S X="   High Risk Pneumo,Hep.: "_X
  1.  ;**********
  1.  ;
  1.  S X=X_" (as of "_$$SLDT2^BIUTL5(BIFDT,1)_")"
  1.  D WRITE^BIPATVW1(.BILINE,X,,Z)
  1.  S X="   Forecast Flu/Pneumo..: "_$$INFL^BIUTL11(BIDFN,1)
  1.  D WRITE^BIPATVW1(.BILINE,X,,Z)
  1.  ;D:$G(BIDUZ2)  ;Uncomment to display Pneumo Site Parameter.
  1.  ;.N X,Y,Z S X=$$PNMAGE^BIPATUP2(BIDUZ2)
  1.  ;.S Y=$P(X,U),Z=$P(X,U,2)
  1.  ;. X=Y_" years old, "_$S(Z:"every 6 years.",1:"one time only.")
  1.  ;.S X="   Pneumo Site Parameter: Set at "_X
  1.  ;.D WRITE^BIPATVW1(.BILINE,X,,Z)
  1.  S X="   Mother's HBsAG Status: "_$$T^BITRS($$MOTHER^BIUTL11(BIDFN,1))
  1.  D WRITE^BIPATVW1(.BILINE,X,,Z)
  1.  S X=$$NEXTAPPT^BIUTL11(BIDFN)
  1.  I ((X]"")&(X'="None")) S X="   Next Appointment.....: "_$E(X,1,54) D
  1.  .D WRITE^BIPATVW1(.BILINE,X,,Z)
  1.  D
  1.  .N Y S Y=$$CONSENT^BIUTL1(BIDFN)
  1.  .I Y=1 S X="Consented" Q
  1.  .I Y=0 S X="Declined" Q
  1.  .S X="Unknown"
  1.  S X="   State Registry.......: "_X
  1.  D WRITE^BIPATVW1(.BILINE,X,,Z)
  1.  S X="   Other Information....: "_$$OTHERIN^BIUTL11(BIDFN)
  1.  D WRITE^BIPATVW1(.BILINE,X,,Z)
  1.  D WRITE^BIPATVW1(.BILINE,,,Z)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. HELP ;EP
  1.  ;----> Explanation of this report.
  1.  N BITEXT D TEXT1(.BITEXT)
  1.  D START^BIHELP("PATIENT VIEW SCREEN - HELP",.BITEXT)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. TEXT1(BITEXT) ;EP
  1.  ;;
  1.  ;;This is the main Patient View Screen, the single point from
  1.  ;;which you manage all of an individual patient's immunization data.
  1.  ;;
  1.  ;;The screen is divided horizontally into THREE SECTIONS:
  1.  ;;
  1.  ;;The TOP third of the screen lists the patient's demographic information,
  1.  ;;most of which is edited through the RPMS Patient Registration.
  1.  ;;
  1.  ;;The MIDDLE third of the screen is subdivided into LEFT and RIGHT Columns:
  1.  ;;
  1.  ;;   The LEFT column lists the Patient's Immunization and Skin Test
  1.  ;;   history, including adverse reactions.
  1.  ;;
  1.  ;;   The RIGHT column lists the patient's Immunizations Due, date of last
  1.  ;;   letter sent to the patient, and any contraindications.
  1.  ;;
  1.  ;;The BOTTOM third of the screen lists Actions you can take to add or edit
  1.  ;;the patient's immunization data, or to display other relevant patient
  1.  ;;information.
  1.  ;;
  1.  ;;For many patients, there is more information than can be displayed
  1.  ;;in the middle section of the screen.  To view all of the information
  1.  ;;on a Patient's Immunization History it may be necessary to use the
  1.  ;;"arrow keys" to scroll up and down.
  1.  ;;
  1.  ;;The Actions at the bottom of the screen are:
  1.  ;;
  1.  ;;  A  Add Immunization  - to add a new immunization
  1.  ;;  D  Delete Visit      - to delete an immunization
  1.  ;;  P  Patient Edit      - to edit patient guardian, inactive date, etc.
  1.  ;;  S  Skin Test Add     - to add a skin test
  1.  ;;  I  ImmServe Profile  - to view details of the forecast
  1.  ;;  C  Contraindications - to add/edit/delete contraindications
  1.  ;;  E  Edit Visit        - to change data of an immunization
  1.  ;;  H  Health Summary    - to view the patient's Health Summary
  1.  ;;  L  Letter Print      - to select and print a patient letter
  1.  ;;
  1.  ;;
  1.  ;;There are also Hidden Actions, which you can review by typing ??
  1.  ;;at the "Select Action:" prompt.  If you entered ??, the Hidden
  1.  ;;Actions will be displayed in a list after this text.  Any of the
  1.  ;;Hidden Actions can be executed by typing their names or synonyms
  1.  ;;at the "Select Action:" prompt, just as with the primary Actions.
  1.  ;;
  1.  ;;NOTE! There are two ways to print a patient's Immunization History:
  1.  ;;
  1.  ;;      1) At the Select Action prompt enter "PL" or "Print List".
  1.  ;;         This action will print or queue the entire Patient View Screen
  1.  ;;         as it appears on your screen.
  1.  ;;
  1.  ;;  or  2) Enter "L" or "Letter Print" and select the "Official
  1.  ;;         Immunization Record" for the form letter to print.
  1.  ;;
  1.  D LOADTX("TEXT1",,.BITEXT)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. LOADTX(BILINL,BITAB,BITEXT) ;EP
  1.  Q:$G(BILINL)=""
  1.  N I,T,X S T="" S:'$D(BITAB) BITAB=5 F I=1:1:BITAB S T=T_" "
  1.  F I=1:1 S X=$T(@BILINL+I) Q:X'[";;"  S BITEXT(I)=T_$P(X,";;",2)
  1.  Q