BADEASU.m

BADEASU ; IHS/OIT/FJE  MSC/VAC/AMF - Dentrix HL7 UTILITIES  DISPLAY EDR ASUFAC ;14-Sep-2010 13:29;EDR

 ;;1.0;DENTAL/EDR INTERFACE;**1**;AUG 22, 2011

 ;; Modified - IHS/MSC/VAC - 8/2010 - Move from BEE namespace to BADE namespace

 ;; Modified - IHS/MSC/AMF - 10/2010 - Trace Function

 ;;

 Q

CLEAN ;EP for diagnostic use only by programmer

 ;K ^HLB

 ;K ^HLA

 S ^HLB(0)="HLO MESSAGES^778O^^"

 S ^HLA(0)="HLO MESSAGE BODY^777D^^"

 S ^HLC("QUEUECOUNT","OUT","DENTRIX:5012","DENT ADT")=0

 S ^HLC("QUEUECOUNT","IN","DENTRIX:5012","DENT ADT")=0

 S ^HLC("QUEUECOUNT","OUT","DENTRIX:5012","DENT MFE")=0

 S ^HLC("QUEUECOUNT","IN","DENTRIX:5012","DENT MFE")=0

 S ^HLC("FILE777","OUT")=0

 S ^HLC("FILE778","OUT","TCP")=0

 Q

RSEND ;EP

 N X

 W !,"Reset a message in HLO for EIE transport"

 W !!,"Are you sure you want to reset an HLO message" S %=2 D YN^DICN I %'=1 S Y=-1 Q

 S DIR(0)="N",DIR("A")="Enter IEN to remove 16,17,20,21 DATA" D ^DIR K DIR

 Q:Y="^"  S X=Y

 I '$D(^HLB(X,0)) W !,"Message IEN not identified..",! Q

 S $P(^HLB(X,0),"^",16)=""

 S $P(^HLB(X,0),"^",17)=""

 S $P(^HLB(X,0),"^",20)=""

 S $P(^HLB(X,0),"^",21)=""

 S ^HLB(X,4)=""

 W !,"Message IEN "_X_" reset.."

 S DIR(0)="EA",DIR("?")="",DIR("A")="Press ENTER to continue..." D ^DIR K DIR

 Q

ASUFAC ;EP LOOK FOR ALL ACTIVE ASUFAC NUMBERS

 N X,X1,X2,BADEX

 S X=0 F  S X=$O(^AUPNPAT(X)) Q:+X=0  D

 .S X1=0 F  S X1=$O(^AUPNPAT(X,41,X1)) Q:+X1=0  D

 ..S X2=$P($G(^AUPNPAT(X,41,X1,0)),"^",3)

 ..I $L(X2) D

 ...I '$D(BADEX("I",X1)) S BADEX("I",X1)=0

 ...S BADEX("I",X1)=BADEX("I",X1)+1

 ..I '$L(X2) D

 ...I '$D(BADEX("A",X1)) S BADEX("A",X1)=0

 ...S BADEX("A",X1)=BADEX("A",X1)+1

 W @IOF,!,"     A S U F A C  D I S P L A Y",!

 W !!,"Active  Count",?15,"Facility",?55,"ASUFAC"

 S X=0 F  S X=$O(BADEX("A",X)) Q:+X=0  D

 .S $P(BADEX("A",X),"^",2)=$P($G(^DIC(4,X,0)),"^",1)

 .S $P(BADEX("A",X),"^",3)=$P($G(^AUTTLOC(X,0)),"^",10)

 .W !,"Active:  ",$P(BADEX("A",X),"^",1),?15,$P(BADEX("A",X),"^",2),?55,$P(BADEX("A",X),"^",3)

 W !!,"Inactive Count",?15,"Facility",?55,"ASUFAC"

 S X=0 F  S X=$O(BADEX("I",X)) Q:+X=0  D

 .S $P(BADEX("I",X),"^",2)=$P($G(^DIC(4,X,0)),"^",1)

 .S $P(BADEX("I",X),"^",3)=$P($G(^AUTTLOC(X,0)),"^",10)

 .W !,"Inactive:",$P(BADEX("I",X),"^",1),?15,$P(BADEX("I",X),"^",2),?55,$P(BADEX("I",X),"^",3)

 S DIR(0)="EA",DIR("?")="",DIR("A")="Press ENTER to continue..." D ^DIR K DIR

 Q

