BKMVA9 ;PRXM/HC/JGH-HMS PATIENT REGISTER; [ 1/19/2005 7:16 PM ] ; 09 Jun 2005 12:58 PM
;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
;
EN ; -EP for BKMV UPD1 State
N HIVIEN,ENTER
S HIVIEN=$$HIVIEN^BKMIXX3()
I HIVIEN="" W !,"There is no HMS register defined." H 2 Q
I '$$VALID^BKMIXX3(DUZ) Q
; DAOU/BHS-12/29/05-Removed Sec check-enforced w/i each opt
;I '$$BKMPRIV^BKMIXX3(DUZ) D NOGO^BKMIXX3 Q
;
K ^TMP("BKMVA9",$J)
D EN^VALM("BKMV UPD1 STATE")
K ^TMP("BKMVA9",$J)
I '$$GETALL^BKMVA1(DFN) W !,"No Patient entered or Patient Not In Register <Enter>" H 2 Q
D INIT^BKMVA1
Q
;
EXEN ; EP -Called by GETNOT^BKMVA1A
; Assume DFN exists
N HIVIEN
S HIVIEN=$$HIVIEN^BKMIXX3()
I HIVIEN="" W !,"There is no HMS register defined." H 2 Q
I '$$VALID^BKMIXX3(DUZ) W !,"You are not a valid HMS user." H 2 Q
;
K ^TMP("BKMVA9",$J)
D EN^VALM("BKMV UPD1 STATE")
K ^TMP("BKMVA9",$J)
Q
;
HDR ; -header
D HDR^BKMVA51
Q
;
INIT ; -init vars & list array
D GETALL
Q
;
GETALL ;
N VALMPGE,PNOT,BKMVA9,PDAT,TEXT,BKMVA9E,DA0,DA1,DA2,IENS,CAT,BKMDT,RSTAT
N BKMSTAT,BKMSTATI,PNOTI,BKMDTE
D ^XBFMK
S VALMCNT=0,VALMPGE=1,VALMAR="^TMP(""BKMVA9"","_$J_")",VALM0=""
S DA2=$$BKMIEN^BKMIXX3(DFN)
S DA1=$$BKMREG^BKMIXX3(DA2)
K DA
S DA=DA1,DA(1)=DA2
S IENS=$$IENS^DILF(.DA)
;DAOU/ALA 9/21/05 Modified State Reprtng data to reflect new fields
;D GETS^DIQ(90451.01,IENS,"4;4.1;4.2;4.3;4.5;4.51;4.52;4.53","E","BKMVA9","BKMVA9E")
; DAOU/BHS-10/31/05-Modified to translate dates to consistent format
; DAOU/BHS-11/30/05-Modified display order per IHS & add date entered display, etc
D GETS^DIQ(90451.01,IENS,"4.1;4.3;4.51;4.53","EI","BKMVA9","BKMVA9E")
S TEXT=""
S TEXT=$$SETFLD^VALM1("State Reporting Category:",TEXT,"Type")
S TEXT=$$SETFLD^VALM1("HIV",TEXT,"Status")
S TEXT=$$SETFLD^VALM1("",TEXT,"Date Entered")
S VALMCNT=$G(VALMCNT)+1 D SET^VALM10(VALMCNT,TEXT)
S BKMSTAT=$G(BKMVA9("90451.01",IENS,"4.3","E")),(BKMSTATI,RSTAT)=$G(BKMVA9("90451.01",IENS,"4.3","I"))
S BKMDT=$$FMTE^XLFDT($S($$GET1^DIQ(90451.01,IENS,"4","I")'="":$$GET1^DIQ(90451.01,IENS,"4","I")\1,1:""),"1")
S BKMDTE=$$FMTE^XLFDT($S($$GET1^DIQ(90451.01,IENS,"4.4","I")'="":$$GET1^DIQ(90451.01,IENS,"4.4","I")\1,1:""),"1")
S TEXT=""
S TEXT=$$SETFLD^VALM1("Reported to State?",TEXT,"Type")
S TEXT=$$SETFLD^VALM1(BKMSTAT_$S(BKMSTATI="Y"&(BKMDT'=""):" - "_BKMDT,1:""),TEXT,"Status")
S TEXT=$$SETFLD^VALM1(BKMDTE,TEXT,"Date Entered")
S VALMCNT=$G(VALMCNT)+1 D SET^VALM10(VALMCNT,TEXT)
S BKMSTAT=$S(RSTAT="Y":$G(BKMVA9("90451.01",IENS,"4.1","E")),1:"")
S BKMSTATI=$S(RSTAT="Y":$G(BKMVA9("90451.01",IENS,"4.1","I")),1:"")
S BKMDT=$S(RSTAT="Y":$$FMTE^XLFDT($S($$GET1^DIQ(90451.01,IENS,"4.2","I")'="":$$GET1^DIQ(90451.01,IENS,"4.2","I")\1,1:""),"1"),1:"")
S BKMDTE=$$FMTE^XLFDT($S($$GET1^DIQ(90451.01,IENS,"4.41","I")'="":$$GET1^DIQ(90451.01,IENS,"4.41","I")\1,1:""),"1")
S TEXT=""
S TEXT=$$SETFLD^VALM1("Confirmed by State?",TEXT,"Type")
S TEXT=$$SETFLD^VALM1(BKMSTAT_$S(BKMSTATI="Y"&(BKMDT'=""):" - "_BKMDT,1:""),TEXT,"Status")
S TEXT=$$SETFLD^VALM1(BKMDTE,TEXT,"Date Entered")
S VALMCNT=$G(VALMCNT)+1 D SET^VALM10(VALMCNT,TEXT)
S VALMCNT=$$I^BKMIXX3($G(VALMCNT),) D SET^VALM10(VALMCNT,"") ; A blank line
S TEXT=""
S TEXT=$$SETFLD^VALM1("State Reporting Category:",TEXT,"Type")
S TEXT=$$SETFLD^VALM1("AIDS",TEXT,"Status")
S TEXT=$$SETFLD^VALM1("",TEXT,"Date Entered")
S VALMCNT=$G(VALMCNT)+1 D SET^VALM10(VALMCNT,TEXT)
S BKMSTAT=$G(BKMVA9("90451.01",IENS,"4.53","E")),(BKMSTATI,RSTAT)=$G(BKMVA9("90451.01",IENS,"4.53","I"))
S BKMDT=$$FMTE^XLFDT($S($$GET1^DIQ(90451.01,IENS,"4.5","I")'="":$$GET1^DIQ(90451.01,IENS,"4.5","I")\1,1:""),"1")
S BKMDTE=$$FMTE^XLFDT($S($$GET1^DIQ(90451.01,IENS,"4.54","I")'="":$$GET1^DIQ(90451.01,IENS,"4.54","I")\1,1:""),"1")
S TEXT=""
S TEXT=$$SETFLD^VALM1("Reported to State?",TEXT,"Type")
S TEXT=$$SETFLD^VALM1(BKMSTAT_$S(BKMSTATI="Y"&(BKMDT'=""):" - "_BKMDT,1:""),TEXT,"Status")
S TEXT=$$SETFLD^VALM1(BKMDTE,TEXT,"Date Entered")
S VALMCNT=$G(VALMCNT)+1 D SET^VALM10(VALMCNT,TEXT)
S BKMSTAT=$S(RSTAT="Y":$G(BKMVA9("90451.01",IENS,"4.51","E")),1:"")
S BKMSTATI=$S(RSTAT="Y":$G(BKMVA9("90451.01",IENS,"4.51","I")),1:"")
S BKMDT=$S(RSTAT="Y":$$FMTE^XLFDT($S($$GET1^DIQ(90451.01,IENS,"4.52","I")'="":$$GET1^DIQ(90451.01,IENS,"4.52","I")\1,1:""),"1"),1:"")
S BKMDTE=$$FMTE^XLFDT($S($$GET1^DIQ(90451.01,IENS,"4.541","I")'="":$$GET1^DIQ(90451.01,IENS,"4.541","I")\1,1:""),"1")
S TEXT=""
S TEXT=$$SETFLD^VALM1("Confirmed by State?",TEXT,"Type")
S TEXT=$$SETFLD^VALM1(BKMSTAT_$S(BKMSTATI="Y"&(BKMDT'=""):" - "_BKMDT,1:""),TEXT,"Status")
S TEXT=$$SETFLD^VALM1(BKMDTE,TEXT,"Date Entered")
S VALMCNT=$G(VALMCNT)+1 D SET^VALM10(VALMCNT,TEXT)
;
S VALMCNT=$$I^BKMIXX3($G(VALMCNT),) D SET^VALM10(VALMCNT,"") ; A blank line
; Partnr Notify Status-only display if exists
S PNOT=$$GET1^DIQ(90451.01,IENS,"15","E"),PNOTI=$$GET1^DIQ(90451.01,IENS,"15","I")
S PDAT=$$FMTE^XLFDT($S($$GET1^DIQ(90451.01,IENS,"16","I")'="":$$GET1^DIQ(90451.01,IENS,"16","I")\1,1:""),"1")
S BKMDTE=$$FMTE^XLFDT($S($$GET1^DIQ(90451.01,IENS,"17","I")'="":$$GET1^DIQ(90451.01,IENS,"17","I")\1,1:""),"1")
S TEXT=""
S TEXT=$$SETFLD^VALM1("Partner Notification Status:",TEXT,"Type")
S TEXT=$$SETFLD^VALM1(PNOT_$S(PNOTI="Y"&(PDAT'=""):" - "_PDAT,1:""),TEXT,"Status")
S TEXT=$$SETFLD^VALM1(BKMDTE,TEXT,"Date Entered")
S VALMCNT=$G(VALMCNT)+1 D SET^VALM10(VALMCNT,TEXT)
;
D ^XBFMK
Q
;
MAINFORM ; State Reporting/Confirmation
; Assume DFN & DUZ exist
; OSTAT utilized in input template
N BKMPRIV,HIVIEN,BKMIEN,BKMREG,BKMV,BKMIENS,OSTAT
D ^XBFMK
S BKMPRIV=$$BKMPRIV^BKMIXX3(DUZ)
I 'BKMPRIV D NOGO^BKMIXX3 Q
S HIVIEN=$$HIVIEN^BKMIXX3()
Q:HIVIEN=""
S BKMIEN=$$BKMIEN^BKMIXX3(DFN)
Q:BKMIEN=""
S BKMREG=$$BKMREG^BKMIXX3(BKMIEN)
Q:BKMREG=""
D ^XBFMK
D FULL^VALM1
; PRXM/BHS-04/04/06-Removed
;D EN^BKMVAUD
; DAOU/BHS-12/01/05-Orig vals for 'Date Entered' if changed
; Capture fields: 4,4.1,4.2,4.3,4.5,4.51,4.52,4.53
K DA
S DA(1)=BKMIEN,DA=BKMREG
S BKMIENS=$$IENS^DILF(.DA)
S BKMV("PRE",4)=$$GET1^DIQ(90451.01,BKMIENS,4,"I")
S BKMV("PRE",4.1)=$$GET1^DIQ(90451.01,BKMIENS,4.1,"I")
S BKMV("PRE",4.2)=$$GET1^DIQ(90451.01,BKMIENS,4.2,"I")
S BKMV("PRE",4.3)=$$GET1^DIQ(90451.01,BKMIENS,4.3,"I")
S BKMV("PRE",4.5)=$$GET1^DIQ(90451.01,BKMIENS,4.5,"I")
S BKMV("PRE",4.51)=$$GET1^DIQ(90451.01,BKMIENS,4.51,"I")
S BKMV("PRE",4.52)=$$GET1^DIQ(90451.01,BKMIENS,4.52,"I")
S BKMV("PRE",4.53)=$$GET1^DIQ(90451.01,BKMIENS,4.53,"I")
K DA
S DA=BKMIEN,DIE="^BKM(90451,",DR="[BKMV PATIENT RECORD STATE]"
L +^BKM(90451,BKMIEN):0 I '$T D EN^DDIOL("Another user is editing this entry.") H 2 G MAINX
D ^DIE K SRCAT
H 1
; DAOU/BHS-12/01/05-Update 'Date Entered' if changed
; Capture fields: 4,4.1,4.2,4.3,4.5,4.51,4.52,4.53
K DA
S DA(1)=BKMIEN,DA=BKMREG
S BKMIENS=$$IENS^DILF(.DA)
S BKMV("POST",4)=$$GET1^DIQ(90451.01,BKMIENS,4,"I")
S BKMV("POST",4.1)=$$GET1^DIQ(90451.01,BKMIENS,4.1,"I")
S BKMV("POST",4.2)=$$GET1^DIQ(90451.01,BKMIENS,4.2,"I")
S BKMV("POST",4.3)=$$GET1^DIQ(90451.01,BKMIENS,4.3,"I")
S BKMV("POST",4.5)=$$GET1^DIQ(90451.01,BKMIENS,4.5,"I")
S BKMV("POST",4.51)=$$GET1^DIQ(90451.01,BKMIENS,4.51,"I")
S BKMV("POST",4.52)=$$GET1^DIQ(90451.01,BKMIENS,4.52,"I")
S BKMV("POST",4.53)=$$GET1^DIQ(90451.01,BKMIENS,4.53,"I")
; Compare pre vs post
I (BKMV("PRE",4)'=BKMV("POST",4))!(BKMV("PRE",4.3)'=BKMV("POST",4.3)) D
. ; STATE HIV RPT LAST UPDATED (4.4)
. S DIE="^BKM(90451,"_DA(1)_",1,"
. S DR="4.4////"_$$NOW^XLFDT()_";"
. D ^DIE
I (BKMV("PRE",4.1)'=BKMV("POST",4.1))!(BKMV("PRE",4.2)'=BKMV("POST",4.2)) D
. ; STATE HIV ACK LAST UPDATED (4.41)
. S DIE="^BKM(90451,"_DA(1)_",1,"
. S DR="4.41////"_$$NOW^XLFDT()_";"
. D ^DIE
I (BKMV("PRE",4.5)'=BKMV("POST",4.5))!(BKMV("PRE",4.53)'=BKMV("POST",4.53)) D
. ; STATE AIDS RPT LAST UPDATED (4.54)
. S DIE="^BKM(90451,"_DA(1)_",1,"
. S DR="4.54////"_$$NOW^XLFDT()_";"
. D ^DIE
I (BKMV("PRE",4.51)'=BKMV("POST",4.51))!(BKMV("PRE",4.52)'=BKMV("POST",4.52)) D
. ; STATE AIDS ACK LAST UPDATED (4.541)
. S DIE="^BKM(90451,"_DA(1)_",1,"
. S DR="4.541////"_$$NOW^XLFDT()_";"
. D ^DIE
L -^BKM(90451,BKMIEN)
; PRXM/BHS-04/04/06-Removed
;D POST^BKMVAUD
MAINX ; Exit point for MAINFORM
K ^TMP("BKMVA9",$J)
D GETALL
Q
;
PNOTFORM ; Partner notification
; Assume DFN & DUZ exist
; OSTAT utilized in input template
N BKMPRIV,HIVIEN,BKMIEN,BKMREG,IENS,BKMV,BKMIENS,OSTAT
D ^XBFMK
S BKMPRIV=$$BKMPRIV^BKMIXX3(DUZ)
I 'BKMPRIV D NOGO^BKMIXX3 Q
S HIVIEN=$$HIVIEN^BKMIXX3()
Q:HIVIEN=""
S BKMIEN=$$BKMIEN^BKMIXX3(DFN)
Q:BKMIEN=""
S BKMREG=$$BKMREG^BKMIXX3(BKMIEN)
Q:BKMREG=""
D ^XBFMK
D FULL^VALM1
; PRXM/BHS-04/04/06-Removed
;D EN^BKMVAUD
; DAOU/BHS-12/01/05-Track original values to track 'Date Entered' for changes
; Capture fields: 15,16
K DA
S DA(1)=BKMIEN,DA=BKMREG
S BKMIENS=$$IENS^DILF(.DA)
S BKMV("PRE",15)=$$GET1^DIQ(90451.01,BKMIENS,15,"I")
S BKMV("PRE",16)=$$GET1^DIQ(90451.01,BKMIENS,16,"I")
K DA
S DA(1)=BKMIEN,DA=BKMREG,IENS=$$IENS^DILF(.DA)
L +^BKM(90451,BKMIEN):0 I '$T D EN^DDIOL("Another user is editing this entry.") H 2 G PNOTX
; If PARTNER NOTIFICATION STATUS (#15) is null, default it
I $$GET1^DIQ(90451.01,IENS,"15","I")="" D
. ; Default to 'Unknown'
. S DIE="^BKM(90451,"_DA(1)_",1,"
. S DR="15////U;"
. D ^DIE
K DA
S DA=BKMIEN,DIE="^BKM(90451,",DR="[BKMV UPD1 PNOT]"
D ^DIE
H 1
; DAOU/BHS-12/01/05-Update 'Date Entered' fields where appropriate
; Capture fields: 15,16
K DA
S DA(1)=BKMIEN,DA=BKMREG
S BKMIENS=$$IENS^DILF(.DA)
S BKMV("POST",15)=$$GET1^DIQ(90451.01,BKMIENS,15,"I")
S BKMV("POST",16)=$$GET1^DIQ(90451.01,BKMIENS,16,"I")
; Compare pre vs post
I BKMV("PRE",15)'=BKMV("POST",15)!(BKMV("PRE",16)'=BKMV("POST",16)) D
. ; PARTNER NOTIFIED LAST UPDATED (17)
. S DIE="^BKM(90451,"_DA(1)_",1,"
. S DR="17////"_$$NOW^XLFDT()_";"
. D ^DIE
L -^BKM(90451,BKMIEN)
; PRXM/BHS-04/04/06-Removed
;D POST^BKMVAUD
PNOTX ; PNOTFORM Exit point
K ^TMP("BKMVA9",$J)
D GETALL
Q
;
HELP ; -help
S X="?" D DISP^XQORM1 W !
Q
;
EXIT ; -exit
K VALM0,VALMAR,VALMHDR,VALMCNT
Q
;
YNP(PROMPT,DFLT) ;Yes/No question
N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,TEXT,DIWL,DIWR,BKMTOT,II
S DFLT=$G(DFLT)
S DIR(0)="Y"
; If PROMPT is > 1 line, split with ^DIWP
I $L(PROMPT)>77 D
. K ^UTILITY($J,"W")
. S X=PROMPT,DIWL=1,DIWR=77 D ^DIWP
. S BKMTOT=+$G(^UTILITY($J,"W",DIWL))
. F II=1:1:BKMTOT D
. . S TEXT=$G(^UTILITY($J,"W",DIWL,II,0))
. . I $E(TEXT,$L(TEXT))=" " S TEXT=$E(TEXT,1,$L(TEXT)-1)
. . I II<BKMTOT S DIR("A",II)=TEXT
. . I II=BKMTOT S DIR("A")=TEXT
I $L(PROMPT)<78 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)
;
STAT(DFN,FLD) ; get current AIDS/HIV State Reportng/Confirmation or Partnr Notification Status
N STAT,BKMIEN,BKMREG
S STAT=""
S BKMIEN=$$BKMIEN^BKMIXX3(DFN)
I BKMIEN="" Q STAT
S BKMREG=$$BKMREG^BKMIXX3(BKMIEN)
I BKMREG="" Q STAT
S STAT=$$GET1^DIQ(90451.01,BKMREG_","_BKMIEN_",",FLD,"I")
Q STAT
;
HIVRDT ; EP -Input Transform for State HIV Reporting DT
N Y,HIVCDT,DOB,DFN
S HIVCDT=$$GET1^DIQ(90451.01,DA_","_DA(1)_",",4.2,"I")
S DFN=$$GET1^DIQ(90451,DA(1)_",",.01,"I")
S DOB=$$GET1^DIQ(2,DFN,.03,"I")
S %DT="EX" D ^%DT S X=Y
I Y=-1 K X S BFL=1 Q
I DOB>X K X Q
I X>DT K X Q
I HIVCDT'="",X>HIVCDT K X Q
Q
;
HIVCDT ; EP -Input Transform for State HIV Confirmation DT
N Y,HIVRDT,DOB,DFN
S HIVRDT=$$GET1^DIQ(90451.01,DA_","_DA(1)_",",4,"I")
S DFN=$$GET1^DIQ(90451,DA(1)_",",.01,"I")
S DOB=$$GET1^DIQ(2,DFN,.03,"I")
S %DT="EX" D ^%DT S X=Y
I Y=-1 K X S BFL=1 Q
I DOB>X K X Q
I X>DT K X Q
I HIVRDT'="",X<HIVRDT K X Q
Q
;
AIDRDT ; EP -Input Transform for State AIDS Reporting DT
N Y,AIDCDT,DOB,DFN
S AIDCDT=$$GET1^DIQ(90451.01,DA_","_DA(1)_",",4.52,"I")
S DFN=$$GET1^DIQ(90451,DA(1)_",",.01,"I")
S DOB=$$GET1^DIQ(2,DFN,.03,"I")
S %DT="EX" D ^%DT S X=Y
I Y=-1 K X S BFL=1 Q
I DOB>X K X Q
I X>DT K X Q
I AIDCDT'="",X>AIDCDT K X Q
Q
;
AIDCDT ; EP -Input Transform for State AIDS Confirmation DT
N Y,AIDRDT,DOB,DFN
S AIDRDT=$$GET1^DIQ(90451.01,DA_","_DA(1)_",",4.5,"I")
S DFN=$$GET1^DIQ(90451,DA(1)_",",.01,"I")
S DOB=$$GET1^DIQ(2,DFN,.03,"I")
S %DT="EX" D ^%DT S X=Y
I Y=-1 K X S BFL=1 Q
I DOB>X K X Q
I X>DT K X Q
I AIDRDT'="",X<AIDRDT K X Q
Q
;
PNOTDT ; EP -Input Transform for Partner Notification DT
NEW Y,DOB,DFN
S DFN=$$GET1^DIQ(90451,DA(1)_",",.01,"I")
S DOB=$$GET1^DIQ(2,DFN,.03,"I")
S %DT="EX" D ^%DT S X=Y
I Y=-1 K X S BFL=1 Q
I DOB>X K X Q
I X>DT K X Q
Q
;
HIVRHLP ; EP -HIV State Reporting DT Special Help
S DV=""
K HELP
I $G(BFL) D HELP^%DTC K BFL Q
I X["BAD" D
. S HELP(1)="The State HIV reporting date must be previous to the State HIV confirmation"
. S HELP(1,"F")="?5"
. S HELP(2)="date, if it exists, and not previous to the Date of Birth and not in the future."
. S HELP(2,"F")="!?5"
. S HELP(3)="Please reenter the date."
. S HELP(3,"F")="!?5"
. D EN^DDIOL(.HELP)
K HELP
Q
;
HIVCHLP ; EP -HIV State Confirmation DT Special Help
S DV=""
K HELP
I $G(BFL) D HELP^%DTC K BFL Q
I X["BAD" D
. S HELP(1)="The State HIV confirmation date must be on or after the State HIV reporting"
. S HELP(1,"F")="?5"
. S HELP(2)="date, if it exists, and not previous to the Date of Birth and not in the future."
. S HELP(2,"F")="!?5"
. S HELP(3)="Please reenter the date."
. S HELP(3,"F")="!?5"
. D EN^DDIOL(.HELP)
K HELP
Q
;
AIDRHLP ; EP -AIDS State Reporting DT Special Help
S DV=""
K HELP
I $G(BFL) D HELP^%DTC K BFL Q
I X["BAD" D
. S HELP(1)="The State AIDS reporting date must be previous to the State AIDS confirmation"
. S HELP(1,"F")="?5"
. S HELP(2)="date, if it exists, and not previous to the Date of Birth and not in the future."
. S HELP(2,"F")="!?5"
. S HELP(3)="Please reenter the date."
. S HELP(3,"F")="!?5"
. D EN^DDIOL(.HELP)
K HELP
Q
;
AIDCHLP ; EP -AIDS State Confirmation DT Special Help
S DV=""
K HELP
I $G(BFL) D HELP^%DTC K BFL Q
I X["BAD" D
. S HELP(1)="The State AIDS confirmation date must on or after the State AIDS reporting"
. S HELP(1,"F")="?5"
. S HELP(2)="date, if it exists, and not previous to the Date of Birth and not in the future."
. S HELP(2,"F")="!?5"
. S HELP(3)="Please reenter the date."
. S HELP(3,"F")="!?5"
. D EN^DDIOL(.HELP)
K HELP
Q
;
PNOTHLP ; EP -Partner Notification Special Help
S DV=""
K HELP
I $G(BFL) D HELP^%DTC K BFL Q
I X["BAD" D
. S HELP(1)="The partner notification date must not precede the Date of Birth and"
. S HELP(1,"F")="?5"
. S HELP(2)="cannot be in the future. Please reenter the date."
. S HELP(2,"F")="!?5"
. D EN^DDIOL(.HELP)
K HELP
Q
BKMVA9 ;PRXM/HC/JGH-HMS PATIENT REGISTER; [ 1/19/2005 7:16 PM ] ; 09 Jun 2005 12:58 PM
+1 ;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;
EN ; -EP for BKMV UPD1 State
+1 NEW HIVIEN,ENTER
+2 SET HIVIEN=$$HIVIEN^BKMIXX3()
+3 IF HIVIEN=""
WRITE !,"There is no HMS register defined."
HANG 2
QUIT
+4 IF '$$VALID^BKMIXX3(DUZ)
QUIT
+5 ; DAOU/BHS-12/29/05-Removed Sec check-enforced w/i each opt
+6 ;I '$$BKMPRIV^BKMIXX3(DUZ) D NOGO^BKMIXX3 Q
+7 ;
+8 KILL ^TMP("BKMVA9",$JOB)
+9 DO EN^VALM("BKMV UPD1 STATE")
+10 KILL ^TMP("BKMVA9",$JOB)
+11 IF '$$GETALL^BKMVA1(DFN)
WRITE !,"No Patient entered or Patient Not In Register <Enter>"
HANG 2
QUIT
+12 DO INIT^BKMVA1
+13 QUIT
+14 ;
EXEN ; EP -Called by GETNOT^BKMVA1A
+1 ; Assume DFN exists
+2 NEW HIVIEN
+3 SET HIVIEN=$$HIVIEN^BKMIXX3()
+4 IF HIVIEN=""
WRITE !,"There is no HMS register defined."
HANG 2
QUIT
+5 IF '$$VALID^BKMIXX3(DUZ)
WRITE !,"You are not a valid HMS user."
HANG 2
QUIT
+6 ;
+7 KILL ^TMP("BKMVA9",$JOB)
+8 DO EN^VALM("BKMV UPD1 STATE")
+9 KILL ^TMP("BKMVA9",$JOB)
+10 QUIT
+11 ;
HDR ; -header
+1 DO HDR^BKMVA51
+2 QUIT
+3 ;
INIT ; -init vars & list array
+1 DO GETALL
+2 QUIT
+3 ;
GETALL ;
+1 NEW VALMPGE,PNOT,BKMVA9,PDAT,TEXT,BKMVA9E,DA0,DA1,DA2,IENS,CAT,BKMDT,RSTAT
+2 NEW BKMSTAT,BKMSTATI,PNOTI,BKMDTE
+3 DO ^XBFMK
+4 SET VALMCNT=0
SET VALMPGE=1
SET VALMAR="^TMP(""BKMVA9"","_$JOB_")"
SET VALM0=""
+5 SET DA2=$$BKMIEN^BKMIXX3(DFN)
+6 SET DA1=$$BKMREG^BKMIXX3(DA2)
+7 KILL DA
+8 SET DA=DA1
SET DA(1)=DA2
+9 SET IENS=$$IENS^DILF(.DA)
+10 ;DAOU/ALA 9/21/05 Modified State Reprtng data to reflect new fields
+11 ;D GETS^DIQ(90451.01,IENS,"4;4.1;4.2;4.3;4.5;4.51;4.52;4.53","E","BKMVA9","BKMVA9E")
+12 ; DAOU/BHS-10/31/05-Modified to translate dates to consistent format
+13 ; DAOU/BHS-11/30/05-Modified display order per IHS & add date entered display, etc
+14 DO GETS^DIQ(90451.01,IENS,"4.1;4.3;4.51;4.53","EI","BKMVA9","BKMVA9E")
+15 SET TEXT=""
+16 SET TEXT=$$SETFLD^VALM1("State Reporting Category:",TEXT,"Type")
+17 SET TEXT=$$SETFLD^VALM1("HIV",TEXT,"Status")
+18 SET TEXT=$$SETFLD^VALM1("",TEXT,"Date Entered")
+19 SET VALMCNT=$GET(VALMCNT)+1
DO SET^VALM10(VALMCNT,TEXT)
+20 SET BKMSTAT=$GET(BKMVA9("90451.01",IENS,"4.3","E"))
SET (BKMSTATI,RSTAT)=$GET(BKMVA9("90451.01",IENS,"4.3","I"))
+21 SET BKMDT=$$FMTE^XLFDT($SELECT($$GET1^DIQ(90451.01,IENS,"4","I")'="":$$GET1^DIQ(90451.01,IENS,"4","I")\1,1:""),"1")
+22 SET BKMDTE=$$FMTE^XLFDT($SELECT($$GET1^DIQ(90451.01,IENS,"4.4","I")'="":$$GET1^DIQ(90451.01,IENS,"4.4","I")\1,1:""),"1")
+23 SET TEXT=""
+24 SET TEXT=$$SETFLD^VALM1("Reported to State?",TEXT,"Type")
+25 SET TEXT=$$SETFLD^VALM1(BKMSTAT_$SELECT(BKMSTATI="Y"&(BKMDT'=""):" - "_BKMDT,1:""),TEXT,"Status")
+26 SET TEXT=$$SETFLD^VALM1(BKMDTE,TEXT,"Date Entered")
+27 SET VALMCNT=$GET(VALMCNT)+1
DO SET^VALM10(VALMCNT,TEXT)
+28 SET BKMSTAT=$SELECT(RSTAT="Y":$GET(BKMVA9("90451.01",IENS,"4.1","E")),1:"")
+29 SET BKMSTATI=$SELECT(RSTAT="Y":$GET(BKMVA9("90451.01",IENS,"4.1","I")),1:"")
+30 SET BKMDT=$SELECT(RSTAT="Y":$$FMTE^XLFDT($SELECT($$GET1^DIQ(90451.01,IENS,"4.2","I")'="":$$GET1^DIQ(90451.01,IENS,"4.2","I")\1,1:""),"1"),1:"")
+31 SET BKMDTE=$$FMTE^XLFDT($SELECT($$GET1^DIQ(90451.01,IENS,"4.41","I")'="":$$GET1^DIQ(90451.01,IENS,"4.41","I")\1,1:""),"1")
+32 SET TEXT=""
+33 SET TEXT=$$SETFLD^VALM1("Confirmed by State?",TEXT,"Type")
+34 SET TEXT=$$SETFLD^VALM1(BKMSTAT_$SELECT(BKMSTATI="Y"&(BKMDT'=""):" - "_BKMDT,1:""),TEXT,"Status")
+35 SET TEXT=$$SETFLD^VALM1(BKMDTE,TEXT,"Date Entered")
+36 SET VALMCNT=$GET(VALMCNT)+1
DO SET^VALM10(VALMCNT,TEXT)
+37 ; A blank line
SET VALMCNT=$$I^BKMIXX3($GET(VALMCNT),)
DO SET^VALM10(VALMCNT,"")
+38 SET TEXT=""
+39 SET TEXT=$$SETFLD^VALM1("State Reporting Category:",TEXT,"Type")
+40 SET TEXT=$$SETFLD^VALM1("AIDS",TEXT,"Status")
+41 SET TEXT=$$SETFLD^VALM1("",TEXT,"Date Entered")
+42 SET VALMCNT=$GET(VALMCNT)+1
DO SET^VALM10(VALMCNT,TEXT)
+43 SET BKMSTAT=$GET(BKMVA9("90451.01",IENS,"4.53","E"))
SET (BKMSTATI,RSTAT)=$GET(BKMVA9("90451.01",IENS,"4.53","I"))
+44 SET BKMDT=$$FMTE^XLFDT($SELECT($$GET1^DIQ(90451.01,IENS,"4.5","I")'="":$$GET1^DIQ(90451.01,IENS,"4.5","I")\1,1:""),"1")
+45 SET BKMDTE=$$FMTE^XLFDT($SELECT($$GET1^DIQ(90451.01,IENS,"4.54","I")'="":$$GET1^DIQ(90451.01,IENS,"4.54","I")\1,1:""),"1")
+46 SET TEXT=""
+47 SET TEXT=$$SETFLD^VALM1("Reported to State?",TEXT,"Type")
+48 SET TEXT=$$SETFLD^VALM1(BKMSTAT_$SELECT(BKMSTATI="Y"&(BKMDT'=""):" - "_BKMDT,1:""),TEXT,"Status")
+49 SET TEXT=$$SETFLD^VALM1(BKMDTE,TEXT,"Date Entered")
+50 SET VALMCNT=$GET(VALMCNT)+1
DO SET^VALM10(VALMCNT,TEXT)
+51 SET BKMSTAT=$SELECT(RSTAT="Y":$GET(BKMVA9("90451.01",IENS,"4.51","E")),1:"")
+52 SET BKMSTATI=$SELECT(RSTAT="Y":$GET(BKMVA9("90451.01",IENS,"4.51","I")),1:"")
+53 SET BKMDT=$SELECT(RSTAT="Y":$$FMTE^XLFDT($SELECT($$GET1^DIQ(90451.01,IENS,"4.52","I")'="":$$GET1^DIQ(90451.01,IENS,"4.52","I")\1,1:""),"1"),1:"")
+54 SET BKMDTE=$$FMTE^XLFDT($SELECT($$GET1^DIQ(90451.01,IENS,"4.541","I")'="":$$GET1^DIQ(90451.01,IENS,"4.541","I")\1,1:""),"1")
+55 SET TEXT=""
+56 SET TEXT=$$SETFLD^VALM1("Confirmed by State?",TEXT,"Type")
+57 SET TEXT=$$SETFLD^VALM1(BKMSTAT_$SELECT(BKMSTATI="Y"&(BKMDT'=""):" - "_BKMDT,1:""),TEXT,"Status")
+58 SET TEXT=$$SETFLD^VALM1(BKMDTE,TEXT,"Date Entered")
+59 SET VALMCNT=$GET(VALMCNT)+1
DO SET^VALM10(VALMCNT,TEXT)
+60 ;
+61 ; A blank line
SET VALMCNT=$$I^BKMIXX3($GET(VALMCNT),)
DO SET^VALM10(VALMCNT,"")
+62 ; Partnr Notify Status-only display if exists
+63 SET PNOT=$$GET1^DIQ(90451.01,IENS,"15","E")
SET PNOTI=$$GET1^DIQ(90451.01,IENS,"15","I")
+64 SET PDAT=$$FMTE^XLFDT($SELECT($$GET1^DIQ(90451.01,IENS,"16","I")'="":$$GET1^DIQ(90451.01,IENS,"16","I")\1,1:""),"1")
+65 SET BKMDTE=$$FMTE^XLFDT($SELECT($$GET1^DIQ(90451.01,IENS,"17","I")'="":$$GET1^DIQ(90451.01,IENS,"17","I")\1,1:""),"1")
+66 SET TEXT=""
+67 SET TEXT=$$SETFLD^VALM1("Partner Notification Status:",TEXT,"Type")
+68 SET TEXT=$$SETFLD^VALM1(PNOT_$SELECT(PNOTI="Y"&(PDAT'=""):" - "_PDAT,1:""),TEXT,"Status")
+69 SET TEXT=$$SETFLD^VALM1(BKMDTE,TEXT,"Date Entered")
+70 SET VALMCNT=$GET(VALMCNT)+1
DO SET^VALM10(VALMCNT,TEXT)
+71 ;
+72 DO ^XBFMK
+73 QUIT
+74 ;
MAINFORM ; State Reporting/Confirmation
+1 ; Assume DFN & DUZ exist
+2 ; OSTAT utilized in input template
+3 NEW BKMPRIV,HIVIEN,BKMIEN,BKMREG,BKMV,BKMIENS,OSTAT
+4 DO ^XBFMK
+5 SET BKMPRIV=$$BKMPRIV^BKMIXX3(DUZ)
+6 IF 'BKMPRIV
DO NOGO^BKMIXX3
QUIT
+7 SET HIVIEN=$$HIVIEN^BKMIXX3()
+8 IF HIVIEN=""
QUIT
+9 SET BKMIEN=$$BKMIEN^BKMIXX3(DFN)
+10 IF BKMIEN=""
QUIT
+11 SET BKMREG=$$BKMREG^BKMIXX3(BKMIEN)
+12 IF BKMREG=""
QUIT
+13 DO ^XBFMK
+14 DO FULL^VALM1
+15 ; PRXM/BHS-04/04/06-Removed
+16 ;D EN^BKMVAUD
+17 ; DAOU/BHS-12/01/05-Orig vals for 'Date Entered' if changed
+18 ; Capture fields: 4,4.1,4.2,4.3,4.5,4.51,4.52,4.53
+19 KILL DA
+20 SET DA(1)=BKMIEN
SET DA=BKMREG
+21 SET BKMIENS=$$IENS^DILF(.DA)
+22 SET BKMV("PRE",4)=$$GET1^DIQ(90451.01,BKMIENS,4,"I")
+23 SET BKMV("PRE",4.1)=$$GET1^DIQ(90451.01,BKMIENS,4.1,"I")
+24 SET BKMV("PRE",4.2)=$$GET1^DIQ(90451.01,BKMIENS,4.2,"I")
+25 SET BKMV("PRE",4.3)=$$GET1^DIQ(90451.01,BKMIENS,4.3,"I")
+26 SET BKMV("PRE",4.5)=$$GET1^DIQ(90451.01,BKMIENS,4.5,"I")
+27 SET BKMV("PRE",4.51)=$$GET1^DIQ(90451.01,BKMIENS,4.51,"I")
+28 SET BKMV("PRE",4.52)=$$GET1^DIQ(90451.01,BKMIENS,4.52,"I")
+29 SET BKMV("PRE",4.53)=$$GET1^DIQ(90451.01,BKMIENS,4.53,"I")
+30 KILL DA
+31 SET DA=BKMIEN
SET DIE="^BKM(90451,"
SET DR="[BKMV PATIENT RECORD STATE]"
+32 LOCK +^BKM(90451,BKMIEN):0
IF '$TEST
DO EN^DDIOL("Another user is editing this entry.")
HANG 2
GOTO MAINX
+33 DO ^DIE
KILL SRCAT
+34 HANG 1
+35 ; DAOU/BHS-12/01/05-Update 'Date Entered' if changed
+36 ; Capture fields: 4,4.1,4.2,4.3,4.5,4.51,4.52,4.53
+37 KILL DA
+38 SET DA(1)=BKMIEN
SET DA=BKMREG
+39 SET BKMIENS=$$IENS^DILF(.DA)
+40 SET BKMV("POST",4)=$$GET1^DIQ(90451.01,BKMIENS,4,"I")
+41 SET BKMV("POST",4.1)=$$GET1^DIQ(90451.01,BKMIENS,4.1,"I")
+42 SET BKMV("POST",4.2)=$$GET1^DIQ(90451.01,BKMIENS,4.2,"I")
+43 SET BKMV("POST",4.3)=$$GET1^DIQ(90451.01,BKMIENS,4.3,"I")
+44 SET BKMV("POST",4.5)=$$GET1^DIQ(90451.01,BKMIENS,4.5,"I")
+45 SET BKMV("POST",4.51)=$$GET1^DIQ(90451.01,BKMIENS,4.51,"I")
+46 SET BKMV("POST",4.52)=$$GET1^DIQ(90451.01,BKMIENS,4.52,"I")
+47 SET BKMV("POST",4.53)=$$GET1^DIQ(90451.01,BKMIENS,4.53,"I")
+48 ; Compare pre vs post
+49 IF (BKMV("PRE",4)'=BKMV("POST",4))!(BKMV("PRE",4.3)'=BKMV("POST",4.3))
Begin DoDot:1
+50 ; STATE HIV RPT LAST UPDATED (4.4)
+51 SET DIE="^BKM(90451,"_DA(1)_",1,"
+52 SET DR="4.4////"_$$NOW^XLFDT()_";"
+53 DO ^DIE
End DoDot:1
+54 IF (BKMV("PRE",4.1)'=BKMV("POST",4.1))!(BKMV("PRE",4.2)'=BKMV("POST",4.2))
Begin DoDot:1
+55 ; STATE HIV ACK LAST UPDATED (4.41)
+56 SET DIE="^BKM(90451,"_DA(1)_",1,"
+57 SET DR="4.41////"_$$NOW^XLFDT()_";"
+58 DO ^DIE
End DoDot:1
+59 IF (BKMV("PRE",4.5)'=BKMV("POST",4.5))!(BKMV("PRE",4.53)'=BKMV("POST",4.53))
Begin DoDot:1
+60 ; STATE AIDS RPT LAST UPDATED (4.54)
+61 SET DIE="^BKM(90451,"_DA(1)_",1,"
+62 SET DR="4.54////"_$$NOW^XLFDT()_";"
+63 DO ^DIE
End DoDot:1
+64 IF (BKMV("PRE",4.51)'=BKMV("POST",4.51))!(BKMV("PRE",4.52)'=BKMV("POST",4.52))
Begin DoDot:1
+65 ; STATE AIDS ACK LAST UPDATED (4.541)
+66 SET DIE="^BKM(90451,"_DA(1)_",1,"
+67 SET DR="4.541////"_$$NOW^XLFDT()_";"
+68 DO ^DIE
End DoDot:1
+69 LOCK -^BKM(90451,BKMIEN)
+70 ; PRXM/BHS-04/04/06-Removed
+71 ;D POST^BKMVAUD
MAINX ; Exit point for MAINFORM
+1 KILL ^TMP("BKMVA9",$JOB)
+2 DO GETALL
+3 QUIT
+4 ;
PNOTFORM ; Partner notification
+1 ; Assume DFN & DUZ exist
+2 ; OSTAT utilized in input template
+3 NEW BKMPRIV,HIVIEN,BKMIEN,BKMREG,IENS,BKMV,BKMIENS,OSTAT
+4 DO ^XBFMK
+5 SET BKMPRIV=$$BKMPRIV^BKMIXX3(DUZ)
+6 IF 'BKMPRIV
DO NOGO^BKMIXX3
QUIT
+7 SET HIVIEN=$$HIVIEN^BKMIXX3()
+8 IF HIVIEN=""
QUIT
+9 SET BKMIEN=$$BKMIEN^BKMIXX3(DFN)
+10 IF BKMIEN=""
QUIT
+11 SET BKMREG=$$BKMREG^BKMIXX3(BKMIEN)
+12 IF BKMREG=""
QUIT
+13 DO ^XBFMK
+14 DO FULL^VALM1
+15 ; PRXM/BHS-04/04/06-Removed
+16 ;D EN^BKMVAUD
+17 ; DAOU/BHS-12/01/05-Track original values to track 'Date Entered' for changes
+18 ; Capture fields: 15,16
+19 KILL DA
+20 SET DA(1)=BKMIEN
SET DA=BKMREG
+21 SET BKMIENS=$$IENS^DILF(.DA)
+22 SET BKMV("PRE",15)=$$GET1^DIQ(90451.01,BKMIENS,15,"I")
+23 SET BKMV("PRE",16)=$$GET1^DIQ(90451.01,BKMIENS,16,"I")
+24 KILL DA
+25 SET DA(1)=BKMIEN
SET DA=BKMREG
SET IENS=$$IENS^DILF(.DA)
+26 LOCK +^BKM(90451,BKMIEN):0
IF '$TEST
DO EN^DDIOL("Another user is editing this entry.")
HANG 2
GOTO PNOTX
+27 ; If PARTNER NOTIFICATION STATUS (#15) is null, default it
+28 IF $$GET1^DIQ(90451.01,IENS,"15","I")=""
Begin DoDot:1
+29 ; Default to 'Unknown'
+30 SET DIE="^BKM(90451,"_DA(1)_",1,"
+31 SET DR="15////U;"
+32 DO ^DIE
End DoDot:1
+33 KILL DA
+34 SET DA=BKMIEN
SET DIE="^BKM(90451,"
SET DR="[BKMV UPD1 PNOT]"
+35 DO ^DIE
+36 HANG 1
+37 ; DAOU/BHS-12/01/05-Update 'Date Entered' fields where appropriate
+38 ; Capture fields: 15,16
+39 KILL DA
+40 SET DA(1)=BKMIEN
SET DA=BKMREG
+41 SET BKMIENS=$$IENS^DILF(.DA)
+42 SET BKMV("POST",15)=$$GET1^DIQ(90451.01,BKMIENS,15,"I")
+43 SET BKMV("POST",16)=$$GET1^DIQ(90451.01,BKMIENS,16,"I")
+44 ; Compare pre vs post
+45 IF BKMV("PRE",15)'=BKMV("POST",15)!(BKMV("PRE",16)'=BKMV("POST",16))
Begin DoDot:1
+46 ; PARTNER NOTIFIED LAST UPDATED (17)
+47 SET DIE="^BKM(90451,"_DA(1)_",1,"
+48 SET DR="17////"_$$NOW^XLFDT()_";"
+49 DO ^DIE
End DoDot:1
+50 LOCK -^BKM(90451,BKMIEN)
+51 ; PRXM/BHS-04/04/06-Removed
+52 ;D POST^BKMVAUD
PNOTX ; PNOTFORM Exit point
+1 KILL ^TMP("BKMVA9",$JOB)
+2 DO GETALL
+3 QUIT
+4 ;
HELP ; -help
+1 SET X="?"
DO DISP^XQORM1
WRITE !
+2 QUIT
+3 ;
EXIT ; -exit
+1 KILL VALM0,VALMAR,VALMHDR,VALMCNT
+2 QUIT
+3 ;
YNP(PROMPT,DFLT) ;Yes/No question
+1 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,TEXT,DIWL,DIWR,BKMTOT,II
+2 SET DFLT=$GET(DFLT)
+3 SET DIR(0)="Y"
+4 ; If PROMPT is > 1 line, split with ^DIWP
+5 IF $LENGTH(PROMPT)>77
Begin DoDot:1
+6 KILL ^UTILITY($JOB,"W")
+7 SET X=PROMPT
SET DIWL=1
SET DIWR=77
DO ^DIWP
+8 SET BKMTOT=+$GET(^UTILITY($JOB,"W",DIWL))
+9 FOR II=1:1:BKMTOT
Begin DoDot:2
+10 SET TEXT=$GET(^UTILITY($JOB,"W",DIWL,II,0))
+11 IF $EXTRACT(TEXT,$LENGTH(TEXT))=" "
SET TEXT=$EXTRACT(TEXT,1,$LENGTH(TEXT)-1)
+12 IF II<BKMTOT
SET DIR("A",II)=TEXT
+13 IF II=BKMTOT
SET DIR("A")=TEXT
End DoDot:2
End DoDot:1
+14 IF $LENGTH(PROMPT)<78
SET DIR("A")=PROMPT
+15 IF DFLT="YES"!(DFLT="NO")
SET DIR("B")=DFLT
+16 DO ^DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT 0
+17 QUIT $SELECT(+$GET(Y)=0:0,1:1)
+18 ;
STAT(DFN,FLD) ; get current AIDS/HIV State Reportng/Confirmation or Partnr Notification Status
+1 NEW STAT,BKMIEN,BKMREG
+2 SET STAT=""
+3 SET BKMIEN=$$BKMIEN^BKMIXX3(DFN)
+4 IF BKMIEN=""
QUIT STAT
+5 SET BKMREG=$$BKMREG^BKMIXX3(BKMIEN)
+6 IF BKMREG=""
QUIT STAT
+7 SET STAT=$$GET1^DIQ(90451.01,BKMREG_","_BKMIEN_",",FLD,"I")
+8 QUIT STAT
+9 ;
HIVRDT ; EP -Input Transform for State HIV Reporting DT
+1 NEW Y,HIVCDT,DOB,DFN
+2 SET HIVCDT=$$GET1^DIQ(90451.01,DA_","_DA(1)_",",4.2,"I")
+3 SET DFN=$$GET1^DIQ(90451,DA(1)_",",.01,"I")
+4 SET DOB=$$GET1^DIQ(2,DFN,.03,"I")
+5 SET %DT="EX"
DO ^%DT
SET X=Y
+6 IF Y=-1
KILL X
SET BFL=1
QUIT
+7 IF DOB>X
KILL X
QUIT
+8 IF X>DT
KILL X
QUIT
+9 IF HIVCDT'=""
IF X>HIVCDT
KILL X
QUIT
+10 QUIT
+11 ;
HIVCDT ; EP -Input Transform for State HIV Confirmation DT
+1 NEW Y,HIVRDT,DOB,DFN
+2 SET HIVRDT=$$GET1^DIQ(90451.01,DA_","_DA(1)_",",4,"I")
+3 SET DFN=$$GET1^DIQ(90451,DA(1)_",",.01,"I")
+4 SET DOB=$$GET1^DIQ(2,DFN,.03,"I")
+5 SET %DT="EX"
DO ^%DT
SET X=Y
+6 IF Y=-1
KILL X
SET BFL=1
QUIT
+7 IF DOB>X
KILL X
QUIT
+8 IF X>DT
KILL X
QUIT
+9 IF HIVRDT'=""
IF X<HIVRDT
KILL X
QUIT
+10 QUIT
+11 ;
AIDRDT ; EP -Input Transform for State AIDS Reporting DT
+1 NEW Y,AIDCDT,DOB,DFN
+2 SET AIDCDT=$$GET1^DIQ(90451.01,DA_","_DA(1)_",",4.52,"I")
+3 SET DFN=$$GET1^DIQ(90451,DA(1)_",",.01,"I")
+4 SET DOB=$$GET1^DIQ(2,DFN,.03,"I")
+5 SET %DT="EX"
DO ^%DT
SET X=Y
+6 IF Y=-1
KILL X
SET BFL=1
QUIT
+7 IF DOB>X
KILL X
QUIT
+8 IF X>DT
KILL X
QUIT
+9 IF AIDCDT'=""
IF X>AIDCDT
KILL X
QUIT
+10 QUIT
+11 ;
AIDCDT ; EP -Input Transform for State AIDS Confirmation DT
+1 NEW Y,AIDRDT,DOB,DFN
+2 SET AIDRDT=$$GET1^DIQ(90451.01,DA_","_DA(1)_",",4.5,"I")
+3 SET DFN=$$GET1^DIQ(90451,DA(1)_",",.01,"I")
+4 SET DOB=$$GET1^DIQ(2,DFN,.03,"I")
+5 SET %DT="EX"
DO ^%DT
SET X=Y
+6 IF Y=-1
KILL X
SET BFL=1
QUIT
+7 IF DOB>X
KILL X
QUIT
+8 IF X>DT
KILL X
QUIT
+9 IF AIDRDT'=""
IF X<AIDRDT
KILL X
QUIT
+10 QUIT
+11 ;
PNOTDT ; EP -Input Transform for Partner Notification DT
+1 NEW Y,DOB,DFN
+2 SET DFN=$$GET1^DIQ(90451,DA(1)_",",.01,"I")
+3 SET DOB=$$GET1^DIQ(2,DFN,.03,"I")
+4 SET %DT="EX"
DO ^%DT
SET X=Y
+5 IF Y=-1
KILL X
SET BFL=1
QUIT
+6 IF DOB>X
KILL X
QUIT
+7 IF X>DT
KILL X
QUIT
+8 QUIT
+9 ;
HIVRHLP ; EP -HIV State Reporting DT Special Help
+1 SET DV=""
+2 KILL HELP
+3 IF $GET(BFL)
DO HELP^%DTC
KILL BFL
QUIT
+4 IF X["BAD"
Begin DoDot:1
+5 SET HELP(1)="The State HIV reporting date must be previous to the State HIV confirmation"
+6 SET HELP(1,"F")="?5"
+7 SET HELP(2)="date, if it exists, and not previous to the Date of Birth and not in the future."
+8 SET HELP(2,"F")="!?5"
+9 SET HELP(3)="Please reenter the date."
+10 SET HELP(3,"F")="!?5"
+11 DO EN^DDIOL(.HELP)
End DoDot:1
+12 KILL HELP
+13 QUIT
+14 ;
HIVCHLP ; EP -HIV State Confirmation DT Special Help
+1 SET DV=""
+2 KILL HELP
+3 IF $GET(BFL)
DO HELP^%DTC
KILL BFL
QUIT
+4 IF X["BAD"
Begin DoDot:1
+5 SET HELP(1)="The State HIV confirmation date must be on or after the State HIV reporting"
+6 SET HELP(1,"F")="?5"
+7 SET HELP(2)="date, if it exists, and not previous to the Date of Birth and not in the future."
+8 SET HELP(2,"F")="!?5"
+9 SET HELP(3)="Please reenter the date."
+10 SET HELP(3,"F")="!?5"
+11 DO EN^DDIOL(.HELP)
End DoDot:1
+12 KILL HELP
+13 QUIT
+14 ;
AIDRHLP ; EP -AIDS State Reporting DT Special Help
+1 SET DV=""
+2 KILL HELP
+3 IF $GET(BFL)
DO HELP^%DTC
KILL BFL
QUIT
+4 IF X["BAD"
Begin DoDot:1
+5 SET HELP(1)="The State AIDS reporting date must be previous to the State AIDS confirmation"
+6 SET HELP(1,"F")="?5"
+7 SET HELP(2)="date, if it exists, and not previous to the Date of Birth and not in the future."
+8 SET HELP(2,"F")="!?5"
+9 SET HELP(3)="Please reenter the date."
+10 SET HELP(3,"F")="!?5"
+11 DO EN^DDIOL(.HELP)
End DoDot:1
+12 KILL HELP
+13 QUIT
+14 ;
AIDCHLP ; EP -AIDS State Confirmation DT Special Help
+1 SET DV=""
+2 KILL HELP
+3 IF $GET(BFL)
DO HELP^%DTC
KILL BFL
QUIT
+4 IF X["BAD"
Begin DoDot:1
+5 SET HELP(1)="The State AIDS confirmation date must on or after the State AIDS reporting"
+6 SET HELP(1,"F")="?5"
+7 SET HELP(2)="date, if it exists, and not previous to the Date of Birth and not in the future."
+8 SET HELP(2,"F")="!?5"
+9 SET HELP(3)="Please reenter the date."
+10 SET HELP(3,"F")="!?5"
+11 DO EN^DDIOL(.HELP)
End DoDot:1
+12 KILL HELP
+13 QUIT
+14 ;
PNOTHLP ; EP -Partner Notification Special Help
+1 SET DV=""
+2 KILL HELP
+3 IF $GET(BFL)
DO HELP^%DTC
KILL BFL
QUIT
+4 IF X["BAD"
Begin DoDot:1
+5 SET HELP(1)="The partner notification date must not precede the Date of Birth and"
+6 SET HELP(1,"F")="?5"
+7 SET HELP(2)="cannot be in the future. Please reenter the date."
+8 SET HELP(2,"F")="!?5"
+9 DO EN^DDIOL(.HELP)
End DoDot:1
+10 KILL HELP
+11 QUIT
