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

BARRSL1.m

Go to the documentation of this file. 
  1. BARRSL1 ; IHS/SD/LSL - Selective Report Parameters-PART 2 ; 12/19/2008
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**6,10,16,19,20,23,24**;OCT 26,2005;Build 69
  1.  ; IHS/SD/TMM 7/20/10 1.8*19 Add Group Plan to A/R Statistical report.
  1.  ;     When selecting A/R STATISTICAL REPORT by Billing Entity prompt
  1.  ;             user for Group Plans to include in report data.
  1.  ;     FIXPMS10019 #1 - TSR report, Add Adjustment inclusion 
  1.  ;             parameter: "Sent To  Collections" 
  1.  ;     Resolve UNDEFINED error <UNDEFINED>S4+12^DICL2 
  1.  ;     Add STATUS CHANGE as Selection Type for TSR report
  1.  ;
  1.  ; IHS/SD/POTT 12/12 ADDED SELECTION OF CODING DX VERSION ICD-9 / ICD-10 - BAR1.8*23
  1.  ; IHS/SD/POTT 03/13 ADDED NEW VA billing - BAR1.8*23
  1.  ; IHS/SD/POTT 06/13 FIXED FLAWS IN SELECTING ICD9/10 DX - BAR1.8*23
  1.  ; IHS/SD/POTT 07/13 DO NOT ALLOW SELECT ICD10 WHEN INFRASTRUCTURE NOT PRESENT - BAR1.8*23
  1.  ; IHS/SD/POTT HEAT150941 02/09/14 Allow ALL DX9/10 - BAR1.8*24
  1.  ;                        if no DX selected: show ALL DX of ALL available coding systems
  1.  ;                        fixed escape from report after pressing ^ in DX prompts
  1.  ; ;;;IHS/SD/POTT ICD-10 SANDBOX TESTING: FIXED ERR MESSAGE Low Diagnosis is Greater than the High IF DXLO=DXHI - BAR1.8*??
  1.  ; IHS/SD/POTT BETA FIXED RETURN TO SELECT INCLUSION PARAMETERS: BAR1.8*24
  1.  ;
  1.  Q
  1.  ; ******
  1.  ;
  1. TRANTYP ; EP
  1.  D TRANTYP^BARRSL4 ;ASK FOR TRANSACTION TYPE
  1.  Q
  1.  ; 
  1. LOC ; EP
  1.  ; Select Location inclusion parameters
  1.  W !
  1.  K DIC,BARY("LOC")
  1.  S DIC="^BAR(90052.05,DUZ(2),"
  1.  S DIC(0)="ZAEMQ"
  1.  S DIC("A")="Select Visit LOCATION: "
  1.  D ^DIC
  1.  K DIC
  1.  Q:$D(DTOUT)!($D(DUOUT))
  1.  Q:+Y<1
  1.  S BARY("LOC")=+Y
  1.  S BARY("LOC","NM")=Y(0,0)
  1.  Q
  1.  ; **************
  1. TYP ; EP
  1.  ; Select BILLING ENTITY Inclusion Parameter
  1.  ; May not specify both billing entity and a/r account
  1.  K DIR,BARY("TYP"),BARY("ACCT"),BARY("PAT"),BARY("ALL"),BARY("ITYP")
  1.  ; - BAR1.8*23 UPDATED DISPATCH TABLE
  1.  S DIR(0)="SO^1:MEDICARE"
  1.  S DIR(0)=DIR(0)_";2:MEDICAID"
  1.  S DIR(0)=DIR(0)_";3:PRIVATE INSURANCE"
  1.  S DIR(0)=DIR(0)_";4:NON-BENEFICIARY PATIENTS"
  1.  S DIR(0)=DIR(0)_";5:BENEFICIARY PATIENTS"
  1.  S DIR(0)=DIR(0)_";6:SPECIFIC A/R ACCOUNT"
  1.  S DIR(0)=DIR(0)_";7:SPECIFIC PATIENT"
  1.  S DIR(0)=DIR(0)_";8:WORKMEN'S COMP"
  1.  S DIR(0)=DIR(0)_";9:PRIVATE + WORKMEN'S COMP"
  1.  S DIR(0)=DIR(0)_";10:CHIP"
  1.  S DIR(0)=DIR(0)_";11:VETERANS ADMINISTRATION"
  1.  S DIR(0)=DIR(0)_";12:OTHER"
  1.  S DIR("A")="Select TYPE of BILLING ENTITY to Display"
  1.  S DIR("?")="Enter TYPE of BILLING ENTITY to display, or press <return> for ALL"
  1.  D ^DIR
  1.  K DIR
  1.  I $D(DUOUT)!($D(DTOUT)) Q
  1.  Q:Y<1
  1.  S BARY("TYP")=U_Y_U
  1.  S BARY("TYP","NM")=Y(0)
  1.  G ACCT:Y=6,PAT:Y=7
  1.  ;P.OTT UPDATED DISPATCH TABLE  BAR1.8*23
  1.  S:Y=1 BARY("TYP")="^R^MH^MD^MC^MMC^"
  1.  S:Y=2 BARY("TYP")="^D^K^FPL^"
  1.  S:Y=3 BARY("TYP")="^H^M^P^F^"
  1.  S:Y=4 BARY("TYP")="^N^"
  1.  S:Y=5 BARY("TYP")="^I^"
  1.  S:Y=8 BARY("TYP")="^W^"
  1.  S:Y=9 BARY("TYP")="^H^M^P^F^W^"
  1.  S:Y=10 BARY("TYP")="^K^"
  1.  S:Y=11 BARY("TYP")="^V^"
  1.  S:Y=12 BARY("TYP")="^W^C^N^I^T^G^SEP^TSI^"
  1.  Q
  1.  ; ***********
  1. ACCT ; 
  1.  ; Specific insurer of billing entity parameter
  1.  K DIC
  1.  K BARY("TYP"),BARY("ACCT")
  1.  S DIC="^BARAC(DUZ(2),"
  1.  S DIC(0)="ZQEAM"
  1.  D ^DIC
  1.  K DIC
  1.  Q:$D(DTOUT)!($D(DUOUT))
  1.  Q:+Y<0
  1.  S BARY("ACCT")=+Y
  1.  S BARY("ACCT","NM")=Y(0,0)
  1.  I $G(BAR("OPT"))="STA" F BARGRPI=1:1 D GETGRP Q:+Y<0
  1.  Q
  1.  ; *******
  1. GETGRP ;  Prompt for Group #   ;New Tag... M819*ADD*TMM*20100720
  1.  W !
  1.  K DIC
  1.  S DIC="^AUTNEGRP("
  1.  S DIC("A")="ENTER IN THE GROUP NUMBER YOU WISH TO REPORT: "
  1.  S DIC(0)="AEQMZ"
  1.  D ^DIC
  1.  I Y'>0 Q
  1.  S BARY("GRP PLAN")=$G(BARGRPI)
  1.  S BARY("GRP PLAN",+Y)=Y(0,0)  ;Y=Group Plan, Y(0,0)=Group Plan Name
  1.  ;END 1.8*19
  1.  Q
  1.  ;
  1. PAT ;
  1.  ; Specific patient of billing entity parameter
  1.  K BARY("TYP"),BARY("PAT")
  1.  S DIC="^AUPNPAT("
  1.  S DIC(0)="ZQEAM"
  1.  D ^DIC
  1.  K DIC
  1.  Q:$D(DTOUT)!($D(DUOUT))
  1.  K AUPNLK("ALL")
  1.  Q:+Y<0
  1.  S BARY("PAT")=+Y
  1.  S BARY("PAT","NM")=Y(0,0)
  1.  Q
  1.  ; **********
  1. ALL ; EP
  1.  ; Select ALLOWANCE CATEGORY Inclusion Parameter  BAR1.8*23
  1.  K DIR,BARY("TYP"),BARY("ACCT"),BARY("PAT"),BARY("ALL"),BARY("ITYP")
  1.  S DIR(0)="SO^1:MEDICARE              (INS TYPES R MD MH MC MMC)" ;JULY 2003 
  1.  S DIR(0)=DIR(0)_";2:MEDICAID              (INS TYPES D K FPL)"
  1.  S DIR(0)=DIR(0)_";3:PRIVATE INSURANCE     (INS TYPES P H F M)"
  1.  S DIR(0)=DIR(0)_";4:VETERANS              (INS TYPES V)"
  1.  S DIR(0)=DIR(0)_";5:OTHER                 (INS TYPES W C N I G T SEP TSI)"
  1.  S DIR("A")="Select TYPE of ALLOWANCE CATEGORY to Display"
  1.  S DIR("?")="Enter TYPE of ALLOWANCE CATEGORY to display, or press <return> for ALL"
  1.  D ^DIR
  1.  K DIR
  1.  I $D(DUOUT)!($D(DTOUT)) S BARDONE3=1 Q
  1.  I Y<1 S BARDONE3=1 Q
  1.  S BARY("ALL")=Y
  1.  S BARY("ALL","NM")=Y(0)
  1.  Q
  1.  ; *******************
  1. DT ; EP
  1.  ; Select Date inclusion parameter
  1.  D DT^BARRSL4
  1.  Q
  1.  ; **************************
  1. PRV ; EP
  1.  ; Select Provider Inclusion Parameter
  1.  D PRV^BARRSL4
  1.  Q
  1.  ; *******************************
  1. AR ; EP
  1.  ; Select A/R Clerk Inclusion Parameter
  1.  D AR^BARRSL4
  1.  Q
  1.  ; ******************
  1. BATCH ; EP
  1.  ; Select Collection Batch Inclusion Parameter
  1.  D BATCH^BARRSL4
  1.  Q
  1.  ; *******
  1. ITEM ; EP
  1.  ; Select Collection Batch Item Inclusion Parameter
  1.  D ITEM^BARRSL4
  1.  Q
  1.  ; *************
  1. RTYP ; EP
  1.  ; Select Report Type Inclusion Parameter
  1.  D RTYP^BARRSL4
  1.  Q
  1.  ; *********************
  1. DSVC ; EP Select One Discharge Service
  1.  D DSVC^BARRSL4
  1.  Q
  1.  ; ********************  BAR1.8*23
  1. ASKICD() ;         
  1.  D ASKICD^BARRSL4()
  1.  Q Y
  1. CLNUPDX ;CLEAN UP DX
  1.  D CLNUPDX^BARRSL4
  1.  Q
  1. DX ; EP
  1.  S BARQ=0 ;^
  1.  K BARY("DX9")
  1.  K BARY("DX10")
  1.  K BARY("DX-ICDVER")
  1. DXCODE ;
  1.  ;S BARICDV=$$ASKICD() I BARICDV="^" D  QUIT ;OLD CODE  BAR1.8*24
  1.  ;FIXED RETURN TO SELECT INCLUSION PARAMETERS
  1.  S BARICDV=$$ASKICD() I BARICDV="^"  S DUOUT=0,DIRUT=0 D  QUIT  ;NEW CODE  BAR1.8*24
  1.  . D CLNUPDX
  1.  I Y="B"!(Y=10) I $T(+1^ICDEX)="" D  G DXCODE
  1.  . W !!!,"NOTE: SOME OF THE ICD-10 INFRASTRUCTURE UTILITIES ARE MISSING."
  1.  . W !,"THIS REPORT CANNOT CURRENTLY PROVIDE ANY DATA BASED ON ICD-10 DX CODES"
  1.  . Q
  1.  S BARY("DX-ICDVER")=BARICDV
  1.  I BARY("DX-ICDVER")=9 D  I $G(BARQ) Q
  1.  . D DX9 I $G(BARQ) Q
  1.  . D DXADD(9) I $G(BARQ) Q
  1.  I BARY("DX-ICDVER")=10 D  I $G(BARQ) Q
  1.  . D DX10 I $G(BARQ) Q
  1.  . D DXADD(10) I $G(BARQ) Q
  1.  I BARY("DX-ICDVER")="B" D  I $G(BARQ) Q
  1.  . D DX9 I $G(BARQ) Q
  1.  . D DXADD(9) I $G(BARQ) Q
  1.  . D DX10 I $G(BARQ) Q
  1.  . D DXADD(10) I $G(BARQ) Q
  1.  I BARY("DX-ICDVER")=9!(BARY("DX-ICDVER")="B") I '$D(BARY("DX9")) D
  1.  . K BARY("DX9")
  1.  . S BARY("DX9")="ALL"  ;- BAR1.8*24
  1.  . S BARY("DX9_ALL")="ALL"
  1.  I BARY("DX-ICDVER")=10!(BARY("DX-ICDVER")="B") I '$D(BARY("DX10")) D
  1.  . K BARY("DX10")
  1.  . S BARY("DX10")="ALL"  ;- BAR1.8*24
  1.  . S BARY("DX10_ALL")="ALL"
  1.  W !!
  1.  D SHOWDX
  1.  S DIR("A")="Are you OK with this selection"
  1.  S DIR("B")="YES"
  1.  S DIR(0)="Y"
  1.  D ^DIR
  1.  K DIR
  1.  I Y'=1 D  G DX
  1.  . W !,"OK, make a new DX selection"
  1.  Q
  1.  ;
  1. DX9 ;<------- 
  1.  ;
  1. DXLOW9 ;
  1.  K BARY("DX9")
  1.  K DIR,DIC,DA
  1.  W !!
  1.  W "Entry of Diagnosis Range ICD-9",!
  1.  W "=============================="
  1.  S DIR(0)="PO^80:ZAEMQ"
  1.  S DIR("A")="Low ICD-9 Code (from) "
  1.  I $$HAVICD10() S DIR("S")="I $P($G(^ICD9(Y,1)),U)=1" ;
  1.  D ^DIR
  1.  I $G(DUOUT) S BARQ=1 Q  ;3/25
  1.  I +Y<1 Q  ;ENTER: GO FOR INDIVIDUAL DX
  1.  S BARY("DX9",1)=$P(Y,U,2)
  1.  ;
  1. DXHI9 ;
  1.  S DIR(0)="PO^80:ZAEMQ"
  1.  S DIR("A")="High ICD-9 Code (to) "
  1.  I $$HAVICD10() S DIR("S")="I $P($G(^ICD9(Y,1)),U)=1"
  1.  D ^DIR
  1.  I $G(DUOUT) S BARQ=1 Q
  1.  I $D(BARY("DX9",1)) I +Y<1 G DXLOW9 ;IF LO DEFINED, ENTER
  1.  I +Y<1 Q  ;ENTER
  1.  S BARY("DX9",2)=$P(Y,U,2)
  1.  I BARY("DX9",1)=BARY("DX9",2) QUIT  ; - BAR1.8*24
  1.  I BARY("DX9",1)>BARY("DX9",2)!('+BARY("DX9",1)&($E(BARY("DX9",1),2,9)>$E(BARY("DX9",2),2,9))) D  G DXLOW9
  1.  .  W !!,*7,"INPUT ERROR: Low Diagnosis is Greater than the High, TRY AGAIN!",!!
  1.  Q
  1.  ; ********************** 
  1. DXADD(BARICD) ;
  1.  NEW BARDXTYP
  1.  S BARDXTYP="DX"_BARICD
  1.  K BARY(BARDXTYP,3)
  1.  F  D ADDDX(BARICD) Q:$G(BARQ)  Q:Y<0
  1.  K BARY(BARDXTYP,4)
  1.  W !!
  1.  Q
  1. ADDDX(BARICD) ;ADD ONE OR MORE SINGLE DG INTO BARY("DX9",3 or BARY("DX10",3
  1.  K DIR,DIC,DA,BARDX
  1.  N BARDXTYP
  1.  S BARDXTYP="DX"_BARICD
  1.  I $O(BARY(BARDXTYP,3,""))]"" D LIST(BARICD)
  1.  W !!
  1.  W "Entry of Diagnosis Code ICD-",BARICD,!
  1.  W "=============================="
  1.  S DIR(0)="PO^80:ZAEMQ"
  1.  S DIR("A")="Individual ICD-"_BARICD_" Code"
  1.  I BARICD=9 I $$HAVICD10() S DIR("S")="I $P($G(^ICD9(Y,1)),U)=1"
  1.  I BARICD=10 I $$HAVICD10() S DIR("S")="I $P($G(^ICD9(Y,1)),U)=30"
  1.  D ^DIR
  1.  I $G(DUOUT) S BARQ=1 Q  ;3/25 
  1.  ;I $D(DIRUT) Q
  1.  I +Y<1 Q
  1.  S BARDX=$P(Y,U,2)
  1.  I BARDX="" S BARQ1=1 Q
  1.  I $D(BARY(BARDXTYP,3,BARDX)) D  Q
  1.  . W !,"      Removed from selection."
  1.  . K BARY(BARDXTYP,3,BARDX)
  1.  S BARY(BARDXTYP,3,BARDX)="" W !,"    Added to selection." Q
  1.  Q
  1. CONTDX(BARICD) ;
  1.  QUIT
  1.  K DIR,DIC,DA
  1.  N BARDXTYP,BARDX1
  1.  S BARDXTYP="DX"_BARICD
  1.  S Y=0 K DIRUT
  1.  S DIR("A")="DX-"_BARICD_" code which begins "
  1.  S DIR(0)="FUO^3:30"
  1.  S DIR("?")="Enter partial DX"_BARICD_" code (begins with)"
  1.  I BARICD=9 S DIR("?")=DIR("?")_" in form NNN."
  1.  I BARICD=9 S DIR("?")=DIR("?")_"in form ANN (A=A...Z  N=1...0)."
  1.  D ^DIR
  1.  I Y="" S Y=-1 Q
  1.  S BARDX1=Y
  1.  D LIST^BARRSLDX(BARDX1,0)
  1.  I 'BARCNT W " no matching DXs found" Q
  1.  I $D(BARY(BARDXTYP,4,BARDX1)) D  Q
  1.  . I '$$ASKREM() Q
  1.  . K BARY(BARDXTYP,4,BARDX1)
  1.  . W !,BARDX1, "  removed from selection."
  1.  W " (",BARCNT," matching DXs found) "
  1.  S BARY(BARDXTYP,4,BARDX1)="" W !,BARDX1," added to selection." Q
  1.  Q
  1. DX10 ;
  1.  ;
  1. DXLOW10 ;
  1.  K BARY("DX10")
  1.  K DIR,DIC,DA
  1.  W !!
  1.  W "Entry of Diagnosis Range ICD-10",!
  1.  W "==============================="
  1.  S DIR(0)="PO^80:ZAEMQ"
  1.  S DIR("A")="Low ICD-10 Code (from) "
  1.  S DIR("S")="I $P($G(^ICD9(Y,1)),U)=30"
  1.  D ^DIR
  1.  I $G(DUOUT) S BARQ=1 Q  ;3/25
  1.  I +Y<1 Q  ;ENTER: GO FOR INDIVIDUAL DX
  1.  S BARY("DX10",1)=$P(Y,U,2)
  1.  ;
  1. DXHI10 ;
  1.  S DIR(0)="PO^80:ZAEMQ" ;
  1.  S DIR("A")="High ICD-10 Code (to) "
  1.  S DIR("S")="I $P($G(^ICD9(Y,1)),U)=30"
  1.  D ^DIR
  1.  I $G(DUOUT) S BARQ=1 Q  ;
  1.  ;if DX10LOW defined, and DX10HI was enterer nil; retrurn to DX10LOW entry
  1.  I $G(BARY("DX10",1))]"" I +Y<1 G DXLOW10
  1.  I +Y<1 Q  ;ENTER 
  1.  S BARY("DX10",2)=$P(Y,U,2)
  1.  ;;;I BARY("DX10",2)=BARY("DX10",1) Q  ; - BAR1.8*??
  1.  I '(BARY("DX10",2)]]BARY("DX10",1)) D  G DXLOW10
  1.  . W !!,*7,"INPUT ERROR: Low Diagnosis is Greater than the High, TRY AGAIN!",!!
  1.  Q
  1.  ; **********************
  1. DXADINFO(BARX,BARY) ; 
  1.  QUIT  ;
  1. LIST(BARICD) ;
  1.  N BAR1,BAR2,BAR3,BAR4
  1.  W !!?5,"Currently selected diagnoses: "
  1.  N BARDXTYP
  1.  S BARDXTYP="DX"_BARICD
  1.  S BAR1="" F  S BAR1=$O(BARY(BARDXTYP,3,BAR1)) Q:BAR1=""  W ! D DXINFO(BAR1) ;
  1.  S BAR1="" F  S BAR1=$O(BARY(BARDXTYP,4,BAR1)) Q:BAR1=""  W !,"code begins ",BAR1
  1.  Q
  1. LBL ; EP
  1.  ; Ask for large balance
  1.  K DIR
  1.  S DIR(0)="NAO^50:10000000:2"
  1.  S DIR("A")="Large Balance: "
  1.  S:$D(BARY("LBL")) DIR("B")=BARY("LBL")
  1.  D ^DIR
  1.  K DIR
  1.  I $D(DUOUT)!(Y="")  Q
  1.  S BARY("LBL")=+Y
  1.  Q
  1.  ; ******************
  1. SBL ; EP
  1.  ; Ask for small balance
  1.  K DIR
  1.  S DIR(0)="NAO^0:99:2"
  1.  S DIR("A")="Small Balance: "
  1.  S:$D(BARY("SBL")) DIR("B")=BARY("SBL")
  1.  D ^DIR
  1.  K DIR
  1.  I $D(DUOUT)!(Y="")  Q
  1.  S BARY("SBL")=+Y
  1.  Q
  1.  ; ****************
  1. ITYP ; EP
  1.  ; Ask for Insurer Type
  1.  K DIR,BARY("ITYP"),BARY("ACCT"),BARY("PAT"),BARY("ALL"),BARY("TYP")
  1.  K BARY("COLPT")
  1.  ;PRIV
  1.  S DIR(0)="SO^H:HMO"
  1.  S DIR(0)=DIR(0)_";M:MEDICARE SUPPL."
  1.  S DIR(0)=DIR(0)_";P:PRIVATE INSURANCE" 
  1.  S DIR(0)=DIR(0)_";F:FRATERNAL ORGANIZATION" 
  1.  ;OTHER
  1.  S DIR(0)=DIR(0)_";T:THIRD PARTY LIABILITY" 
  1.  S DIR(0)=DIR(0)_";W:WORKMEN'S COMP"
  1.  S DIR(0)=DIR(0)_";C:CHAMPUS"
  1.  S DIR(0)=DIR(0)_";N:NON-BENEFICIARY (NON-INDIAN)"
  1.  S DIR(0)=DIR(0)_";I:INDIAN PATIENT"
  1.  S DIR(0)=DIR(0)_";G:GUARANTOR"
  1.  S DIR(0)=DIR(0)_";SEP:STATE EXCHANGE PLAN" 
  1.  S DIR(0)=DIR(0)_";TSI:TRIBAL SELF INSURED" 
  1.  ;MEDICAID 
  1.  S DIR(0)=DIR(0)_";D:MEDICAID FI"
  1.  S DIR(0)=DIR(0)_";K:CHIP (KIDSCARE)"
  1.  S DIR(0)=DIR(0)_";FPL:FPL 133 PERCENT"
  1.  ;MEDICARE
  1.  S DIR(0)=DIR(0)_";R:MEDICARE FI"
  1.  S DIR(0)=DIR(0)_";MD:MEDICARE PART D"
  1.  S DIR(0)=DIR(0)_";MC:MEDICARE PART C"
  1.  S DIR(0)=DIR(0)_";MH:MEDICARE HMO"
  1.  S DIR(0)=DIR(0)_";MMC:MEDICARE MANAGED CARE"
  1.  ;VETERANS
  1.  S DIR(0)=DIR(0)_";V:VETERANS ADMINISTRATION"
  1.  ;-------END OF TABLE 
  1.  S DIR("A")="Select INSURER TYPE to Display"
  1.  S DIR("?")="Enter TYPE of INSURER to display, or press <return> for ALL"
  1.  D ^DIR
  1.  K DIR
  1.  I $D(DUOUT)!($D(DTOUT))!($D(DIRUT)) Q
  1.  S BARY("ITYP")=Y
  1.  S BARY("ITYP","NM")=Y(0)
  1.  Q
  1.  ; *****************
  1. COLPT ; EP
  1.  ; Select Collection Point and Date ranges
  1.  K BARY("COLPT"),BARY("ITYP")
  1.  S DIC="^BAR(90051.02,DUZ(2),"
  1.  S DIC(0)="ZQEAM"
  1.  D ^DIC
  1.  K DIC
  1.  Q:$D(DTOUT)!($D(DUOUT))
  1.  Q:+Y<0
  1.  S BARY("COLPT")=+Y
  1.  S BARY("COLPT","NM")=Y(0,0)
  1.  Q
  1.  ;start new code bar*1.8*20 REQ10
  1. DATASRC ;EP
  1.  ;Select Data Source
  1.  S DIR(0)="SO^1:ELECTRONIC;2:MANUAL;3:BOTH"
  1.  S DIR("A")="Select DATA SOURCE to Display"
  1.  I $D(BARY("DATA SRC")) S DIR("B")=BARY("DATA SRC")
  1.  D ^DIR
  1.  K DIR
  1.  I $D(DUOUT)!($D(DTOUT))!($D(DIRUT)) Q
  1.  S BARY("DATA SRC")=Y(0)
  1.  Q
  1.  ;end new code REQ10
  1. SHOWDX ; - BAR1.8*23 LIST SELECTED DXs
  1.  NEW BAR1,BAR2,BAR3,BARTMP1
  1.  I $G(BARY("DX9"))="ALL" W !,"Display all ICD-9 Diagnosis"
  1.  I $G(BARY("DX10"))="ALL" W !,"Display all ICD-10 Diagnosis"
  1.  F BAR1="DX9","DX10" D
  1.  . F BAR2=1,2,3 I $D(BARY(BAR1,BAR2)) D
  1.  . . W !,"ICD"_$E(BAR1,3,4) ;
  1.  . . I BAR2<3 D  Q
  1.  . . . I BAR2=1 W " FROM "
  1.  . . . I BAR2=2 W " TO   "
  1.  . . . S BARDX=BARY(BAR1,BAR2)
  1.  . . . D DXINFO(BARDX) ;
  1.  . . W "      "
  1.  . . S BARDX="" F  S BARDX=$O(BARY(BAR1,BAR2,BARDX)) Q:BARDX=""  D DXINFO(BARDX) W !
  1.  . S BAR2=4 I $D(BARY(BAR1,BAR2)) D
  1.  . . W !,BAR1
  1.  . . W " begins"
  1.  . . S BARDX="" F  S BARDX=$O(BARY(BAR1,BAR2,BARDX)) Q:BARDX=""  W ?12," ",BARDX W !
  1.  Q
  1. DXINFO(BARDX) ;
  1.  NEW BAR2,BAR3,BAR4
  1.  S BAR4=""
  1.  W ?12," ",BARDX
  1.  I $$HAVICD10() D  ;
  1.  . S BAR2=BARDX_" "
  1.  . S BAR3=$O(^ICD9("AB",BAR2,""))
  1.  . I BAR3]"" S BAR4=$P($G(^ICD9(BAR3,67,1,0)),U,2)
  1.  E  D
  1.  . S BAR2=BARDX
  1.  . S BAR3=$O(^ICD9("AB",BAR2,""))
  1.  . I BAR3]"" S BAR4=$P($G(^ICD9(BAR3,0)),U,3)
  1.  W ?20,BAR4 ;CODE - TEXT
  1.  ;ICD9 - OLD GLOBAL VERSION: ^ICD9(2,0)="100.89^^LEPTOSPIRAL INFECT NEC^^1^^^^"
  1.  ;ICD10 - NDE GLOBAL VERSION ^ICD9("AB","307.1 ",1361) =
  1.  ;                           ^ICD9(1361,67,1,0)="2781001^ANOREXIA NERVOSA"
  1.  Q
  1. ASKREM() ;
  1.  K DIR
  1.  S DIR("A")="DX already selected. Do you want to remove it from selection (Y/N): "
  1.  S DIR("B")="NO"
  1.  S DIR(0)="YOA"
  1.  D ^DIR
  1.  K DIR
  1.  I Y>0 Q 1
  1.  Q 0
  1. HAVICD10() ;RETURNS 1 IF ICD10 INSTALLED
  1.  Q $T(+1^ICDEX)]""
  1.  ;---------------------------EOR-------------------
  1.  ;SHOW(X) ;
  1.  I 'X Q
  1.  W !,"Y=",Y,"  X=",X," DTOUT: ",$G(DTOUT)," DUOUT: ",$G(DUOUT)," DIRUT: ",$G(DIRUT)," DIROUT: ",$D(DIROUT),"  $g(barq)=",$G(BARQ)
  1.  ;S DUOUT=0,DIRUT=0
  1.  Q