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

BKMVA41.m

Go to the documentation of this file. 
  1. BKMVA41 ;PRXM/HC/JGH - HMS PATIENT REGISTER; [ 1/19/2005 7:16 PM ] ; 13 Apr 2005  5:42 PM
  1.  ;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
  1.  ;
  1.  Q
  1.  ;
  1. EN ;ENTRY POINT -- ListMan template BKMV PCC LAB REVIEW
  1.  ; Assumes existence of DFN,DUZ
  1.  N HIVIEN
  1.  S HIVIEN=$$HIVIEN^BKMIXX3()
  1.  I HIVIEN="" W !,"There is no HMS register defined." H 2 Q
  1.  I '$$VALID^BKMIXX3(DUZ) Q
  1.  K ^TMP("BKMVA41",$J)
  1.  D ^XBFMK
  1.  D EN^VALM("BKMV PCC LAB REVIEW")
  1.  D ^XBFMK
  1.  D EXIT
  1.  Q
  1.  ;
  1. HDR ; -- header code
  1.  ; Assumes existence of DUZ
  1.  N DA,IENS,SITE
  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.  S VALMHDR(2)=$G(RCRDHDR)
  1.  Q
  1.  ;
  1. INIT ; -- init variables and list array
  1.  ; Assumes existence of DFN
  1.  D GETALL(DFN)
  1.  Q
  1.  ;
  1. GETALL(DFN) ; Build ListMan display array of patient lab information
  1.  ; Input variables:
  1.  ;  DFN - IEN for File 2
  1.  ; Output variables:
  1.  ;  VALMAR - Builds ListMan array
  1.  ;  VALMCNT - List array count
  1.  ;  VALM0
  1.  N DA0,TEXT,LABDT,IENS,REFLOW,REFHIGH,BKMRNG,LAB,BKMVDT,VSTIEN,BKMPVDT
  1.  N BKMACC,BKMPAR,BKMCHI,BKMRVDT
  1.  D ^XBFMK
  1.  S VALMCNT=0,VALMAR="^TMP(""BKMVA41"","""_$J_""")",VALM0=""
  1.  ;
  1.  ;PRXM/HC/BHS - 06/14/2006 - Resort lab test by reverse date, acc #, parent lab, child lab
  1.  ;                           to match PAT/REC/LAB display order per IHS
  1.  ;                           Commented out code removed for readability and size constraints
  1.  S LAB=0,LABDT=0
  1.  F  S LAB=$O(^AUPNVLAB("AC",DFN,LAB)) Q:LAB=""  D
  1.  . S DA=LAB,IENS=$$IENS^DILF(.DA)
  1.  . S LABDT=$$GET1^DIQ(9000010.09,IENS,"1201","I")
  1.  . ; If event d/t is null, try visit d/t
  1.  . I LABDT="" D  Q:LABDT=""
  1.  . . S VSTIEN=$$GET1^DIQ(9000010.09,IENS,".03","I") Q:VSTIEN=""
  1.  . . S LABDT=$$GET1^DIQ(9000010,VSTIEN_",",".01","I")
  1.  . S BKMRVDT=9999999-(LABDT\1)
  1.  . S BKMACC=$E($$GET1^DIQ(9000010.09,IENS,".06","E"),1,2)
  1.  . I BKMACC="" S BKMACC="ZZ"
  1.  . S BKMPAR=$S($$GET1^DIQ(9000010.09,IENS,"1208","I")]"":$$GET1^DIQ(9000010.09,IENS,"1208","I"),1:LAB)
  1.  . S BKMCHI=$S($$GET1^DIQ(9000010.09,IENS,"1208","I")="":0,1:LAB)
  1.  . S ^TMP("BKMVA41",$J,"NEW_SORT",BKMRVDT,BKMACC,BKMPAR,BKMCHI)=""
  1.  ; Build display records
  1.  S (BKMRVDT,BKMPVDT)="" F  S BKMRVDT=$O(^TMP("BKMVA41",$J,"NEW_SORT",BKMRVDT)) Q:BKMRVDT=""  D
  1.  . S BKMACC="" F  S BKMACC=$O(^TMP("BKMVA41",$J,"NEW_SORT",BKMRVDT,BKMACC)) Q:BKMACC=""  D
  1.  . . S BKMPAR="" F  S BKMPAR=$O(^TMP("BKMVA41",$J,"NEW_SORT",BKMRVDT,BKMACC,BKMPAR)) Q:BKMPAR=""  D
  1.  . . . S BKMCHI="" F  S BKMCHI=$O(^TMP("BKMVA41",$J,"NEW_SORT",BKMRVDT,BKMACC,BKMPAR,BKMCHI)) Q:BKMCHI=""  D
  1.  . . . . S DA=$S(BKMCHI>0:BKMCHI,1:BKMPAR)
  1.  . . . . S IENS=$$IENS^DILF(.DA)
  1.  . . . . S BKMVDT=9999999-BKMRVDT
  1.  . . . . S VALMCNT=$G(VALMCNT)+1
  1.  . . . . S TEXT=""
  1.  . . . . ; Display only date and only when not a duplicate of previous entry
  1.  . . . . S TEXT=$$SETFLD^VALM1($S((BKMVDT\1)'=(BKMPVDT\1):$$FMTE^XLFDT(BKMVDT\1,"5Z"),1:""),TEXT,"Visit")
  1.  . . . . S TEXT=$$SETFLD^VALM1($S(BKMCHI>0:"  ",1:"")_$$GET1^DIQ(9000010.09,IENS,".01","E"),TEXT,"Lab Test")
  1.  . . . . S TEXT=$$SETFLD^VALM1($$GET1^DIQ(9000010.09,IENS,".04","E"),TEXT,"Results")
  1.  . . . . S TEXT=$$SETFLD^VALM1($$GET1^DIQ(9000010.09,IENS,"1101","E"),TEXT,"Units")
  1.  . . . . S REFLOW=$$GET1^DIQ(9000010.09,IENS,"1104","E")
  1.  . . . . S REFHIGH=$$GET1^DIQ(9000010.09,IENS,"1105","E")
  1.  . . . . S BKMRNG=REFLOW_"-"_REFHIGH
  1.  . . . . I BKMRNG="-" S BKMRNG=""
  1.  . . . . S TEXT=$$SETFLD^VALM1(BKMRNG,TEXT,"RefRange")
  1.  . . . . D SET^VALM10(VALMCNT,TEXT)
  1.  . . . . S BKMPVDT=BKMVDT
  1.  D ^XBFMK
  1.  Q
  1.  ;
  1. GETDA(DFN,VALUE) ; Return IEN for the Patient DFN with the Register value
  1.  ; Search for the appropriate register VALUE for the patient DFN and return the
  1.  ; patient IEN in the variable DA.
  1.  ; If  the variable VALUE contains a 1 then the IEN for the patient in the 
  1.  ; HIV Management System is returned.
  1.  N DA
  1.  S DA="" F  S DA=$O(^AUPNVLAB("AC",DFN,DA)) Q:DA=""
  1.  Q DA
  1.  ;
  1. HELP ; -- help code
  1.  S X="?" D DISP^XQORM1 W !
  1.  Q
  1.  ;
  1. EXIT ;clean up used variables
  1.  K ^TMP("BKMVA41",$J)
  1.  K VALM0,VALMAR,VALMCNT,VALMHDR
  1.  Q
  1.  ;
  1.  ;