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

BKMVA1B.m

Go to the documentation of this file. 
  1. BKMVA1B ;PRXM/HC/BHS - HMS PATIENT REGISTER CONT; [ 8/16/2005 11:33 AM ] ; 16 Aug 2005  11:33 AM
  1.  ;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
  1.  ;
  1.  ; Prompts and functions related to BKMVA1
  1.  Q
  1.  ;
  1. YNP(PROMPT,DFLT) ;EP - Yes/No question
  1.  S DFLT=$G(DFLT)
  1.  D ^XBFMK
  1.  S DIR(0)="Y"
  1.  S DIR("A")=PROMPT
  1.  I DFLT="YES"!(DFLT="NO") S DIR("B")=DFLT
  1.  D ^DIR I $D(DTOUT)!$D(DUOUT) Q 0
  1.  Q $S(+$G(Y)=0:0,1:1)
  1.  ;
  1. FOLL() ;EP -Where Followed prompt
  1.  N BKMIEN,BKMREG,DA,BKMIENS,FOLL
  1.  S BKMIEN=$$BKMIEN^BKMIXX3(DFN)
  1.  S BKMREG=$$BKMREG^BKMIXX3(BKMIEN)
  1.  S DA(1)=BKMIEN,DA=BKMREG
  1.  S BKMIENS=$$IENS^DILF(.DA)
  1.  S FOLL=$$GET1^DIQ(90451.01,BKMIENS,.015,"E")
  1.  I FOLL="" S FOLL=$$GET1^DIQ(4,+$G(DUZ(2)),.01,"E")
  1.  N DIR,Y
  1.  S DIR("B")=FOLL
  1.  S DIR(0)="POr^9999999.06:EZ"
  1.  S DIR("A")="  Where Followed"
  1.  D ^DIR
  1.  I Y=-1,X="@" Q "@"
  1.  I $D(DTOUT)!$D(DUOUT) Q -1
  1.  Q $P(Y,"^")
  1.  ;
  1. DXHIST(BKMIENS,BKMDUZ,BKMDX) ;EP - Update Date/Time of HMS Diagnosis Category History for File 90451
  1.  ; Input variables:
  1.  ;  BKMIENS - IEN list formatted for File 90451.01
  1.  ;  BKMDUZ - User IEN from File 200
  1.  ;  BKMDX  - Internal code from HMS DIAGNOSIS CATEGORY (??)
  1.  ; Output variables:
  1.  ;  Record updated in File 90451
  1.  ; Initialize variables
  1.  N IENS
  1.  I $G(BKMIENS)'="",$G(BKMDUZ)'="" D
  1.  .; Set the data via FileMan API
  1.  .K FDA
  1.  .S IENS="+1,"_BKMIENS
  1.  .;S %DT="ST",X="N" D ^%DT
  1.  .;S FDA(90451.151,IENS,.01)=Y       ; DATE/TIME
  1.  .S FDA(90451.151,IENS,.01)=$$NOW^XLFDT()       ; DATE/TIME
  1.  .S FDA(90451.151,IENS,.02)=BKMDX   ; HMS DIAGNOSIS CATEGORY
  1.  .S FDA(90451.151,IENS,.03)=BKMDUZ  ; EVENT USER (File 200)
  1.  .D UPDATE^DIE("","FDA","")
  1.  .K FDA,%DT,X,Y
  1.  Q
  1.  ;
  1. DIAG(DFN) ;EP - Return HMS Diagnosis Category
  1.  N BKMIEN,BKMREG,DA,BKMIENS
  1.  S BKMIEN=$$BKMIEN^BKMIXX3(DFN)
  1.  S BKMREG=$$BKMREG^BKMIXX3(BKMIEN)
  1.  S DA(1)=BKMIEN,DA=BKMREG
  1.  S BKMIENS=$$IENS^DILF(.DA)
  1.  Q $$GET1^DIQ(90451.01,BKMIENS,2.3,"I")
  1.  ;
  1. LDVAL(IENS) ; Load initial data values for input template BKMV PATIENT RECORD
  1.  N TEMP
  1.  K BKMVAL
  1.  D GETS^DIQ(90451.01,IENS,".5;1;2.3;2.7;3;5;5.5;.015;6;6.5;7","I","TEMP")
  1.  M BKMVAL=TEMP(90451.01,IENS)
  1.  Q
  1.  ;
  1. LDREC(DFN,GUI) ;EP - Load recommended values for HMS Diagnosis Category, Initial HIV Date and
  1.  ; Initial AIDS Date based on taxonomies
  1.  ; this will first load the appropriate taxonomies and then calculate
  1.  ; recommended values and store them in the following variables:
  1.  ; DIAGCAT (Diagnosis); IAIDSDT (Initial AIDS date) ; HAIDSDT (Initial HIV date)
  1.  ;
  1.  ;  Added GUI Flag so as work with iCare
  1.  S GUI=$G(GUI,0)
  1.  I 'GUI D EN^DDIOL("Please wait, calculating default diagnosis category and initial dates.")
  1.  ; Load taxonomies
  1.  D ITAX^BKMVA1U
  1.  ; Created REGDC^BKVMA1C to Process new logic for Recommended Diagnosis Category
  1.  ;D AIDS^BKMVFAP1(DFN) ; Determine recommended values
  1.  D REGDC^BKMVA1C(DFN)
  1.  ; Kill temporary globals used to store taxonomies
  1.  K ^TMP("BKMAIDS",$J),^TMP("BKMHIV",$J),^TMP("BKMCD4",$J)
  1.  K ^TMP("BKMHIVP",$J),^TMP("BKMTST",$J),^TMP("BKMCD4AB",$J)
  1.  Q
  1.  ;
  1. GETDXCAT(DFN) ;
  1.  N BKMIEN,BKMREG,HIVIEN,BKMCHK,BKMVUP,DIAGCAT
  1.  D ^XBFMK
  1.  I '$$BKMPRIV^BKMIXX3(DUZ) D NOGO^BKMIXX3 Q
  1.  S HIVIEN=$$HIVIEN^BKMIXX3()
  1.  I HIVIEN="" Q
  1.  S BKMIEN=$$BKMIEN^BKMIXX3(DFN)
  1.  I BKMIEN="" Q
  1.  S BKMREG=$$BKMREG^BKMIXX3(BKMIEN)
  1.  I BKMREG="" Q
  1.  S DA(1)=BKMIEN,DA=BKMREG
  1.  S BKMIENS=$$IENS^DILF(.DA)
  1.  ; Capture Clinical Classification (3) and HMS Dx Cat (2.3)
  1.  S BKMV("PRE",3)=$$GET1^DIQ(90451.01,BKMIENS,3,"I")
  1.  S BKMV("PRE",2.3)=$$GET1^DIQ(90451.01,BKMIENS,2.3,"I")
  1.  ; Edit fields
  1.  S DIAGCAT=$$DIAG^BKMIXX3() ;Prompt for HMS Diagnosis Category
  1.  I DIAGCAT'=-1,DIAGCAT]"" D
  1.  . S BKMVUP(90451.01,BKMIENS,2.3)=$G(DIAGCAT) K DA
  1.  . D FILE^DIE("I","BKMVUP")
  1.  K DA
  1.  S DA(1)=BKMIEN,DA=BKMREG
  1.  S BKMIENS=$$IENS^DILF(.DA)
  1.  ; Capture Clinical Classification (3) and HMS Dx Cat (2.3)
  1.  S BKMV("POST",3)=$$GET1^DIQ(90451.01,BKMIENS,3,"I")
  1.  S BKMV("POST",2.3)=$$GET1^DIQ(90451.01,BKMIENS,2.3,"I")
  1.  ; Compare pre vs. post
  1.  I BKMV("PRE",3)'=BKMV("POST",3) D
  1.  . ; Update Prior Clincal Classification (3.55) and Clinical Class. Change DT (3.5)
  1.  . ;S %DT="ST",X="N" D ^%DT
  1.  . S DIE="^BKM(90451,"_DA(1)_",1,"
  1.  . S DR="3.55////"_BKMV("PRE",3)_";"
  1.  . ;S DR=DR_"3.5////"_Y_";"
  1.  . S DR=DR_"3.5////"_$$NOW^XLFDT()_";"
  1.  . D ^DIE
  1.  I BKMV("PRE",2.3)'=BKMV("POST",2.3) D
  1.  . ; Update Prior Diagnosis (35)
  1.  . S DIE="^BKM(90451,"_DA(1)_",1,"
  1.  . S DR="35////"_BKMV("PRE",2.3)_";"
  1.  . D ^DIE
  1.  . D DXHIST^BKMVA1B(BKMIEN,BKMREG,DUZ,BKMV("POST",2.3))
  1.  D ^XBFMK
  1.  Q
  1.  ;
  1. DSPCC ;EP - Display Clinical Categories
  1.  ;
  1.  N CC,CCIEN,CCSTR
  1.  S CC=""
  1.  W !!?3,"Select one of the following clinical classifications:"
  1.  F  S CC=$O(^BKMV(90451.7,"B",CC)) Q:CC=""  D
  1.  . S CCIEN=$O(^BKMV(90451.7,"B",CC,"")) Q:CCIEN=""
  1.  . S CCSTR=$G(^BKMV(90451.7,CCIEN,0)) Q:CCSTR=""  W !?3,$P(CCSTR,U),?13,$P(CCSTR,U,2)
  1.  W !
  1.  Q
  1.  ;
  1. DSPCDC ;EP - Display CDC Etiology Categories
  1.  N CDC,CDCIEN,CDCSTR
  1.  S CDC=""
  1.  W !!?3,"Select one of the following CDC Etiology categories:"
  1.  F  S CDC=$O(^BKM(90451.5,"D",CDC)) Q:CDC=""  D
  1.  . S CDCIEN=$O(^BKM(90451.5,"D",CDC,"")) Q:CDCIEN=""
  1.  . S CDCSTR=$G(^BKM(90451.5,CDCIEN,0)) Q:CDCSTR=""  W !?3,$P(CDCSTR,U,2),?13,$P(CDCSTR,U)
  1.  W !
  1.  Q
  1.  ;
  1. PROMPTS(DFN,BKMSKIP) ;EP - Patient Record prompts.
  1.  ; BKMSKIP indicates whether or not prompts that are populated
  1.  ; should be skipped when using input template BKMV PATIENT RECORD
  1.  ; Populates DIRUT if timeout or up-arrow to exit
  1.  N HIVIEN,BKMIEN,BKMREG,BKMIENS
  1.  N BKMV,BKMDIAG,OBKMDIAG,BKMCC
  1.  N BKMETI,FOLL
  1.  S BKMETI=1 ;Flag to Input Template BKMV PATIENT RECORD to prompt for etiology
  1.  ;
  1.  S HIVIEN=$$HIVIEN^BKMIXX3
  1.  S BKMIEN=$$BKMIEN^BKMIXX3(DFN)
  1.  S BKMREG=$$BKMREG^BKMIXX3(BKMIEN)
  1.  S DA(1)=BKMIEN,DA=BKMREG
  1.  S BKMIENS=$$IENS^DILF(.DA)
  1.  S DIE("NO^")="OUTOK"
  1.  ; Initialize output variable identifying timeout or up-arrow
  1.  K DIRUT
  1.  ; Builds BKMV("PRE") array
  1.  D GETVALS(BKMIENS,"PRE")
  1.  D FULL^VALM1
  1.  K DA
  1.  S DA=BKMIEN,DIE="^BKM(90451,",DR="[BKMV PATIENT RECORD]"
  1.  I '$$BKMPRIV^BKMIXX3(DUZ) D NOGO^BKMIXX3 Q
  1.  ; Attempt to lock register record
  1.  L +^BKM(90451,BKMIEN):0 I '$T D EN^DDIOL("Another user is editing this entry.") H 2 G PROMPTX
  1.  D ^DIE
  1.  ;Leave in commented lines until input template BKMV PATIENT RECORD has been confirmed
  1.  ; Status
  1.  ;I '$$EXISTRST^BKMVA1A(DFN,HIVIEN) D GETRSTAT^BKMVA1A(DFN)
  1.  ;Q:$D(DIRUT)
  1.  ; Status comments, if no Status
  1.  ;I '$$EXISTRST^BKMVA1A(DFN,HIVIEN),'$$EXISTRSC^BKMVA1A(DFN,HIVIEN) D GETRSCOM^BKMVA1A(DFN)
  1.  ;Q:$D(DIRUT)
  1.  ; HMS dx category
  1.  ;I '$$EXISTHDC^BKMVA1A(DFN,HIVIEN) D GETDXCAT(DFN)
  1.  ;Q:$D(DIRUT)
  1.  ; Initial HIV dx date
  1.  ;I '$$EXISTIHD^BKMVA1A(DFN,HIVIEN) D GETIHDDT^BKMVA1A(DFN)
  1.  ;Q:$D(DIRUT)
  1.  ; Initial AIDS dx date
  1.  ;I '$$EXISTIAD^BKMVA1A(DFN,HIVIEN) D GETIADDT^BKMVA1A(DFN)
  1.  ;Q:$D(DIRUT)
  1.  ; Location
  1.  ;I '$$EXISTFOL^BKMVA1A(DFN,HIVIEN) D GETFOL^BKMVA1A(DFN)
  1.  ;Q:$D(DIRUT)
  1.  ; Provider
  1.  ;I '$$EXISTRP^BKMVA1A(DFN) D GETRP^BKMVA1A(DFN)
  1.  ;Q:$D(DIRUT)
  1.  ; Case manager
  1.  ;I '$$EXISTCM^BKMVA1A(DFN) D GETCM^BKMVA1A(DFN)
  1.  ;Q:$D(DIRUT)
  1.  ; Etiology
  1.  ;I '$$EXISTETI^BKMVA1A(DFN) D GETETI^BKMVA1A(DFN)
  1.  ;Q:$D(DIRUT)
  1.  S BKMIEN=$$BKMIEN^BKMIXX3(DFN)
  1.  S BKMREG=$$BKMREG^BKMIXX3(BKMIEN)
  1.  K DA
  1.  S DA(1)=BKMIEN,DA=BKMREG
  1.  S BKMIENS=$$IENS^DILF(.DA)
  1.  ; Builds BKMV("POST") array
  1.  D GETVALS(BKMIENS,"POST")
  1.  ; Populate triggered fields based on changes
  1.  D COMPVALS(BKMIENS,"PRE","POST")
  1.  ; Unlock register record
  1.  L -^BKM(90451,BKMIEN)
  1. PROMPTX ; Secondary point following unsuccessful lock attempt
  1.  ; Notifications including state reporting status, state confirmation status and partner notification status
  1.  ; PRXM/HC/BHS - 05/22/2006 - Update prompt text per IHS
  1.  ;I '$$EXISTNOT^BKMVA1A(DFN) I $$YNP^BKMVA1B("  Do you want to add notification data to this patient","NO") D GETNOT^BKMVA1A(DFN)
  1.  I '$$EXISTNOT^BKMVA1A(DFN) I $$YNP^BKMVA1B("  Do you want to add State or partner notification data now","NO") D GETNOT^BKMVA1A(DFN)
  1.  Q:$D(DIRUT)
  1.  ; HAART Appropriate and Compliance
  1.  ; PRXM/HC/BHS - 05/22/2006 - Update prompt text per IHS
  1.  ;I '$$EXISTHAP^BKMVA1A(DFN,HIVIEN) I $$YNP^BKMVA1B("  Do you want to add HAART Appropriate or Compliance data to this patient","NO") D GETHAP^BKMVA1A(DFN)
  1.  I '$$EXISTHAP^BKMVA1A(DFN,HIVIEN) I $$YNP^BKMVA1B("  Do you want to add data related to HAART medications now","NO") D GETHAP^BKMVA1A(DFN)
  1.  Q
  1.  ;
  1. GETVALS(IENS,TYP) ;EP - Called from TESTEDIT^BKMVA1A
  1.  ; Build pre/post edit fields to track changes
  1.  N TEMP
  1.  K BKMV(TYP)
  1.  ; Capture Status (.5), Clinical Classification (3), HMS Dx Cat (2.3)
  1.  ;         (5), (5.5) and Etiology (7)
  1.  ; PRX/DLS 4/5/06 Added prompt for Etiology Comments (7.5)
  1.  D GETS^DIQ(90451.01,IENS,".5;2.3;3;5;5.5;7;7.5","I","TEMP")
  1.  M BKMV(TYP)=TEMP(90451.01,IENS)
  1.  Q
  1.  ;
  1. COMPVALS(IENS,TYP1,TYP2) ;EP - Called from TESTEDIT^BKMVA1A
  1.  ; Compare pre/post edit fields to populate other fields
  1.  ; Assumes existence of BKMV array
  1.  ; Inputs:
  1.  ;   TYP1 = Subscript value like "PRE"
  1.  ;   TYP2 = Subscript value like "POST"
  1.  N BKMCC
  1.  I $G(TYP1)=""!($G(TYP2)="") Q
  1.  I '$D(BKMV(TYP1))!'$D(BKMV(TYP2)) Q
  1.  K BKMCC
  1.  ; Delete clinical classification and initial dxs if at risk dx category
  1.  I '$F("^H^A^",U_BKMV(TYP2,2.3,"I")_U) D
  1.  . S BKMCC(90451.01,BKMIENS,3)=""
  1.  . S BKMCC(90451.01,BKMIENS,3.5)=""
  1.  . S BKMCC(90451.01,BKMIENS,5)=""
  1.  . S BKMCC(90451.01,BKMIENS,5.5)=""
  1.  ; Delete initial AIDS dx if HIV dx category
  1.  I BKMV(TYP2,2.3,"I")="H" D
  1.  . S BKMCC(90451.01,BKMIENS,5.5)=""
  1.  ; Compare pre vs. post
  1.  I BKMV(TYP1,.5,"I")'=BKMV(TYP2,.5,"I") D
  1.  . ; Update Prior Status (.55)
  1.  . S BKMCC(90451.01,BKMIENS,.55)=BKMV(TYP1,.5,"I")
  1.  I BKMV(TYP1,3,"I")'=BKMV(TYP2,3,"I") D
  1.  . ; Update Prior Clinical Classification (3.55) and Clinical Class. Change DT (3.5)
  1.  . S BKMCC(90451.01,BKMIENS,3.55)=BKMV(TYP1,3,"I")
  1.  . S BKMCC(90451.01,BKMIENS,3.5)=$$NOW^XLFDT()
  1.  ; Evaluate if HMS Diagnosis Category has changed; if so update it
  1.  I BKMV(TYP1,2.3,"I")'=BKMV(TYP2,2.3,"I") D
  1.  . ; Update Prior Diagnosis (35)
  1.  . S BKMCC(90451.01,BKMIENS,35)=BKMV(TYP1,2.3,"I")
  1.  . D DXHIST^BKMVA1B(BKMIENS,DUZ,BKMV(TYP2,2.3,"I"))
  1.  ; Evaluate if Etiology has changed; if so update Etiology Last Update (7.51)
  1.  I BKMV(TYP1,7,"I")'=BKMV(TYP2,7,"I") D
  1.  . S BKMCC(90451.01,BKMIENS,7.51)=$$NOW^XLFDT()
  1.  D FILE^DIE("","BKMCC")
  1.  Q
  1.  ;
  1.  ;