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

BIPATVW.m

Go to the documentation of this file. 
  1. BIPATVW ;IHS/CMI/MWR - VIEW PATIENT IMM DATA; MAY 10, 2010
  1.  ;;8.5;IMMUNIZATION;;SEP 01,2011
  1.  ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
  1.  ;;  VIEW PATIENT'S IMMUNIZATION DATA AND ALLOW EDITS
  1.  ;;  THROUGH LISTMANAGER.
  1.  ;
  1.  ;
  1.  ;----------
  1. START ;EP
  1.  ;---> Lookup patients, view and edit their Immunization data.
  1.  ;
  1.  D SETVARS^BIUTL5 N BIDFN,BIFDT,BIPOP,BIRTN
  1.  F  D  Q:$G(BIDFN)<1
  1.  .D TITLE^BIUTL5("VIEW PATIENT IMMUNIZATION DATA")
  1.  .D PATLKUP^BIUTL8(.BIDFN,$S($$MAYEDIT^BIUTL11:"ADD",1:""),DUZ(2),.BIPOP)
  1.  .Q:$G(BIPOP)  Q:$G(BIDFN)<1
  1.  .D DATE(.BIFDT,.BIPOP)
  1.  .Q:BIPOP
  1.  .D EN(BIDFN,$$MAYEDIT^BIUTL11,BIFDT,DUZ(2))
  1.  .D UNLOCK($G(BIDFN))
  1.  D EXIT
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. ONEPAT ;EP
  1.  ;---> Lookup patients, view and edit their Immunization data.
  1.  ;
  1.  D SETVARS^BIUTL5 N BIDFN,BIFDT,BIPOP,BIRTN
  1.  D
  1.  .D PATLKUP^BIUTL8(.BIDFN,$S($$MAYEDIT^BIUTL11:"ADD",1:""),DUZ(2),.BIPOP)
  1.  .Q:$G(BIPOP)  Q:$G(BIDFN)<1
  1.  .D DATE(.BIFDT,.BIPOP)
  1.  .Q:BIPOP
  1.  .D EN(BIDFN,$$MAYEDIT^BIUTL11,BIFDT,DUZ(2))
  1.  .D UNLOCK($G(BIDFN))
  1.  D EXIT
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. HAVEPAT(BIDFN,BIFDT,BIPRT,BIPOP) ;EP
  1.  ;---> Entry point when patient is already known.
  1.  ;---> Parameters:
  1.  ;     1 - BIDFN  (req) Patient IEN.
  1.  ;     2 - BIFDT  (opt) Forecast Date (date used for forecast).
  1.  ;     3 - BIPRT  (opt) If BIPRT=1 this call is to print.
  1.  ;     4 - BIPOP  (ret) BIPOP=1 If quit, fail, DTOUT, DUOUT.
  1.  ;
  1.  D SETVARS^BIUTL5 S BIPOP=0 N BIN ;(Preserve BIN from calls above.)
  1.  I '$G(BIDFN)  D ERRCD^BIUTL2(201,,1) S BIPOP=1 Q
  1.  I '$D(^AUPNPAT(BIDFN)) D ERRCD^BIUTL2(203,,1) S BIPOP=1 Q
  1.  K ^BITMP($J),^TMP("BILMVW",$J)
  1.  S ^BITMP($J,1,BIDFN)=""
  1.  D:'$G(BIFDT) DATE(.BIFDT,.BIPOP)
  1.  Q:BIPOP
  1.  D EN(BIDFN,$S($G(BIPRT):2,1:$$MAYEDIT^BIUTL11),$G(BIFDT),DUZ(2))
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. EN(BIDFN,BIEDIT,BIFDT,BIDUZ2) ;EP
  1.  ;---> Main entry point to call Lists: BI PATIENT DATA VIEW/EDIT
  1.  ;---> and BI PATIENT VIEW ONLY.
  1.  ;---> Parameters:
  1.  ;     1 - BIDFN  (req) Patient IEN.
  1.  ;     2 - BIEDIT (opt) Null or 0=View only; 1=View/Edit, 2=Print.
  1.  ;     3 - BIFDT  (opt) Forecast Date (date used for forecast).
  1.  ;     4 - BIDUZ2 (req) User's DUZ(2) for BISITE parameters,
  1.  ;                      which affect forecasting rules.
  1.  ;
  1.  I '$G(BIDFN) D ERRCD^BIUTL2(201,,1) Q
  1.  S:'$G(BIDUZ2) BIDUZ2=$G(DUZ(2))
  1.  I '$G(BIDUZ2) D ERRCD^BIUTL2(105,,1) Q
  1.  ;
  1.  ;---> If no Forecast Date passed, set it equal to today.
  1.  S:'$G(BIFDT) BIFDT=DT
  1.  ;
  1.  ;---> BIHX contains the patient's Immunization History and is
  1.  ;---> used by various protocols and actions in Listmanager.
  1.  N BIHX,DFN S DFN=BIDFN  ;For now with Linda's view reg templates.
  1.  ;
  1.  ;---> Print Patient Data and quit.
  1.  ;---> (Called by Protocol BI PATIENT VIEW PRINT.)
  1.  I $G(BIEDIT)=2 D PRINT Q
  1.  ;
  1.  ;---> Select List Template to View/Edit or View Only.
  1.  S BILIST="BI PATIENT DATA VIEW"_$S($G(BIEDIT)=1:"/EDIT",1:" ONLY")
  1.  I '$D(^SD(409.61,"B",BILIST)) D ERRCD^BIUTL2(628,,1) Q
  1.  D EN^VALM(BILIST)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. PRINT ;EP
  1.  ;---> Print Patient Data screen.
  1.  ;---> Called by Protocol BI PATIENT VIEW PRINT, which is the
  1.  ;---> Print List Protocol for Lists: BI PATIENT DATA VIEW/EDIT and
  1.  ;---> BI PATIENT DATA VIEW ONLY.
  1.  ;
  1.  D DEVICE(.BIPOP)
  1.  I $G(BIPOP) D RESET Q
  1.  ;
  1.  D HDR(1),MAIN^BIPATVW1(1)
  1.  D PRTLST^BIUTL8("BILMVW")
  1.  D RESET
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. HDR(BIPRT) ;EP
  1.  ;---> Header code for both Listman Screen and Print List.
  1.  ;---> Parameters:
  1.  ;     1 - BIPRT  (opt) If BIPRT=1 array is for print: Add Privacy Act
  1.  ;                      line and Site Header line.
  1.  ;
  1.  N BILINE,X,Y S BILINE=0 K VALMHDR
  1.  N BICRT S BICRT=$S(($E($G(IOST))="C")!(IOST["BROWSER"):1,1:0)
  1.  ;
  1.  D WH^BIW(.BILINE)
  1.  ;
  1.  D:$G(BIPRT)
  1.  .S X="WARNING: Confidential Patient Information, Privacy Act applies."
  1.  .D WH^BIW(.BILINE,"   "_X,1)
  1.  .;
  1.  .S X=$$REPHDR^BIUTL6(DUZ(2)),BIDASH=$L(X)+2 D CENTERT^BIUTL5(.X)
  1.  .D WH^BIW(.BILINE,X)
  1.  .S X=$$SP^BIUTL5(BIDASH,"-") D CENTERT^BIUTL5(.X)
  1.  .D WH^BIW(.BILINE,X,1)
  1.  ;
  1.  S Y=$E($$NAME^BIUTL1(BIDFN),1,25)
  1.  S X=" Patient: "
  1.  S:BICRT X=X_IORVON
  1.  S X=X_Y
  1.  S:BICRT X=X_IOINORM
  1.  S X=X_$$SP^BIUTL5(27-$L(Y))_"DOB: "
  1.  S:BICRT X=X_IORVON
  1.  S X=X_$$DOBF^BIUTL1(BIDFN,$G(BIFDT))
  1.  S:BICRT X=X_IOINORM
  1.  D WH^BIW(.BILINE,X)
  1.  S X="  Chart#: "
  1.  S:BICRT X=X_IORVON
  1.  S X=X_$$HRCN^BIUTL1(BIDFN)
  1.  S Y=$E($$INSTTX^BIUTL6($G(DUZ(2))),1,17)
  1.  S X=X_" at "_Y
  1.  S:BICRT X=X_IOINORM
  1.  S X=X_$$SP^BIUTL5(49-$L(X))_$$ACTIVE^BIUTL1(BIDFN)
  1.  S X=X_"   "_$$SEXW^BIUTL1(BIDFN)
  1.  D:$D(^BIP(BIDFN,0))
  1.  .S X=X_"    "_"M HBsAg: "_$E($$MOTHER^BIUTL11(BIDFN,1),1,3)
  1.  D WH^BIW(.BILINE,X,1)
  1.  D:$G(BIPRT)
  1.  .S X="  #  Immunization History                  |   Immunizations DUE"
  1.  .S:$G(BIFDT) X=X_" on "_$$SLDT2^BIUTL5(BIFDT)
  1.  .D WH^BIW(.BILINE,X)
  1.  ;
  1.  ;---> Set Screen Title.
  1.  S VALM("TITLE")="PATIENT VIEW (IMM v"_$$VER^BILOGO_")"
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. INIT ;EP
  1.  ;---> Initialize variables and list array.
  1.  D MAIN^BIPATVW1()
  1.  S BIRTN="BIPATVW"
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. DATE(BIFDT,BIPOP) ;EP
  1.  ;---> Ask Forecast Date.
  1.  ;---> Parameters:
  1.  ;     1 - BIFDT (ret) Forecast Date, Fileman format.
  1.  ;               (opt) Default Date.
  1.  ;     2 - BIPOP (ret) BIPOP=1 If quit, fail, DTOUT, DUOUT.
  1.  ;
  1.  N BIDFLT,DIR
  1. DATE1 ;EP
  1.  S BIPOP=0
  1.  S:$G(BIFDT)="" BIFDT=DT
  1.  S BIDFLT=$$TXDT^BIUTL5(BIFDT)
  1.  D HELP1
  1.  S DIR(0)="DA^::EX"
  1.  S DIR("A")="  Select Forecast Date: ",DIR("B")=BIDFLT
  1.  D ^DIR W !
  1.  I $D(DIRUT) S BIPOP=1 Q
  1.  S BIFDT=$P(Y,".")
  1.  I BIFDT<$$DOB^BIUTL1(BIDFN) D  G DATE1
  1.  .W !?5,"Date must be after patient's date of birth."
  1.  .K BIFDT D DIRZ^BIUTL3()
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. HELP1 ;EP
  1.  ;;The "Forecast" is a list of immunizations that a patient is due
  1.  ;;to receive.
  1.  ;;
  1.  ;;You may view the immunizations that this patient WOULD BE due for
  1.  ;;on a date other than today (past or future).
  1.  D HELPTX("HELP1")
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. HELPTX(BILINL,BITAB) ;EP
  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 DIR("?",I)=T_$P(X,";;",2)
  1.  S DIR("?")=DIR("?",I-1) K DIR("?",I-1)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. RESET ;EP
  1.  ;---> Update partition for return to Listmanager.
  1.  I $D(VALMQUIT) S VALMBCK="Q" Q
  1.  D TERM^VALM0 S VALMBCK="R"
  1.  D INIT,HDR() Q
  1.  ;
  1.  ;
  1.  ;----------
  1. HELP ;EP
  1.  ;---> Help code.
  1.  N BIX S BIX=X
  1.  D EN^XBNEW("HELP^BIPATVW3","VALM*;IO*")
  1.  D:BIX'="??" RE^VALM4
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. EXIT ;EP
  1.  ;---> EOJ Cleanup.
  1.  D KILLALL^BIUTL8(1)
  1.  K ^TMP("BILMVW",$J)
  1.  D CLEAR^VALM1
  1.  D FULL^VALM1
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. DEVICE(BIPOP) ;EP
  1.  ;---> Get Device and possibly queue to Taskman.
  1.  ;---> Parameters:
  1.  ;     1 - BIPOP (ret) If error or Queue, BIPOP=1
  1.  ;
  1.  K %ZIS,IOP S BIPOP=0
  1.  S ZTRTN="DEQUEUE^BIPATVW"
  1.  D ZSAVES^BIUTL3
  1.  D ZIS^BIUTL2(.BIPOP,1)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. DEQUEUE ;EP
  1.  ;---> Print Patient Data screen.
  1.  D HDR(1),MAIN^BIPATVW1(1)
  1.  D PRTLST^BIUTL8("BILMVW"),EXIT
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. UNLOCK(BIDFN) ;EP
  1.  ;---> Unlock BI PATIENT global for this patient.
  1.  ;---> Parameters:
  1.  ;     1 - BIDFN (req) Patient DFN to unlock.
  1.  ;
  1.  Q:'$G(BIDFN)
  1.  N I F I=1:1:5  L -^BIP(BIDFN)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. PRINTX(BILINL,BITAB) ;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'[";;"  W !,T,$P(X,";;",2)
  1.  Q