TRACE ;EP

 ;Toggles globals for EIE Trace

 N OUT,IN,DIR,QUIT

 W !!,"This option is used to toggle the Ensemble Engine Trace."

 W !,"When the trace is enabled, it can slow down the system, so it should only be used for less than 5 minutes at a time.",!

 S OUT=+$G(^BEEICTRL("TRACE","Dental"))

 S IN=+$G(^BEEICTRL("TRACE","DENTRIX"))

 S QUIT=0

 I OUT D  Q:QUIT

 .W !!,"Currently, your OUTBOUND trace is enabled."

 .S DIR(0)="Y",DIR("A")="Do you want to stop the OUTBOUND trace",DIR("B")="Yes" D ^DIR K DIR

 .S:Y=U QUIT=1

 .I Y S ^BEEICTRL("TRACE","Dental")=0 W !,"OUTBOUND trace has been stopped." D CON

 I 'OUT D  Q:QUIT

 .W ! S DIR(0)="Y",DIR("A")="Do you want to start the OUTBOUND trace",DIR("B")="Yes" D ^DIR K DIR

 .S:Y=U QUIT=1

 .I Y S ^BEEICTRL("TRACE","Dental")=1 W !,"OUTBOUND trace has been enabled.",!,"Remember to discontinue it within a few minutes." D CON

 I IN D  Q:QUIT

 .W !!,"Currently, your INBOUND trace is enabled."

 .S DIR(0)="Y",DIR("A")="Do you want to stop the INBOUND trace",DIR("B")="Yes" D ^DIR K DIR

 .S:Y=U QUIT=1

 .I Y S ^BEEICTRL("TRACE","DENTRIX")=0 W !,"INBOUND trace has been stopped." D CON

 I 'IN D  Q:QUIT

 .W ! S DIR(0)="Y",DIR("A")="Do you want to start the INBOUND trace",DIR("B")="Yes" D ^DIR K DIR

 .S:Y=U QUIT=1

 .I Y S ^BEEICTRL("TRACE","DENTRIX")=1 W !,"INBOUND trace has been enabled.",!,"Remember to discontinue it within a few minutes." D CON

 Q

 ;

CON ;

 S DIR(0)="EA",DIR("?")="",DIR("A")="Press ENTER to continue..." D ^DIR K DIR

 Q

 ;

BADEASU   ; IHS/OIT/FJE  MSC/VAC/AMF - Dentrix HL7 UTILITIES  DISPLAY EDR ASUFAC ;14-Sep-2010 13:29;EDR

 +1       ;;1.0;DENTAL/EDR INTERFACE;**1**;AUG 22, 2011

 +2       ;; Modified - IHS/MSC/VAC - 8/2010 - Move from BEE namespace to BADE namespace

 +3       ;; Modified - IHS/MSC/AMF - 10/2010 - Trace Function

 +4       ;;

 +5        QUIT 

CLEAN     ;EP for diagnostic use only by programmer

 +1       ;K ^HLB

 +2       ;K ^HLA

 +3        SET ^HLB(0)="HLO MESSAGES^778O^^"

 +4        SET ^HLA(0)="HLO MESSAGE BODY^777D^^"

 +5        SET ^HLC("QUEUECOUNT","OUT","DENTRIX:5012","DENT ADT")=0

 +6        SET ^HLC("QUEUECOUNT","IN","DENTRIX:5012","DENT ADT")=0

 +7        SET ^HLC("QUEUECOUNT","OUT","DENTRIX:5012","DENT MFE")=0

 +8        SET ^HLC("QUEUECOUNT","IN","DENTRIX:5012","DENT MFE")=0

 +9        SET ^HLC("FILE777","OUT")=0

 +10       SET ^HLC("FILE778","OUT","TCP")=0

 +11       QUIT 

