BARRSL4 ; IHS/SD/LSL - Selective Report Parameters-PART 2 ; 12/19/2008
;;1.8;IHS ACCOUNTS RECEIVABLE;**23,24**;OCT 26,2005;Build 69
; CODE EXTENSION OF BARRSL1
;
; IHS/SD/POTT 12/12 ADDED SELECTION OF CODING DX VERSION ICD-9 / ICD-10 - BAR1.8*23
; IHS/SD/POTT 06/13 FIXED FLAWS IN SELECTING ICD9/10 DX - BAR1.8*23
; IHS/SD/POTT 07/13 DO NOT ALLOW SELECT ICD10 WHEN INFRASTRUCTURE NOT PRESENT - BAR1.8*23
; IHS/SD/POTT HEAT150941 02/09/14 Allow ALL DX9/10 - BAR1.8*24
; if no DX selected: show ALL DX of ALL available coding systems - BAR1.8*24
;*******************************************************************************
Q
TRANTYP ; EP
;ASK FOR TRANSACTION TYPE
K BARY("TRANS TYPE")
K Y
K DIR
S DIR(0)="SO^1:PAYMENT;2:ADJUSTMENT"
I BAR("OPT")="TSR" S DIR(0)="SO^1:PAYMENT;2:ADJUSTMENT;3:STATUS CHANGE" ;1.8*19 TMM
S DIR("A")="Select ONE or MORE of the above INCLUSION PARAMETERS"
S DIR("?")="The report can be restricted to one or more of the listed parameters. A parameter can be removed by reselecting it and making a null entry."
S DIR("?",1)="If you choose PAYMENT you cannot chooose any adjustments and vise versa."
D ^DIR
I $D(DTOUT)!$D(DUOUT)!$D(DIRUT) S BARY("TRANS TYPE",40)="PAYMENT" Q
;40 = IEN OF 'PAYMENT' IN A/R TABLE ENTRY
;43 = IEN OF 'ADJUST ACCOUNT' IN A/R TABLE ENTRY
;993 = IEN OF 'SENT TO COLLECTIONS IN A/R TABLE ENTRY ;1.8*19 TMM
S BARY("TRANS TYPE",$S(Y=1:40,Y=2:43,Y=3:993,1:43))=$S(Y=1:"PAYMENT",Y=2:"ADJUST ACCOUNT",Y=3:"STATUS CHANGE",1:"ADJUST ACCOUNT") ;M819_4*DEL*TMM*20100819
K DIR
I $G(BARY("TRANS TYPE",43))="ADJUST ACCOUNT"!(BAR("OPT")="PAY") D
. K DIC,DIE,DR,DA
. S DIC(0)="AEZ"
. S DIC=90052.01
. S DIC("S")="I "",3,4,13,14,15,16,19,20,21,22,""[("",""_Y_"","")"
. S DIC("W")="N C,DINAME W "" "" W "" "",$P(^(0),U,2)"
. D ^DIC
. Q:Y'>0 ;bar*1.8*20
. N BARCAT
. I Y>0 S BARCAT=+Y,BARY("TRANS TYPE","ADJ CAT",BARCAT)=Y(0)
. E Q
. W !
. K DIC,DIE,DR,DA
. S DIC(0)="AEZ"
. S DIC=90052.02
. S DIC("S")="I $P(^(0),U,2)=BARCAT"
. D ^DIC
. K BARCAT
. I Y>0 S BARY("TRANS TYPE","ADJ TYPE",+Y)=Y(0)
I $G(BARY("TRANS TYPE",993))="STATUS CHANGE" D
. K DIC,DIE,DR,DA
. S DIC(0)="AEZ"
. S DIC=90052.01
. S DIC("S")="I "",25,""[("",""_Y_"","")"
. S DIC("W")="N C,DINAME W "" "" W "" "",$P(^(0),U,2)"
. D ^DIC
. Q:Y'>0
. N BARCAT
. I Y>0 S BARCAT=+Y,BARY("TRANS TYPE","ADJ CAT",BARCAT)=Y(0)
. E Q
. W !
. K DIC,DIE,DR,DA
. S DIC(0)="AEZ"
. S DIC=90052.02
. S DIC("S")="I $P(^(0),U,2)=BARCAT"
. D ^DIC
. K BARCAT
. I Y>0 S BARY("TRANS TYPE","ADJ TYPE",+Y)=Y(0)
. ;END 1.8*19
Q
DT ; EP
; Select Date inclusion parameter
K DIR,BARY("DT")
I BARP("RTN")="BARRTAR" Q:$D(DIRUT) D
. K BARY("BATCH"),BARY("ITEM")
. S BARTYP=4
E D Q:+BARDONE!(Y<1)
. S DIR(0)="SO^1:Approval Date;2:Visit Date;3:Export Date"
. S:BAR("OPT")="IPDR" DIR(0)="SO^1:Approval Date;2:Admission Date"
. S:BAR("OPT")="TSR" DIR(0)="SO^1:Visit Date;2:Approval Date;3:Export Date;4:Transaction Date;5:Batch Date"
. S:BAR("OPT")="PAY" DIR(0)="SO^1:Approval Date;2:Visit Date;3:Export Date;4:Transaction Date;5:Batch Date"
. S:BAR("OPT")="DAYS" DIR(0)="SO^1:Visit Date"
. S DIR("A")="Select TYPE of DATE Desired"
. D ^DIR
. K DIR
. I $D(DUOUT)!$D(DTOUT) S BARDONE=1
. S BARTYP=Y
;
DTYP ;
K DIRUT,DUOUT,DTOUT
S BARY("DT")=$S(BARTYP=1:"A",BARTYP=3:"X",BARTYP=4:"T",1:"V")
I BAR("OPT")="PAY" D
. S BARY("DT")=$S(BARTYP=1:"A",BARTYP=2:"V",BARTYP=3:"X",BARTYP=4:"T",1:"B")
I BAR("OPT")="TSR" D
. S BARY("DT")=$S(BARTYP=1:"V",BARTYP=2:"A",BARTYP=3:"X",BARTYP=4:"T",1:"B")
. I BARTYP=2 S BARTYP=1 Q
. S:BARTYP=1 BARTYP=2
I BAR("OPT")="DAYS" D
. S BARY("DT")="V"
. S BARTYP=12
;
S BARDTYP="VISIT"
S:BARTYP=1 BARDTYP="APPROVAL"
S:BARTYP=3 BARDTYP="EXPORT"
S:BARTYP=4 BARDTYP="TRANSACTION"
I BARDTYP="VISIT",BAR("OPT")="IPDR" S BARDTYP="ADMISSION"
S:BARTYP=5 BARDTYP="BATCH"
;END
S BARDTYP=BARDTYP_" DATE"
W !!," ============ Entry of ",BARDTYP," Range =============",!
S DIR("A")="Enter STARTING "_BARDTYP_" for the Report"
S DIR(0)="DOE"
D ^DIR
G DT:$D(DIRUT)
S BARY("DT",1)=Y
W !
S DIR("A")="Enter ENDING DATE for the Report"
S DIR(0)="DOE"
D ^DIR
K DIR
G DT:$D(DIRUT)
S BARY("DT",2)=Y
I BARY("DT",1)>BARY("DT",2) W !!,*7,"INPUT ERROR: Start Date is Greater than the End Date, TRY AGAIN!",!! G DTYP
Q
PRV ; EP
; Select Provider Inclusion Parameter
K BARY("PRV")
W !
S DIC("S")="I $D(^VA(200,""AK.PROVIDER"",$P(^(0),U)))" ;IHS/SD/TPF 5/22/2008 BAR*1.8*6 DD 4.1.5
S DIC="^VA(200,"
S DIC(0)="QEAM"
D ^DIC
I $D(DTOUT)!($D(DUOUT)) S BARDONE=1 Q
K DIC
S:+Y>0 BARY("PRV")=+Y
Q
; *******************************
AR ; EP
; Select A/R Clerk Inclusion Parameter
K BARY("AR")
W !
S DIC("B")=DUZ ;IHS/SD/TPF 5/22/2008 BAR*1.8*6 DD 4.1.5
S DIC="^VA(200,"
S DIC(0)="ZQEAM"
D ^DIC
I $D(DTOUT)!($D(DUOUT)) S BARDONE=1 Q
K DIC
Q:+Y<1
S BARY("AR")=+Y
S BARY("AR","NM")=Y(0,0)
Q
; ******************
BATCH ; EP
; Select Collection Batch Inclusion Parameter
K BARY("BATCH"),BARY("ITEM"),BARY("COLPT")
W !
S DIC="^BARCOL(DUZ(2),"
S DIC(0)="ZQEAM"
S DIC("A")="Select Collection Batch: "
S DIC("W")="D BATW^BARPST"
S DIC("S")="I $P(^(0),U,3)=""P""&($G(BARUSR(29,""I""))=$P(^(0),U,10))"
D ^DIC
I $D(DTOUT)!($D(DUOUT)) S BARDONE=1 Q
K DIC
Q:+Y<1
S BARCOL=+Y ;BAR*1.8*6 ERROR WHEN TESTING IHS/SD/TPF 7/24/2008
S BARY("BATCH")=+Y
S BARY("BATCH","NM")=Y(0,0)
Q
; *******
ITEM ; EP
; Select Collection Batch Item Inclusion Parameter
D BATCH
I +BARDONE!(+Y<1) Q
W !
S DA(1)=BARY("BATCH")
S DIC="^BARCOL(DUZ(2),"_DA(1)_",1,"
S DIC(0)="ZQEAM"
S DIC("A")="Select Collection Batch Item: "
S DIC("W")="D DICW^BARPST"
; Screen out cancelled items
S DIC("S")="I $P(^(0),U,17)'=""C""&($P(^(0),U,17)'=""R"")"
D ^DIC
I $D(DTOUT)!($D(DUOUT)) S BARDONE=1 Q
K DIC
Q:+Y<1
S BARY("ITEM")=+Y
S BARY("ITEM","NM")=Y(0,0)
Q
; *************
RTYP ; EP
; Select Report Type Inclusion Parameter
K DIR,BARY("RTYP")
S DIR(0)="SO^1:Detail;2:Summary;3:Detail and Summary"
; BAR*1.8*19 IHS/SD/PKD 6/01/10
I BAR("OPT")="CXL" S DIR(0)="SO^1:Detail;2:Summary"
S DIR("A")="Select TYPE of REPORT desired"
S DIR("B")=1
D ^DIR
K DIR
I $D(DUOUT)!$D(DTOUT) S BARDONE=1 Q
S BARY("RTYP")=Y
S BARY("RTYP","NM")=Y(0)
Q
; *********************
DSVC ; EP
; Select One Discharge Service
; FACILITY TREATING SPECIALTY File ^DIC(45.7)
K BARY("DSVC"),DIC,DA
S DIC="^DIC(45.7,"
S DIC(0)="ZAEMQ"
S DIC("A")="Select Discharge Service: "
D ^DIC
K DIC
Q:$D(DTOUT)!($D(DUOUT))
Q:+Y<1
S BARY("DSVC")=+Y
S BARY("DSVC","NM")=Y(0,0)
Q
; ********************
ASKICD() ; - BAR1.8*24
K DIRUT,DIR,Y
S Y=$$DIR^XBDIR("S^9:ICD-9;10:ICD-10;B:Both coding versions","Select ICD Version ","","","","",1)
K DA
Q Y
CLNUPDX ;CLEAN UP DX
;K BARY("DXTYPE") HEAT150941
K BARY("DX-ICDVER") ;- BAR1.8*24
K BARY("DX9")
K BARY("DX10")
Q
;
;-------------EOR------------
BARRSL4 ; IHS/SD/LSL - Selective Report Parameters-PART 2 ; 12/19/2008
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**23,24**;OCT 26,2005;Build 69
+2 ; CODE EXTENSION OF BARRSL1
+3 ;
+4 ; IHS/SD/POTT 12/12 ADDED SELECTION OF CODING DX VERSION ICD-9 / ICD-10 - BAR1.8*23
+5 ; IHS/SD/POTT 06/13 FIXED FLAWS IN SELECTING ICD9/10 DX - BAR1.8*23
+6 ; IHS/SD/POTT 07/13 DO NOT ALLOW SELECT ICD10 WHEN INFRASTRUCTURE NOT PRESENT - BAR1.8*23
+7 ; IHS/SD/POTT HEAT150941 02/09/14 Allow ALL DX9/10 - BAR1.8*24
+8 ; if no DX selected: show ALL DX of ALL available coding systems - BAR1.8*24
+9 ;*******************************************************************************
+10 QUIT
TRANTYP ; EP
+1 ;ASK FOR TRANSACTION TYPE
+2 KILL BARY("TRANS TYPE")
+3 KILL Y
+4 KILL DIR
+5 SET DIR(0)="SO^1:PAYMENT;2:ADJUSTMENT"
+6 ;1.8*19 TMM
IF BAR("OPT")="TSR"
SET DIR(0)="SO^1:PAYMENT;2:ADJUSTMENT;3:STATUS CHANGE"
+7 SET DIR("A")="Select ONE or MORE of the above INCLUSION PARAMETERS"
+8 SET DIR("?")="The report can be restricted to one or more of the listed parameters. A parameter can be removed by reselecting it and making a null entry."
+9 SET DIR("?",1)="If you choose PAYMENT you cannot chooose any adjustments and vise versa."
+10 DO ^DIR
+11 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)
SET BARY("TRANS TYPE",40)="PAYMENT"
QUIT
+12 ;40 = IEN OF 'PAYMENT' IN A/R TABLE ENTRY
+13 ;43 = IEN OF 'ADJUST ACCOUNT' IN A/R TABLE ENTRY
+14 ;993 = IEN OF 'SENT TO COLLECTIONS IN A/R TABLE ENTRY ;1.8*19 TMM
+15 ;M819_4*DEL*TMM*20100819
SET BARY("TRANS TYPE",$SELECT(Y=1:40,Y=2:43,Y=3:993,1:43))=$SELECT(Y=1:"PAYMENT",Y=2:"ADJUST ACCOUNT",Y=3:"STATUS CHANGE",1:"ADJUST ACCOUNT")
+16 KILL DIR
+17 IF $GET(BARY("TRANS TYPE",43))="ADJUST ACCOUNT"!(BAR("OPT")="PAY")
Begin DoDot:1
+18 KILL DIC,DIE,DR,DA
+19 SET DIC(0)="AEZ"
+20 SET DIC=90052.01
+21 SET DIC("S")="I "",3,4,13,14,15,16,19,20,21,22,""[("",""_Y_"","")"
+22 SET DIC("W")="N C,DINAME W "" "" W "" "",$P(^(0),U,2)"
+23 DO ^DIC
+24 ;bar*1.8*20
IF Y'>0
QUIT
+25 NEW BARCAT
+26 IF Y>0
SET BARCAT=+Y
SET BARY("TRANS TYPE","ADJ CAT",BARCAT)=Y(0)
+27 IF '$TEST
QUIT
+28 WRITE !
+29 KILL DIC,DIE,DR,DA
+30 SET DIC(0)="AEZ"
+31 SET DIC=90052.02
+32 SET DIC("S")="I $P(^(0),U,2)=BARCAT"
+33 DO ^DIC
+34 KILL BARCAT
+35 IF Y>0
SET BARY("TRANS TYPE","ADJ TYPE",+Y)=Y(0)
End DoDot:1
+36 IF $GET(BARY("TRANS TYPE",993))="STATUS CHANGE"
Begin DoDot:1
+37 KILL DIC,DIE,DR,DA
+38 SET DIC(0)="AEZ"
+39 SET DIC=90052.01
+40 SET DIC("S")="I "",25,""[("",""_Y_"","")"
+41 SET DIC("W")="N C,DINAME W "" "" W "" "",$P(^(0),U,2)"
+42 DO ^DIC
+43 IF Y'>0
QUIT
+44 NEW BARCAT
+45 IF Y>0
SET BARCAT=+Y
SET BARY("TRANS TYPE","ADJ CAT",BARCAT)=Y(0)
+46 IF '$TEST
QUIT
+47 WRITE !
+48 KILL DIC,DIE,DR,DA
+49 SET DIC(0)="AEZ"
+50 SET DIC=90052.02
+51 SET DIC("S")="I $P(^(0),U,2)=BARCAT"
+52 DO ^DIC
+53 KILL BARCAT
+54 IF Y>0
SET BARY("TRANS TYPE","ADJ TYPE",+Y)=Y(0)
+55 ;END 1.8*19
End DoDot:1
+56 QUIT
DT ; EP
+1 ; Select Date inclusion parameter
+2 KILL DIR,BARY("DT")
+3 IF BARP("RTN")="BARRTAR"
IF $DATA(DIRUT)
QUIT
Begin DoDot:1
+4 KILL BARY("BATCH"),BARY("ITEM")
+5 SET BARTYP=4
End DoDot:1
+6 IF '$TEST
Begin DoDot:1
+7 SET DIR(0)="SO^1:Approval Date;2:Visit Date;3:Export Date"
+8 IF BAR("OPT")="IPDR"
SET DIR(0)="SO^1:Approval Date;2:Admission Date"
+9 IF BAR("OPT")="TSR"
SET DIR(0)="SO^1:Visit Date;2:Approval Date;3:Export Date;4:Transaction Date;5:Batch Date"
+10 IF BAR("OPT")="PAY"
SET DIR(0)="SO^1:Approval Date;2:Visit Date;3:Export Date;4:Transaction Date;5:Batch Date"
+11 IF BAR("OPT")="DAYS"
SET DIR(0)="SO^1:Visit Date"
+12 SET DIR("A")="Select TYPE of DATE Desired"
+13 DO ^DIR
+14 KILL DIR
+15 IF $DATA(DUOUT)!$DATA(DTOUT)
SET BARDONE=1
+16 SET BARTYP=Y
End DoDot:1
IF +BARDONE!(Y<1)
QUIT
+17 ;
DTYP ;
+1 KILL DIRUT,DUOUT,DTOUT
+2 SET BARY("DT")=$SELECT(BARTYP=1:"A",BARTYP=3:"X",BARTYP=4:"T",1:"V")
+3 IF BAR("OPT")="PAY"
Begin DoDot:1
+4 SET BARY("DT")=$SELECT(BARTYP=1:"A",BARTYP=2:"V",BARTYP=3:"X",BARTYP=4:"T",1:"B")
End DoDot:1
+5 IF BAR("OPT")="TSR"
Begin DoDot:1
+6 SET BARY("DT")=$SELECT(BARTYP=1:"V",BARTYP=2:"A",BARTYP=3:"X",BARTYP=4:"T",1:"B")
+7 IF BARTYP=2
SET BARTYP=1
QUIT
+8 IF BARTYP=1
SET BARTYP=2
End DoDot:1
+9 IF BAR("OPT")="DAYS"
Begin DoDot:1
+10 SET BARY("DT")="V"
+11 SET BARTYP=12
End DoDot:1
+12 ;
+13 SET BARDTYP="VISIT"
+14 IF BARTYP=1
SET BARDTYP="APPROVAL"
+15 IF BARTYP=3
SET BARDTYP="EXPORT"
+16 IF BARTYP=4
SET BARDTYP="TRANSACTION"
+17 IF BARDTYP="VISIT"
IF BAR("OPT")="IPDR"
SET BARDTYP="ADMISSION"
+18 IF BARTYP=5
SET BARDTYP="BATCH"
+19 ;END
+20 SET BARDTYP=BARDTYP_" DATE"
+21 WRITE !!," ============ Entry of ",BARDTYP," Range =============",!
+22 SET DIR("A")="Enter STARTING "_BARDTYP_" for the Report"
+23 SET DIR(0)="DOE"
+24 DO ^DIR
+25 IF $DATA(DIRUT)
GOTO DT
+26 SET BARY("DT",1)=Y
+27 WRITE !
+28 SET DIR("A")="Enter ENDING DATE for the Report"
+29 SET DIR(0)="DOE"
+30 DO ^DIR
+31 KILL DIR
+32 IF $DATA(DIRUT)
GOTO DT
+33 SET BARY("DT",2)=Y
+34 IF BARY("DT",1)>BARY("DT",2)
WRITE !!,*7,"INPUT ERROR: Start Date is Greater than the End Date, TRY AGAIN!",!!
GOTO DTYP
+35 QUIT
PRV ; EP
+1 ; Select Provider Inclusion Parameter
+2 KILL BARY("PRV")
+3 WRITE !
+4 ;IHS/SD/TPF 5/22/2008 BAR*1.8*6 DD 4.1.5
SET DIC("S")="I $D(^VA(200,""AK.PROVIDER"",$P(^(0),U)))"
+5 SET DIC="^VA(200,"
+6 SET DIC(0)="QEAM"
+7 DO ^DIC
+8 IF $DATA(DTOUT)!($DATA(DUOUT))
SET BARDONE=1
QUIT
+9 KILL DIC
+10 IF +Y>0
SET BARY("PRV")=+Y
+11 QUIT
+12 ; *******************************
AR ; EP
+1 ; Select A/R Clerk Inclusion Parameter
+2 KILL BARY("AR")
+3 WRITE !
+4 ;IHS/SD/TPF 5/22/2008 BAR*1.8*6 DD 4.1.5
SET DIC("B")=DUZ
+5 SET DIC="^VA(200,"
+6 SET DIC(0)="ZQEAM"
+7 DO ^DIC
+8 IF $DATA(DTOUT)!($DATA(DUOUT))
SET BARDONE=1
QUIT
+9 KILL DIC
+10 IF +Y<1
QUIT
+11 SET BARY("AR")=+Y
+12 SET BARY("AR","NM")=Y(0,0)
+13 QUIT
+14 ; ******************
BATCH ; EP
+1 ; Select Collection Batch Inclusion Parameter
+2 KILL BARY("BATCH"),BARY("ITEM"),BARY("COLPT")
+3 WRITE !
+4 SET DIC="^BARCOL(DUZ(2),"
+5 SET DIC(0)="ZQEAM"
+6 SET DIC("A")="Select Collection Batch: "
+7 SET DIC("W")="D BATW^BARPST"
+8 SET DIC("S")="I $P(^(0),U,3)=""P""&($G(BARUSR(29,""I""))=$P(^(0),U,10))"
+9 DO ^DIC
+10 IF $DATA(DTOUT)!($DATA(DUOUT))
SET BARDONE=1
QUIT
+11 KILL DIC
+12 IF +Y<1
QUIT
+13 ;BAR*1.8*6 ERROR WHEN TESTING IHS/SD/TPF 7/24/2008
SET BARCOL=+Y
+14 SET BARY("BATCH")=+Y
+15 SET BARY("BATCH","NM")=Y(0,0)
+16 QUIT
+17 ; *******
ITEM ; EP
+1 ; Select Collection Batch Item Inclusion Parameter
+2 DO BATCH
+3 IF +BARDONE!(+Y<1)
QUIT
+4 WRITE !
+5 SET DA(1)=BARY("BATCH")
+6 SET DIC="^BARCOL(DUZ(2),"_DA(1)_",1,"
+7 SET DIC(0)="ZQEAM"
+8 SET DIC("A")="Select Collection Batch Item: "
+9 SET DIC("W")="D DICW^BARPST"
+10 ; Screen out cancelled items
+11 SET DIC("S")="I $P(^(0),U,17)'=""C""&($P(^(0),U,17)'=""R"")"
+12 DO ^DIC
+13 IF $DATA(DTOUT)!($DATA(DUOUT))
SET BARDONE=1
QUIT
+14 KILL DIC
+15 IF +Y<1
QUIT
+16 SET BARY("ITEM")=+Y
+17 SET BARY("ITEM","NM")=Y(0,0)
+18 QUIT
+19 ; *************
RTYP ; EP
+1 ; Select Report Type Inclusion Parameter
+2 KILL DIR,BARY("RTYP")
+3 SET DIR(0)="SO^1:Detail;2:Summary;3:Detail and Summary"
+4 ; BAR*1.8*19 IHS/SD/PKD 6/01/10
+5 IF BAR("OPT")="CXL"
SET DIR(0)="SO^1:Detail;2:Summary"
+6 SET DIR("A")="Select TYPE of REPORT desired"
+7 SET DIR("B")=1
+8 DO ^DIR
+9 KILL DIR
+10 IF $DATA(DUOUT)!$DATA(DTOUT)
SET BARDONE=1
QUIT
+11 SET BARY("RTYP")=Y
+12 SET BARY("RTYP","NM")=Y(0)
+13 QUIT
+14 ; *********************
DSVC ; EP
+1 ; Select One Discharge Service
+2 ; FACILITY TREATING SPECIALTY File ^DIC(45.7)
+3 KILL BARY("DSVC"),DIC,DA
+4 SET DIC="^DIC(45.7,"
+5 SET DIC(0)="ZAEMQ"
+6 SET DIC("A")="Select Discharge Service: "
+7 DO ^DIC
+8 KILL DIC
+9 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+10 IF +Y<1
QUIT
+11 SET BARY("DSVC")=+Y
+12 SET BARY("DSVC","NM")=Y(0,0)
+13 QUIT
+14 ; ********************
ASKICD() ; - BAR1.8*24
+1 KILL DIRUT,DIR,Y
+2 SET Y=$$DIR^XBDIR("S^9:ICD-9;10:ICD-10;B:Both coding versions","Select ICD Version ","","","","",1)
+3 KILL DA
+4 QUIT Y
CLNUPDX ;CLEAN UP DX
+1 ;K BARY("DXTYPE") HEAT150941
+2 ;- BAR1.8*24
KILL BARY("DX-ICDVER")
+3 KILL BARY("DX9")
+4 KILL BARY("DX10")
+5 QUIT
+6 ;
+7 ;-------------EOR------------