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

BKMVA1.m

Go to the documentation of this file. 
  1. BKMVA1 ;PRXM/HC/CJS - HMS PATIENT REGISTER; [ 1/19/2005 7:16 PM ] ; 21 Jul 2005  12:25 PM
  1.  ;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
  1.  ;
  1.  ; Entry point will calculate reminders.
  1. EN ;  EP - Entry point for BKMV R/E Patient Record
  1.  N HIVIEN,BKMPRIV,BKMIEN,BKMREG,BKMTMP
  1.  S HIVIEN=$$HIVIEN^BKMIXX3()
  1.  I HIVIEN="" W !,"There is no HMS register defined." H 2 Q
  1.  I '$$VALID^BKMIXX3(DUZ) W !,"You are not a valid HMS user." H 2 Q
  1.  S BKMPRIV=$$BKMPRIV^BKMIXX3(DUZ)
  1.  ;
  1.  K ^TMP("BKMVA1",$J)
  1.  F  Q:'$$GETPAT^BKMVA1A()  D
  1.  . S HIVIEN=$$HIVIEN^BKMIXX3()
  1.  . I HIVIEN="" W !,"There is no HMS register defined." H 2 Q
  1.  . S BKMPRIV=$$BKMPRIV^BKMIXX3(DUZ)
  1.  . ; Builds ^TMP("BKMLKP",$J) for patient info and sets DFN
  1.  . D BASETMP^BKMIXX3(DFN)
  1.  . S BKMIEN=$$BKMIEN^BKMIXX3(DFN)
  1.  . I BKMIEN="" W !,"There is no register entry for this patient." Q
  1.  . S BKMREG=$$BKMREG^BKMIXX3(BKMIEN)
  1.  . I BKMREG="" W !,"There is no HMS registry entry for this patient." Q
  1.  . ; Pre-edit audit capture
  1.  . D EN^BKMVAUD
  1.  . I BKMPRIV,$$MSNGDATA^BKMVA1A(DFN,HIVIEN),$$YNP^BKMVA1B("Do you want to add missing registry data at this time","NO") D  D PROMPTS^BKMVA1B(DFN,1)
  1.  .. I $$EXISTHDC^BKMVA1A(DFN,HIVIEN),$$EXISTIHD^BKMVA1A(DFN,HIVIEN),$$EXISTIAD^BKMVA1A(DFN,HIVIEN) Q
  1.  .. D LDREC
  1.  . I $D(DIRUT) D POST^BKMVAUD Q
  1.  . I '$$GETALL(DFN,1) W !,"No Patient entered or Patient Not In Register" S BKMTMP=$$PAUSE^BKMIXX3 Q
  1.  . D ^XBFMK,EN^VALM("BKMV R/E PATIENT RECORD")
  1.  . K ^TMP("BKMVA1",$J)
  1.  . S:$G(DFN)="" DFN=$G(^TMP("BKMLKP",$J))
  1.  . S BKMIEN=$$BKMIEN^BKMIXX3(DFN)
  1.  . I BKMIEN="" W !,"There is no register entry for this patient." Q
  1.  . S BKMREG=$$BKMREG^BKMIXX3(BKMIEN)
  1.  . I BKMREG="" W !,"There is no HMS registry entry for this patient." Q
  1.  . ; Post-edit audit capture
  1.  . D ^XBFMK,POST^BKMVAUD
  1.  . K BKMVA1,BKMVA1E,DFN,X,Y,AGE,DOB,PNT,HRN,RID,ADD1,PHONE,RES,CRBY,CRDT,CRTM,EDBY,EDDT,EDTM,STAT,STATDT,STATCOM,ET
  1.  K BKMVA1,BKMVA1E,DFN,X,Y,AGE,DOB,PNT,HRN,RID,ADD1,PHONE,RES,CRBY,CRDT,CRTM,EDBY,EDDT,EDTM,STAT,STATDT,STATCOM,ET
  1.  K ^TMP("BKMVA2R",$J)
  1.  Q
  1.  ;
  1. EN2(DFN,AGE,SEX,DOB,PNT) ; EP - Main entry point for BKMV R/E Patient Record
  1.  N HIVIEN,BKMPRIV,BKMIEN,BKMREG,BKMTMP
  1.  S HIVIEN=$$HIVIEN^BKMIXX3()
  1.  I HIVIEN="" W !,"There is no HMS register defined." H 2 Q
  1.  I '$$VALID^BKMIXX3(DUZ) W !,"You are not a valid HMS user." Q
  1.  S BKMPRIV=$$BKMPRIV^BKMIXX3(DUZ)
  1.  ;
  1.  K ^TMP("BKMVA1",$J)
  1.  ; Builds ^TMP("BKMLKP",$J) for patient info and sets DFN
  1.  D BASETMP^BKMIXX3(DFN)
  1.  S BKMIEN=$$BKMIEN^BKMIXX3(DFN)
  1.  I BKMIEN="" W !,"There is no register entry for this patient." Q
  1.  S BKMREG=$$BKMREG^BKMIXX3(BKMIEN)
  1.  I BKMREG="" W !,"There is no HMS registry entry for this patient." Q
  1.  ; Pre-edit audit capture
  1.  D EN^BKMVAUD
  1.  I BKMPRIV,$$MSNGDATA^BKMVA1A(DFN,HIVIEN),$$YNP^BKMVA1B("Do you want to add missing registry data at this time","NO") D  D PROMPTS^BKMVA1B(DFN,1)
  1.  . I $$EXISTHDC^BKMVA1A(DFN,HIVIEN),$$EXISTIHD^BKMVA1A(DFN,HIVIEN),$$EXISTIAD^BKMVA1A(DFN,HIVIEN) Q
  1.  . D LDREC
  1.  I $D(DIRUT) D POST^BKMVAUD Q
  1.  ;
  1.  I '$$GETALL(DFN,1) W !,"No Patient entered or Patient Not In Register" S BKMTMP=$$PAUSE^BKMIXX3 Q
  1.  D EN^VALM("BKMV R/E PATIENT RECORD")
  1.  K ^TMP("BKMVA1",$J)
  1.  S BKMIEN=$$BKMIEN^BKMIXX3(DFN)
  1.  I BKMIEN="" W !,"There is no register entry for this patient." Q
  1.  S BKMREG=$$BKMREG^BKMIXX3(BKMIEN)
  1.  I BKMREG="" W !,"There is no HMS registry entry for this patient." Q
  1.  ; Post-edit audit capture
  1.  D POST^BKMVAUD
  1.  K BKMVA1,BKMVA1E,DFN,X,Y,AGE,DOB,PNT,HRN,RID,ADD1,PHONE,RES,CRBY,CRDT,CRTM,EDBY,EDDT,EDTM,STAT,STATDT,STATCOM
  1.  K ^TMP("BKMVA2R",$J)
  1.  Q
  1.  ;
  1. EN3 ; -- main entry point for BKMV R/E Patient Record. The Following entry point will not calculate reminders.
  1.  K BKMVA1,BKMVA1E,DFN,X,Y,AGE,DOB,PNT,HRN,RID,ADD1,PHONE,RES,CRBY,CRDT,CRTM,EDBY,EDDT,EDTM,STAT,STATDT,STATCOM
  1.  N HIVIEN,BKMPRIV,BKMIEN,BKMREG,BKMTMP
  1.  S HIVIEN=$$HIVIEN^BKMIXX3()
  1.  I HIVIEN="" W !,"There is no HMS register defined." H 2 Q
  1.  I '$$VALID^BKMIXX3(DUZ) W !,"You are not a valid HMS user." Q
  1.  S BKMPRIV=$$BKMPRIV^BKMIXX3(DUZ)
  1.  ;
  1.  K ^TMP("BKMVA1",$J)
  1.  F  Q:'$$GETPAT^BKMVA1A()  D
  1.  . S HIVIEN=$$HIVIEN^BKMIXX3()
  1.  . I HIVIEN="" W !,"There is no HMS register defined." H 2 Q
  1.  . S BKMPRIV=$$BKMPRIV^BKMIXX3(DUZ)
  1.  . ; Builds ^TMP("BKMLKP",$J) for patient info and sets DFN
  1.  . D BASETMP^BKMIXX3(DFN)
  1.  . S BKMIEN=$$BKMIEN^BKMIXX3(DFN)
  1.  . I BKMIEN="" W !,"There is no register entry for this patient." Q
  1.  . S BKMREG=$$BKMREG^BKMIXX3(BKMIEN)
  1.  . I BKMREG="" W !,"There is no HMS registry entry for this patient." Q
  1.  . ; Pre-edit audit capture
  1.  . D EN^BKMVAUD
  1.  . I BKMPRIV,$$MSNGDATA^BKMVA1A(DFN,HIVIEN),$$YNP^BKMVA1B("Do you want to add missing registry data at this time","NO") D  D PROMPTS^BKMVA1B(DFN,1)
  1.  .. I $$EXISTHDC^BKMVA1A(DFN,HIVIEN),$$EXISTIHD^BKMVA1A(DFN,HIVIEN),$$EXISTIAD^BKMVA1A(DFN,HIVIEN) Q
  1.  .. D LDREC
  1.  . I $D(DIRUT) D POST^BKMVAUD Q
  1.  . I '$$GETALL(DFN,0) W !,"No Patient entered or Patient Not In Register" S BKMTMP=$$PAUSE^BKMIXX3 Q
  1.  . D EN^VALM("BKMV R/E PATIENT RECORD")
  1.  . K ^TMP("BKMVA1",$J)
  1.  . S:$G(DFN)="" DFN=$G(^TMP("BKMLKP",$J))
  1.  . S BKMIEN=$$BKMIEN^BKMIXX3(DFN)
  1.  . I BKMIEN="" W !,"There is no register entry for this patient." Q
  1.  . S BKMREG=$$BKMREG^BKMIXX3(BKMIEN)
  1.  . I BKMREG="" W !,"There is no HMS registry entry for this patient." Q
  1.  . ; Post-edit audit capture
  1.  . D POST^BKMVAUD
  1.  . K BKMVA1,BKMVA1E,DFN,X,Y,AGE,DOB,PNT,HRN,RID,ADD1,PHONE,RES,CRBY,CRDT,CRTM,EDBY,EDDT,EDTM,STAT,STATDT,STATCOM
  1.  K BKMVA1,BKMVA1E,DFN,X,Y,AGE,DOB,PNT,HRN,RID,ADD1,PHONE,RES,CRBY,CRDT,CRTM,EDBY,EDDT,EDTM,STAT,STATDT,STATCOM
  1.  Q
  1.  ;
  1. HDR ; -- header code
  1.  N SITE,DA,IENS
  1.  S DA=$G(DUZ(2)),IENS=$$IENS^DILF(.DA),SITE=$$GET1^DIQ(4,IENS,.01,"E")
  1.  S VALMHDR(1)=$$PAD^BKMIXX4("",">"," ",(80-$L(SITE)+2)\2)_"["_$G(SITE)_"]"
  1.  Q
  1. ADDRESS(DFN) ;EP
  1.  N ADDR,IND,FIELD,FIELDE,ITEM
  1.  S ADDR=""
  1.  F IND=.111,.112,.113,.114,.115,.116 D
  1.  . S ITEM=$$GET1^DIQ(2,DFN,IND,"E")
  1.  . I IND=".115" S ITEM=$$IENTOST(ITEM)
  1.  . I ADDR="" S ADDR=ITEM Q
  1.  . S ADDR=ADDR_"^"_ITEM Q
  1.  Q ADDR
  1. IENTOEMP(IEN) ;
  1.  N EMPE,EMP
  1.  Q:IEN?." " ""
  1.  S EMP=$$GET1^DIQ(200,IEN,.01,"I","","EMPE")
  1.  Q:$D(EMPE) IEN
  1.  Q EMP
  1. IENTOST(IEN) ;
  1.  N ST,STE
  1.  Q:IEN?." " ""
  1.  S ST=$$GET1^DIQ(5,IEN,1,"I","","STE")
  1.  Q:$D(STE) IEN
  1.  Q ST
  1. PHONE(DFN,TYPE) ;EP
  1.  N PHONE,PHONEE
  1.  Q:DFN?." " ""
  1.  I '$D(TYPE) S TYPE=1
  1.  D GETS^DIQ(2,DFN,".131;.132","I","PHONE","PHONEE")
  1.  Q:$D(PHONEE) DFN
  1.  Q $S(TYPE=1:$G(PHONE(2,DFN_",",.131,"I")),TYPE=2:$G(PHONE(2,DFN_",",.132,"I")),1:"")
  1. RES(DFN) ;EP
  1.  Q $$GET1^DIQ(9000001,DFN,"1117","E")
  1. HRN(DFN) ;EP
  1.  N DA,IENS
  1.  S DA(1)=DFN,DA=DUZ(2)
  1.  S IENS=$$IENS^DILF(.DA)
  1.  Q $$GET1^DIQ(9000001.41,IENS,.02,"E")
  1. PRIMPROV(DFN) ;EP
  1.  Q $$GET1^DIQ(9000001,DFN,.14,"E")
  1. SUMMARY ; Health Summary
  1.  ;D HS^BKMIHSM(DFN)
  1.  D SUPP^BKMSUPP(DFN)
  1.  S VALMBCK="R"
  1.  Q
  1.  ; View/Edit problem list
  1. UPD1HDR(SCRN,NAME) ;
  1.  S SCRN=$G(SCRN),NAME=$G(NAME)
  1.  W:SCRN'?." " !,SCRN
  1.  W:NAME'?." " !,NAME
  1.  W:SCRN'?." "!(NAME'?." ") !
  1.  Q
  1.  ;
  1.  ; Patient Reports in the patient record screen.
  1. REPORTS ;
  1.  N EXITREP,SELECT,OPT
  1.  S EXITREP=0
  1.  F  D  Q:EXITREP
  1.  . D ^XBFMK
  1.  . D CLEAR^VALM1
  1.  . D FULL^VALM1
  1.  . ; PRXM/HC/BHS - 05/10/2006 - Replace DIR selector with code to allow
  1.  . ;                            partial matches on code and desc
  1.  . ;K DIR
  1.  . ;S DIR(0)="SO^DO:Due/OverDue;QC:Quality of Care Audit Report;SUPP:HMS Supplement;HS:Health Summary;BOTH:Both Health Summary and Supplement;SSR:State Surveillance Report;Q:Quit"
  1.  . ;S DIR("A")="Select Patient Report"
  1.  . ;D ^DIR
  1.  . ;S SELECT=Y
  1.  . ;I SELECT?." "!(SELECT?1."^")!(SELECT="Q") S EXITREP=1 Q
  1.  . S SELECT=$$OPT^BKMVA1C()
  1.  . I SELECT="" S EXITREP=1 Q
  1.  . I SELECT="DO" D ONE^BKMVDOD(DFN) Q
  1.  . ;I SELECT="2" D CSEL^BKMIMRP1 Q
  1.  . I SELECT="QC" D EN^BKMVQCR(1) Q
  1.  . I SELECT="SUPP" S OPT=1 D CLEAR^VALM1,FR2^BKMSUPP Q
  1.  . I SELECT="HS" S OPT=2 D CLEAR^VALM1,FR2^BKMSUPP Q
  1.  . I SELECT="BOTH" S OPT=3 D CLEAR^VALM1,FR2^BKMSUPP Q
  1.  . ;I $F("^3^4^5^",U_SELECT_U) S OPT=SELECT-2 D CLEAR^VALM1,FR1^BKMSUPP
  1.  . I SELECT="SSR" D EN1^BKMVSSR Q
  1.  . W !,"Invalid Entry"
  1.  D ^XBFMK
  1.  Q
  1.  ;
  1. ADDDATA(DFN) ;EP - Add Patient Data
  1.  K CALCREM
  1.  D ADDDATA^BKMVA2(DFN)
  1.  Q
  1. INIT ;EP - Review/Edit Patient Record
  1.  D INIT^BKMVA2
  1.  Q
  1. GETALL(DFN,RECALC) ;EP
  1.  S RECALC=$G(RECALC)
  1.  Q $$GETALL^BKMVA2(DFN,RECALC)
  1.  ;
  1. FREVEDIT(ADD,REV,PCCSF) ; EP - Review Edit
  1.  N OPTION
  1.  F  Q:'$$REVEDIT(.OPTION)  D
  1.  . I OPTION="ADD" D  Q
  1.  . . ; PRXM/BHS - 04/05/2006 - Kill removed since it is inside the loop and would reset potentially after data was added for a previous iteration
  1.  . . ;K CALCREM
  1.  . . I '$G(BKMPRIV) D NOGO^BKMIXX3 Q
  1.  . . NEW DIR
  1.  . . S DIR(0)="YA"
  1.  . . S DIR("A")="Do you wish to continue? "
  1.  . . S DIR("A",1)="The data you enter for the above patient will be added permanently"
  1.  . . S DIR("A",2)="to the PCC database."
  1.  . . S DIR("A",3)=" "
  1.  . . S DIR("B")="YES"
  1.  . . D ^DIR
  1.  . . I $D(DTOUT)!$D(DUOUT)!(Y=0) Q
  1.  . . D @ADD
  1.  . . ; Save HMS PCC Buffer subfile
  1.  . . D SAVEVF^BKMVA1A(DFN,PCCSF)
  1.  . . ; PRXM/BHS - 04/05/2006 - Set CALCREM in SAVEVF^BKMVA1A only if data was actually saved
  1.  . . ;S CALCREM=1
  1.  . I OPTION="REV" D @REV Q
  1.  ; Save HMS PCC Buffer subfile
  1.  ;D SAVEVF^BKMVA1A(DFN,PCCSF)
  1.  Q
  1.  ;
  1. REVEDIT(OPTION) ;
  1.  N RCRDHDR,BKMDOD
  1.  D ^XBFMK
  1.  D CLEAR^VALM1
  1.  D FULL^VALM1
  1.  S RCRDHDR=$$PAD^BKMIXX4(" Patient: ",">"," ",10)_$$PAD^BKMIXX4($$GET1^DIQ(2,DFN,".01","E"),">"," ",30)_$$PAD^BKMIXX4(" HRN: ",">"," ",6)_$$PAD^BKMIXX4($$HRN^BKMVA1(DFN),">"," ",9)
  1.  S BKMDOD=$$GET1^DIQ(2,DFN,".351","I")
  1.  I BKMDOD'="" S RCRDHDR=RCRDHDR_$$PAD^BKMIXX4(" DOD: ",">"," ",6)_$$PAD^BKMIXX4($$FMTE^XLFDT(BKMDOD,1),">"," ",15)
  1.  W !,RCRDHDR
  1.  K DIR
  1.  S DIR(0)="SO^REV:Review History;ADD:Add New Data;Q:Quit"
  1.  ;PRXM/HC/DLS 11/30/2005 ; changed V-File prompt to 'Select Action'...
  1.  S DIR("A")="Select Action"
  1.  ;S DIR("A")="Select V-File Option"
  1.  D ^DIR I $D(DIRUT) D ^XBFMK Q 0
  1.  S OPTION=Y
  1.  I Y?1."^"!(Y?." ")!($TR($E(Y,1),"q","Q")="Q") D ^XBFMK Q 0
  1.  D ^XBFMK
  1.  Q 1
  1.  ;
  1. INFO ;
  1.  ;N EXIT,INFO
  1.  ;S EXIT=0
  1.  ;F  D  Q:EXIT
  1.  ;. D ^XBFMK
  1.  ;. D CLEAR^VALM1
  1.  ;. D FULL^VALM1
  1.  ;. K DIR
  1.  ;. S DIR(0)="SO^1:Enter/Edit Info;2:Print Info;Q:Quit;"
  1.  ;. S DIR("A")="Select Info Option"
  1.  ;. D ^DIR
  1.  ;. S INFO=$G(Y)
  1.  ;. I INFO?1."^"!(INFO?." ") S EXIT=1 Q
  1.  ;.;PRXM/HC/CJS 07/21/2005 -- Check for edit access
  1.  ;.; I INFO=1 D ^BKMDOCE Q
  1.  ;. I INFO=1 D:$G(BKMPRIV) ^BKMDOCE D:'$G(BKMPRIV) NOGO^BKMIXX3 Q
  1.  ;. I INFO=2 D ^BKMPHPR Q
  1.  ;. I INFO="Q" S EXIT=1 Q
  1.  ;. W !,"Invalid Selection"
  1.  ;D ^XBFMK
  1.  Q
  1.  ;
  1. LDREC ;Load default values if Diagnosis Category is not at risk
  1.  N DIAG
  1.  S DIAG=$$DIAG^BKMVA1B(DFN)
  1.  I DIAG]"",'$F("^A^H^",U_DIAG_U) Q
  1.  D LDREC^BKMVA1B(DFN)
  1.  Q
  1.  ;
  1. HELP ; -- help code
  1.  S X="?" D DISP^XQORM1 W !
  1.  Q