RSEND     ;EP

 +1        NEW X

 +2        WRITE !,"Reset a message in HLO for EIE transport"

 +3        WRITE !!,"Are you sure you want to reset an HLO message"

           SET %=2

           DO YN^DICN

           IF %'=1

               SET Y=-1

               QUIT 

 +4        SET DIR(0)="N"

           SET DIR("A")="Enter IEN to remove 16,17,20,21 DATA"

           DO ^DIR

           KILL DIR

 +5        IF Y="^"

               QUIT 

           SET X=Y

 +6        IF '$DATA(^HLB(X,0))

               WRITE !,"Message IEN not identified..",!

               QUIT 

 +7        SET $PIECE(^HLB(X,0),"^",16)=""

 +8        SET $PIECE(^HLB(X,0),"^",17)=""

 +9        SET $PIECE(^HLB(X,0),"^",20)=""

 +10       SET $PIECE(^HLB(X,0),"^",21)=""

 +11       SET ^HLB(X,4)=""

 +12       WRITE !,"Message IEN "_X_" reset.."

 +13       SET DIR(0)="EA"

           SET DIR("?")=""

           SET DIR("A")="Press ENTER to continue..."

           DO ^DIR

           KILL DIR

 +14       QUIT 

ASUFAC    ;EP LOOK FOR ALL ACTIVE ASUFAC NUMBERS

 +1        NEW X,X1,X2,BADEX

 +2        SET X=0

           FOR 

               SET X=$ORDER(^AUPNPAT(X))

               IF +X=0

                   QUIT 

               Begin DoDot:1

 +3                SET X1=0

                   FOR 

                       SET X1=$ORDER(^AUPNPAT(X,41,X1))

                       IF +X1=0

                           QUIT 

                       Begin DoDot:2

 +4                        SET X2=$PIECE($GET(^AUPNPAT(X,41,X1,0)),"^",3)

 +5                        IF $LENGTH(X2)

                               Begin DoDot:3

 +6                                IF '$DATA(BADEX("I",X1))

                                       SET BADEX("I",X1)=0

 +7                                SET BADEX("I",X1)=BADEX("I",X1)+1

                               End DoDot:3

 +8                        IF '$LENGTH(X2)

                               Begin DoDot:3

 +9                                IF '$DATA(BADEX("A",X1))

                                       SET BADEX("A",X1)=0

 +10                               SET BADEX("A",X1)=BADEX("A",X1)+1

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +11       WRITE @IOF,!,"     A S U F A C  D I S P L A Y",!

 +12       WRITE !!,"Active  Count",?15,"Facility",?55,"ASUFAC"

 +13       SET X=0

           FOR 

               SET X=$ORDER(BADEX("A",X))

               IF +X=0

                   QUIT 

               Begin DoDot:1

 +14               SET $PIECE(BADEX("A",X),"^",2)=$PIECE($GET(^DIC(4,X,0)),"^",1)

 +15               SET $PIECE(BADEX("A",X),"^",3)=$PIECE($GET(^AUTTLOC(X,0)),"^",10)

 +16               WRITE !,"Active:  ",$PIECE(BADEX("A",X),"^",1),?15,$PIECE(BADEX("A",X),"^",2),?55,$PIECE(BADEX("A",X),"^",3)

               End DoDot:1

 +17       WRITE !!,"Inactive Count",?15,"Facility",?55,"ASUFAC"

 +18       SET X=0

           FOR 

               SET X=$ORDER(BADEX("I",X))

               IF +X=0

                   QUIT 

               Begin DoDot:1

 +19               SET $PIECE(BADEX("I",X),"^",2)=$PIECE($GET(^DIC(4,X,0)),"^",1)

 +20               SET $PIECE(BADEX("I",X),"^",3)=$PIECE($GET(^AUTTLOC(X,0)),"^",10)

 +21               WRITE !,"Inactive:",$PIECE(BADEX("I",X),"^",1),?15,$PIECE(BADEX("I",X),"^",2),?55,$PIECE(BADEX("I",X),"^",3)

               End DoDot:1

 +22       SET DIR(0)="EA"

           SET DIR("?")=""

           SET DIR("A")="Press ENTER to continue..."

           DO ^DIR

           KILL DIR

 +23       QUIT 

