- 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
