BARRSL4.m

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------------