TRACE     ;EP

 +1       ;Toggles globals for EIE Trace

 +2        NEW OUT,IN,DIR,QUIT

 +3        WRITE !!,"This option is used to toggle the Ensemble Engine Trace."

 +4        WRITE !,"When the trace is enabled, it can slow down the system, so it should only be used for less than 5 minutes at a time.",!

 +5        SET OUT=+$GET(^BEEICTRL("TRACE","Dental"))

 +6        SET IN=+$GET(^BEEICTRL("TRACE","DENTRIX"))

 +7        SET QUIT=0

 +8        IF OUT

               Begin DoDot:1

 +9                WRITE !!,"Currently, your OUTBOUND trace is enabled."

 +10               SET DIR(0)="Y"

                   SET DIR("A")="Do you want to stop the OUTBOUND trace"

                   SET DIR("B")="Yes"

                   DO ^DIR

                   KILL DIR

 +11               IF Y=U

                       SET QUIT=1

 +12               IF Y

                       SET ^BEEICTRL("TRACE","Dental")=0

                       WRITE !,"OUTBOUND trace has been stopped."

                       DO CON

               End DoDot:1

               IF QUIT

                   QUIT 

 +13       IF 'OUT

               Begin DoDot:1

 +14               WRITE !

                   SET DIR(0)="Y"

                   SET DIR("A")="Do you want to start the OUTBOUND trace"

                   SET DIR("B")="Yes"

                   DO ^DIR

                   KILL DIR

 +15               IF Y=U

                       SET QUIT=1

 +16               IF Y

                       SET ^BEEICTRL("TRACE","Dental")=1

                       WRITE !,"OUTBOUND trace has been enabled.",!,"Remember to discontinue it within a few minutes."

                       DO CON

               End DoDot:1

               IF QUIT

                   QUIT 

 +17       IF IN

               Begin DoDot:1

 +18               WRITE !!,"Currently, your INBOUND trace is enabled."

 +19               SET DIR(0)="Y"

                   SET DIR("A")="Do you want to stop the INBOUND trace"

                   SET DIR("B")="Yes"

                   DO ^DIR

                   KILL DIR

 +20               IF Y=U

                       SET QUIT=1

 +21               IF Y

                       SET ^BEEICTRL("TRACE","DENTRIX")=0

                       WRITE !,"INBOUND trace has been stopped."

                       DO CON

               End DoDot:1

               IF QUIT

                   QUIT 

 +22       IF 'IN

               Begin DoDot:1

 +23               WRITE !

                   SET DIR(0)="Y"

                   SET DIR("A")="Do you want to start the INBOUND trace"

                   SET DIR("B")="Yes"

                   DO ^DIR

                   KILL DIR

 +24               IF Y=U

                       SET QUIT=1

 +25               IF Y

                       SET ^BEEICTRL("TRACE","DENTRIX")=1

                       WRITE !,"INBOUND trace has been enabled.",!,"Remember to discontinue it within a few minutes."

                       DO CON

               End DoDot:1

               IF QUIT

                   QUIT 

 +26       QUIT 

 +27      ;

CON       ;

 +1        SET DIR(0)="EA"

           SET DIR("?")=""

           SET DIR("A")="Press ENTER to continue..."

           DO ^DIR

           KILL DIR

 +2        QUIT 

 +3       ;