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