BKMVA1C ;PRX/HC/DLS - HMS PATIENT REGISTER CONT;
;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
;
; Prompts and functions related to BKMVA1
Q
;
REGDC(DFN) ;EP - Called by LDREC^BKMVA1B
; Determine HMS Diagnosis Category for Register/Add or PAT/REC/ED, based on HIV, AIDS, and CD4 Absolute criteria.
; Note: This logic is based on the following statement...
; 1. Patient must have at least 2 diags not on the same day of HIV Positive (DX.6);
; AND
; 2. If current CD4 Absolute (T.30) count is below 200'
; OR
; 3. Patient has at least one diagnosis of Other AIDS Defining Illness (DX.1)
; since the first HIV/AIDS diagnosis;
; Then
; Proposed Diagnosis is AIDS;
; Else
; Proposed Diagnosis is HIV.
; Currently, this statement is being interpreted to mean:
; IF (1 and (2 or 3)) --> AIDS
;
; If this logic is changed, only REGDC should be affected.
; HIV,AIDS,andCD4AB should be able to remain the same.
;
N FLG,RSLT,FLAG
; Default is HIV
S RSLT="",DIAGCAT="",HAIDSDT="",IAIDSDT=""
; Do HIV and set FLG("H") to result.
S FLAG("H")=$$HIV(DFN)
; If not HIV, you don't need to go any further. Quit
I 'FLAG("H") Q
; Do AIDS and set FLG("A") to result.
S FLAG("A")=$$AIDS(DFN)
; If not AIDS, check for CD4 Absolute
I 'FLAG("A") S FLAG("C")=$$CD4AB(DFN)
; If HIV and (AIDS or CD4 Absolute) set the final result to "A" (for AIDS).
I FLAG("H") S RSLT="H"
I FLAG("A")!$G(FLAG("C")) S RSLT="A"
K ^TMP("BKMAIDS",$J),^TMP("BKMHIV",$J),^TMP("BKMCD4",$J),^TMP("BKMTST",$J),^TMP("BKMCD4AB",$J),^TMP("BKMHIVP",$J),^TMP("BKMCD4P",$J)
S DIAGCAT=RSLT
Q
;
HIV(DFN) ; (DX.6) See if patient has 2 HIV diagnoses on differing days.
;
N HIDX,HIEN,HIVDT,VISIT,CHK,FLG
S HIDX="",FLG=0
F S HIDX=$O(^TMP("BKMHIV",$J,HIDX)) Q:HIDX="" D
. ; First check the POV's
. S HIEN=""
. F S HIEN=$O(^AUPNVPOV("B",HIDX,HIEN)) Q:(HIEN="")!(FLG) D
.. I $P(^AUPNVPOV(HIEN,0),U,2)=DFN D
... S VISIT=$$GET1^DIQ(9000010.07,HIEN,.03,"I")
... I VISIT D
.... S HIVDT=$P($$GET1^DIQ(9000010,VISIT,.01,"I"),".",1)
.... I $D(^TMP("BKMHIVP",$J,DFN,HIVDT)) Q
.... S ^TMP("BKMHIVP",$J,DFN,HIVDT)=""
.... S ^TMP("BKMHIVP",$J,DFN)=$G(^TMP("BKMHIVP",$J,DFN))+1
.... ;I $O(^TMP("BKMHIVP",$J,DFN,""))=$O(^TMP("BKMHIVP",$J,DFN,""),-1) S FLG=1
. ; Now check the Problem List.
. S HIEN=""
. F S HIEN=$O(^AUPNPROB("B",HIDX,HIEN)) Q:(HIEN="")!(FLG) D
.. I $P(^AUPNPROB(HIEN,0),U,2)=DFN D
... S HIVDT=$P($$PROB^BKMVUTL(HIEN),".")
... I $D(^TMP("BKMHIVP",$J,DFN,HIVDT)) Q
... S ^TMP("BKMHIVP",$J,DFN)=$G(^TMP("BKMHIVP",$J,DFN))+1
... ;I $O(^TMP("BKMHIVP",$J,DFN,""))=$O(^TMP("BKMHIVP",$J,DFN,""),-1) S FLG=1
I $G(^TMP("BKMHIVP",$J,DFN))>1 S FLG=1
Q FLG
;
AIDS(DFN) ; (DX.1) See if patient has at least one AIDS Defining Illness since first HIV/AIDS diagnosis. If so, set FLG=1
;
N AIDX,AIEN,VISIT,FLG
; Get Initial HIV/AIDS date from ^TMP("BKMHIVP"). If null, quit.
S HAIDSDT=$O(^TMP("BKMHIVP",$J,DFN,""))
S FLG=0,AIDX=""
F S AIDX=$O(^TMP("BKMAIDS",$J,AIDX)) Q:(AIDX="")!(FLG) D
. S AIEN=""
. F S AIEN=$O(^AUPNVPOV("B",AIDX,AIEN)) Q:(AIEN="")!(FLG) D
.. I $P(^AUPNVPOV(AIEN,0),U,2)=DFN D
... S VISIT=$$GET1^DIQ(9000010.07,AIEN,.03,"I") Q:VISIT=""
... S IAIDSDT=$P($$GET1^DIQ(9000010,VISIT,.01,"I"),".")
... ; If AIDS Defining Illness date is after Initial HIV/AIDS Diagnosis Date, set FLG=1.
... I IAIDSDT>HAIDSDT S FLG=1
Q FLG
;
CD4AB(DFN) ; (T.30) Accumulate all CD4 Absolute result and see if the most recent CD4 Absolute result is less than 200 (and not null). If so, set FLG=1.
;
NEW LAB,LIEN,RESULT,RDATE,VISDTM,LSTTST,FLG
S LAB="",FLG=0
F S LAB=$O(^TMP("BKMCD4AB",$J,LAB)) Q:LAB="" D
. S LIEN=""
. F S LIEN=$O(^AUPNVLAB("B",LAB,LIEN),-1) Q:(LIEN="") D
.. I $P(^AUPNVLAB(LIEN,0),U,2)=DFN D
... S RESULT=$$GET1^DIQ(9000010.09,LIEN,.04,"E")
... S RDATE=$$GET1^DIQ(9000010.09,LIEN,1212,"I")
... I 'RDATE S VISIT=$$GET1^DIQ(9000010.09,LIEN,.03,"I") Q:VISIT="" D
.... S VISDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")
... I RESULT'="" D
.... I RDATE S ^TMP("BKMCD4P",$J,RDATE)=RESULT
.... I 'RDATE,VISDTM S ^TMP("BKMCD4P",$J,VISDTM)=RESULT
S LSTTST=$O(^TMP("BKMCD4P",$J,""),-1)
I LSTTST'="",^TMP("BKMCD4P",$J,LSTTST)<200 S FLG=1
Q FLG
;
XIT K DIAGCAT,HAIDSDT,IAIDSDT
Q
;
OPT() ;EP - Called by REPORTS^BKMVA1
;Select reports to print
N DIR,X,Y,DTOUT,DUOUT,BKMCHK
;
OPT1 ;
S BKMCHK=0
K DIR
S DIR(0)="FO"
S DIR("A")="Select Patient Report"
S DIR("A",1)=" "
S DIR("A",2)=" Select one of the following:"
S DIR("A",3)=" "
S DIR("A",4)=" DO Due/OverDue"
S DIR("A",5)=" QC Quality of Care Audit Report"
S DIR("A",6)=" SUPP HMS Supplement"
S DIR("A",7)=" HS Health Summary"
S DIR("A",8)=" BOTH Both Health Summary and Supplement"
S DIR("A",9)=" SSR State Surveillance Report"
S DIR("A",10)=" "
S DIR("?")=" "
S DIR("?",1)=" Enter DO to select the Due/OverDue Report"
S DIR("?",2)=" Enter QC to select the Quality of Care Audit Report"
S DIR("?",3)=" Enter SUPP to select the HMS Supplement"
S DIR("?",4)=" Enter HS to select the Health Summary"
S DIR("?",5)=" Enter BOTH to select both the Health Summary and the HMS Supplement"
S DIR("?",6)=" Enter SSR to select the State Surveillance Report"
S DIR("?",7)=" "
S DIR("?",8)=" When BOTH is selected the HMS Supplement will display after the"
S DIR("?",9)=" Health Summary has completed."
D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT)!(Y="") Q ""
S Y=$$UP^XLFSTR(Y)
; Special case where user enters 'H' or 'h' redisplay as ambiguous
I Y="H" D I Y="" G OPT1
.S DIR(0)="SO^1:HMS Supplement;2:Health Summary"
.K DIR("A")
.S DIR("A")="Select the report option"
.K DIR("B"),DIR("?")
.S DIR("?")=" "
.S DIR("?",1)=" Enter 1 to select the HMS Supplement"
.S DIR("?",2)=" Enter 2 to select the Health Summary"
.D ^DIR K DIR
.I $D(DUOUT)!$D(DTOUT)!(Y="") S Y="" Q
.S Y=$S(Y=1:"SUPP",1:"HS"),BKMCHK=1
.;
; Special case where user enters 'S' or 's' redisplay as ambiguous
I Y="S" D I Y="" G OPT1
.S DIR(0)="SO^1:HMS Supplement;2:State Surveillance Report"
.K DIR("A")
.S DIR("A")="Select the report option"
.K DIR("B"),DIR("?")
.S DIR("?")=" "
.S DIR("?",1)=" Enter 1 to select the HMS Supplement"
.S DIR("?",2)=" Enter 2 to select the State Surveillance Report"
.D ^DIR K DIR
.I $D(DUOUT)!$D(DTOUT)!(Y="") S Y="" Q
.S Y=$S(Y=1:"SUPP",1:"SSR"),BKMCHK=1
.;
I '$F("^DO^QC^SUPP^HS^BOTH^SSR^",U_Y_U) D
.I $L(Y)<4,$E("DO",1,$L(Y))=Y S Y="DO" Q
.I $L(Y)<4,$E("QC",1,$L(Y))=Y S Y="QC" Q
.I $L(Y)<4,$E("SUPP",1,$L(Y))=Y S Y="SUPP" Q
.I $L(Y)<4,$E("HS",1,$L(Y))=Y S Y="HS" Q
.I $L(Y)<4,$E("BOTH",1,$L(Y))=Y S Y="BOTH" Q
.I $L(Y)<4,$E("SSR",1,$L(Y))=Y S Y="SSR" Q
.I $L(Y)>0,$E("DUE/OVERDUE",1,$L(Y))=Y S Y="DO" Q
.I $L(Y)>0,$E("QUALITY OF CARE AUDIT REPORT",1,$L(Y))=Y S Y="QC" Q
.I $L(Y)>0,$E("HMS SUPPLEMENT",1,$L(Y))=Y S Y="SUPP" Q
.I $L(Y)>0,$E("HEALTH SUMMARY",1,$L(Y))=Y S Y="HS" Q
.I $L(Y)>0,$E("BOTH HEALTH SUMMARY AND SUPPLEMENT",1,$L(Y))=Y S Y="BOTH" Q
.I $L(Y)>0,$E("STATE SURVEILLANCE REPORT",1,$L(Y))=Y S Y="SSR" Q
I '$F("^DO^QC^SUPP^HS^BOTH^SSR^",U_Y_U) W !!?2,"Please enter a code or description from the list.",!! G OPT1
I 'BKMCHK W " ",$S(Y="DO":"Due/Overdue",Y="QC":"Quality of Care Audit Report",Y="SUPP":"HMS Supplement",Y="HS":"Health Summary",Y="BOTH":"Both Health Summary and Supplement",1:"State Surveillance Report")
Q Y
BKMVA1C ;PRX/HC/DLS - HMS PATIENT REGISTER CONT;
+1 ;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;
+3 ; Prompts and functions related to BKMVA1
+4 QUIT
+5 ;
REGDC(DFN) ;EP - Called by LDREC^BKMVA1B
+1 ; Determine HMS Diagnosis Category for Register/Add or PAT/REC/ED, based on HIV, AIDS, and CD4 Absolute criteria.
+2 ; Note: This logic is based on the following statement...
+3 ; 1. Patient must have at least 2 diags not on the same day of HIV Positive (DX.6);
+4 ; AND
+5 ; 2. If current CD4 Absolute (T.30) count is below 200'
+6 ; OR
+7 ; 3. Patient has at least one diagnosis of Other AIDS Defining Illness (DX.1)
+8 ; since the first HIV/AIDS diagnosis;
+9 ; Then
+10 ; Proposed Diagnosis is AIDS;
+11 ; Else
+12 ; Proposed Diagnosis is HIV.
+13 ; Currently, this statement is being interpreted to mean:
+14 ; IF (1 and (2 or 3)) --> AIDS
+15 ;
+16 ; If this logic is changed, only REGDC should be affected.
+17 ; HIV,AIDS,andCD4AB should be able to remain the same.
+18 ;
+19 NEW FLG,RSLT,FLAG
+20 ; Default is HIV
+21 SET RSLT=""
SET DIAGCAT=""
SET HAIDSDT=""
SET IAIDSDT=""
+22 ; Do HIV and set FLG("H") to result.
+23 SET FLAG("H")=$$HIV(DFN)
+24 ; If not HIV, you don't need to go any further. Quit
+25 IF 'FLAG("H")
QUIT
+26 ; Do AIDS and set FLG("A") to result.
+27 SET FLAG("A")=$$AIDS(DFN)
+28 ; If not AIDS, check for CD4 Absolute
+29 IF 'FLAG("A")
SET FLAG("C")=$$CD4AB(DFN)
+30 ; If HIV and (AIDS or CD4 Absolute) set the final result to "A" (for AIDS).
+31 IF FLAG("H")
SET RSLT="H"
+32 IF FLAG("A")!$GET(FLAG("C"))
SET RSLT="A"
+33 KILL ^TMP("BKMAIDS",$JOB),^TMP("BKMHIV",$JOB),^TMP("BKMCD4",$JOB),^TMP("BKMTST",$JOB),^TMP("BKMCD4AB",$JOB),^TMP("BKMHIVP",$JOB),^TMP("BKMCD4P",$JOB)
+34 SET DIAGCAT=RSLT
+35 QUIT
+36 ;
HIV(DFN) ; (DX.6) See if patient has 2 HIV diagnoses on differing days.
+1 ;
+2 NEW HIDX,HIEN,HIVDT,VISIT,CHK,FLG
+3 SET HIDX=""
SET FLG=0
+4 FOR
SET HIDX=$ORDER(^TMP("BKMHIV",$JOB,HIDX))
IF HIDX=""
QUIT
Begin DoDot:1
+5 ; First check the POV's
+6 SET HIEN=""
+7 FOR
SET HIEN=$ORDER(^AUPNVPOV("B",HIDX,HIEN))
IF (HIEN="")!(FLG)
QUIT
Begin DoDot:2
+8 IF $PIECE(^AUPNVPOV(HIEN,0),U,2)=DFN
Begin DoDot:3
+9 SET VISIT=$$GET1^DIQ(9000010.07,HIEN,.03,"I")
+10 IF VISIT
Begin DoDot:4
+11 SET HIVDT=$PIECE($$GET1^DIQ(9000010,VISIT,.01,"I"),".",1)
+12 IF $DATA(^TMP("BKMHIVP",$JOB,DFN,HIVDT))
QUIT
+13 SET ^TMP("BKMHIVP",$JOB,DFN,HIVDT)=""
+14 SET ^TMP("BKMHIVP",$JOB,DFN)=$GET(^TMP("BKMHIVP",$JOB,DFN))+1
+15 ;I $O(^TMP("BKMHIVP",$J,DFN,""))=$O(^TMP("BKMHIVP",$J,DFN,""),-1) S FLG=1
End DoDot:4
End DoDot:3
End DoDot:2
+16 ; Now check the Problem List.
+17 SET HIEN=""
+18 FOR
SET HIEN=$ORDER(^AUPNPROB("B",HIDX,HIEN))
IF (HIEN="")!(FLG)
QUIT
Begin DoDot:2
+19 IF $PIECE(^AUPNPROB(HIEN,0),U,2)=DFN
Begin DoDot:3
+20 SET HIVDT=$PIECE($$PROB^BKMVUTL(HIEN),".")
+21 IF $DATA(^TMP("BKMHIVP",$JOB,DFN,HIVDT))
QUIT
+22 SET ^TMP("BKMHIVP",$JOB,DFN)=$GET(^TMP("BKMHIVP",$JOB,DFN))+1
+23 ;I $O(^TMP("BKMHIVP",$J,DFN,""))=$O(^TMP("BKMHIVP",$J,DFN,""),-1) S FLG=1
End DoDot:3
End DoDot:2
End DoDot:1
+24 IF $GET(^TMP("BKMHIVP",$JOB,DFN))>1
SET FLG=1
+25 QUIT FLG
+26 ;
AIDS(DFN) ; (DX.1) See if patient has at least one AIDS Defining Illness since first HIV/AIDS diagnosis. If so, set FLG=1
+1 ;
+2 NEW AIDX,AIEN,VISIT,FLG
+3 ; Get Initial HIV/AIDS date from ^TMP("BKMHIVP"). If null, quit.
+4 SET HAIDSDT=$ORDER(^TMP("BKMHIVP",$JOB,DFN,""))
+5 SET FLG=0
SET AIDX=""
+6 FOR
SET AIDX=$ORDER(^TMP("BKMAIDS",$JOB,AIDX))
IF (AIDX="")!(FLG)
QUIT
Begin DoDot:1
+7 SET AIEN=""
+8 FOR
SET AIEN=$ORDER(^AUPNVPOV("B",AIDX,AIEN))
IF (AIEN="")!(FLG)
QUIT
Begin DoDot:2
+9 IF $PIECE(^AUPNVPOV(AIEN,0),U,2)=DFN
Begin DoDot:3
+10 SET VISIT=$$GET1^DIQ(9000010.07,AIEN,.03,"I")
IF VISIT=""
QUIT
+11 SET IAIDSDT=$PIECE($$GET1^DIQ(9000010,VISIT,.01,"I"),".")
+12 ; If AIDS Defining Illness date is after Initial HIV/AIDS Diagnosis Date, set FLG=1.
+13 IF IAIDSDT>HAIDSDT
SET FLG=1
End DoDot:3
End DoDot:2
End DoDot:1
+14 QUIT FLG
+15 ;
CD4AB(DFN) ; (T.30) Accumulate all CD4 Absolute result and see if the most recent CD4 Absolute result is less than 200 (and not null). If so, set FLG=1.
+1 ;
+2 NEW LAB,LIEN,RESULT,RDATE,VISDTM,LSTTST,FLG
+3 SET LAB=""
SET FLG=0
+4 FOR
SET LAB=$ORDER(^TMP("BKMCD4AB",$JOB,LAB))
IF LAB=""
QUIT
Begin DoDot:1
+5 SET LIEN=""
+6 FOR
SET LIEN=$ORDER(^AUPNVLAB("B",LAB,LIEN),-1)
IF (LIEN="")
QUIT
Begin DoDot:2
+7 IF $PIECE(^AUPNVLAB(LIEN,0),U,2)=DFN
Begin DoDot:3
+8 SET RESULT=$$GET1^DIQ(9000010.09,LIEN,.04,"E")
+9 SET RDATE=$$GET1^DIQ(9000010.09,LIEN,1212,"I")
+10 IF 'RDATE
SET VISIT=$$GET1^DIQ(9000010.09,LIEN,.03,"I")
IF VISIT=""
QUIT
Begin DoDot:4
+11 SET VISDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")
End DoDot:4
+12 IF RESULT'=""
Begin DoDot:4
+13 IF RDATE
SET ^TMP("BKMCD4P",$JOB,RDATE)=RESULT
+14 IF 'RDATE
IF VISDTM
SET ^TMP("BKMCD4P",$JOB,VISDTM)=RESULT
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+15 SET LSTTST=$ORDER(^TMP("BKMCD4P",$JOB,""),-1)
+16 IF LSTTST'=""
IF ^TMP("BKMCD4P",$JOB,LSTTST)<200
SET FLG=1
+17 QUIT FLG
+18 ;
XIT KILL DIAGCAT,HAIDSDT,IAIDSDT
+1 QUIT
+2 ;
OPT() ;EP - Called by REPORTS^BKMVA1
+1 ;Select reports to print
+2 NEW DIR,X,Y,DTOUT,DUOUT,BKMCHK
+3 ;
OPT1 ;
+1 SET BKMCHK=0
+2 KILL DIR
+3 SET DIR(0)="FO"
+4 SET DIR("A")="Select Patient Report"
+5 SET DIR("A",1)=" "
+6 SET DIR("A",2)=" Select one of the following:"
+7 SET DIR("A",3)=" "
+8 SET DIR("A",4)=" DO Due/OverDue"
+9 SET DIR("A",5)=" QC Quality of Care Audit Report"
+10 SET DIR("A",6)=" SUPP HMS Supplement"
+11 SET DIR("A",7)=" HS Health Summary"
+12 SET DIR("A",8)=" BOTH Both Health Summary and Supplement"
+13 SET DIR("A",9)=" SSR State Surveillance Report"
+14 SET DIR("A",10)=" "
+15 SET DIR("?")=" "
+16 SET DIR("?",1)=" Enter DO to select the Due/OverDue Report"
+17 SET DIR("?",2)=" Enter QC to select the Quality of Care Audit Report"
+18 SET DIR("?",3)=" Enter SUPP to select the HMS Supplement"
+19 SET DIR("?",4)=" Enter HS to select the Health Summary"
+20 SET DIR("?",5)=" Enter BOTH to select both the Health Summary and the HMS Supplement"
+21 SET DIR("?",6)=" Enter SSR to select the State Surveillance Report"
+22 SET DIR("?",7)=" "
+23 SET DIR("?",8)=" When BOTH is selected the HMS Supplement will display after the"
+24 SET DIR("?",9)=" Health Summary has completed."
+25 DO ^DIR
KILL DIR
+26 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
QUIT ""
+27 SET Y=$$UP^XLFSTR(Y)
+28 ; Special case where user enters 'H' or 'h' redisplay as ambiguous
+29 IF Y="H"
Begin DoDot:1
+30 SET DIR(0)="SO^1:HMS Supplement;2:Health Summary"
+31 KILL DIR("A")
+32 SET DIR("A")="Select the report option"
+33 KILL DIR("B"),DIR("?")
+34 SET DIR("?")=" "
+35 SET DIR("?",1)=" Enter 1 to select the HMS Supplement"
+36 SET DIR("?",2)=" Enter 2 to select the Health Summary"
+37 DO ^DIR
KILL DIR
+38 IF $DATA(DUOUT)!$DATA(DTOUT)!(Y="")
SET Y=""
QUIT
+39 SET Y=$SELECT(Y=1:"SUPP",1:"HS")
SET BKMCHK=1
+40 ;
End DoDot:1
IF Y=""
GOTO OPT1
+41 ; Special case where user enters 'S' or 's' redisplay as ambiguous
+42 IF Y="S"
Begin DoDot:1
+43 SET DIR(0)="SO^1:HMS Supplement;2:State Surveillance Report"
+44 KILL DIR("A")
+45 SET DIR("A")="Select the report option"
+46 KILL DIR("B"),DIR("?")
+47 SET DIR("?")=" "
+48 SET DIR("?",1)=" Enter 1 to select the HMS Supplement"
+49 SET DIR("?",2)=" Enter 2 to select the State Surveillance Report"
+50 DO ^DIR
KILL DIR
+51 IF $DATA(DUOUT)!$DATA(DTOUT)!(Y="")
SET Y=""
QUIT
+52 SET Y=$SELECT(Y=1:"SUPP",1:"SSR")
SET BKMCHK=1
+53 ;
End DoDot:1
IF Y=""
GOTO OPT1
+54 IF '$FIND("^DO^QC^SUPP^HS^BOTH^SSR^",U_Y_U)
Begin DoDot:1
+55 IF $LENGTH(Y)<4
IF $EXTRACT("DO",1,$LENGTH(Y))=Y
SET Y="DO"
QUIT
+56 IF $LENGTH(Y)<4
IF $EXTRACT("QC",1,$LENGTH(Y))=Y
SET Y="QC"
QUIT
+57 IF $LENGTH(Y)<4
IF $EXTRACT("SUPP",1,$LENGTH(Y))=Y
SET Y="SUPP"
QUIT
+58 IF $LENGTH(Y)<4
IF $EXTRACT("HS",1,$LENGTH(Y))=Y
SET Y="HS"
QUIT
+59 IF $LENGTH(Y)<4
IF $EXTRACT("BOTH",1,$LENGTH(Y))=Y
SET Y="BOTH"
QUIT
+60 IF $LENGTH(Y)<4
IF $EXTRACT("SSR",1,$LENGTH(Y))=Y
SET Y="SSR"
QUIT
+61 IF $LENGTH(Y)>0
IF $EXTRACT("DUE/OVERDUE",1,$LENGTH(Y))=Y
SET Y="DO"
QUIT
+62 IF $LENGTH(Y)>0
IF $EXTRACT("QUALITY OF CARE AUDIT REPORT",1,$LENGTH(Y))=Y
SET Y="QC"
QUIT
+63 IF $LENGTH(Y)>0
IF $EXTRACT("HMS SUPPLEMENT",1,$LENGTH(Y))=Y
SET Y="SUPP"
QUIT
+64 IF $LENGTH(Y)>0
IF $EXTRACT("HEALTH SUMMARY",1,$LENGTH(Y))=Y
SET Y="HS"
QUIT
+65 IF $LENGTH(Y)>0
IF $EXTRACT("BOTH HEALTH SUMMARY AND SUPPLEMENT",1,$LENGTH(Y))=Y
SET Y="BOTH"
QUIT
+66 IF $LENGTH(Y)>0
IF $EXTRACT("STATE SURVEILLANCE REPORT",1,$LENGTH(Y))=Y
SET Y="SSR"
QUIT
End DoDot:1
+67 IF '$FIND("^DO^QC^SUPP^HS^BOTH^SSR^",U_Y_U)
WRITE !!?2,"Please enter a code or description from the list.",!!
GOTO OPT1
+68 IF 'BKMCHK
WRITE " ",$SELECT(Y="DO":"Due/Overdue",Y="QC":"Quality of Care Audit Report",Y="SUPP":"HMS Supplement",Y="HS":"Health Summary",Y="BOTH":"Both Health Summary and Supplement",1:"State Surveillance Report")
+69 QUIT Y
