BADE10P3.m

BADE10P3 ;IHS/GDIT/DMB - Dentrix HL7 interface ;20-Feb-2013

 ;;1.0;DENTAL/EDR INTERFACE;**3**;FEB 20, 2013;Build 4

 ;

 Q

POST ; Post Install Entry Point

 D BMES^XPDUTL("Starting Post-Install")

 D HLO

 D CNT

 D BMES^XPDUTL("Post-Install is complete")

 Q

 ;

HLO ;

 N QUEUE,HL778IEN,MSG,CNT,CNT2

 D BMES^XPDUTL("  Clearing Invalid Entries on the HLO queue")

 S QUEUE="",CNT=0,CNT2=0

 F  S QUEUE=$O(^HLB("QUEUE","OUT",QUEUE)) Q:QUEUE=""  D

 . S HL778IEN=""

 . F  S HL778IEN=$O(^HLB("QUEUE","OUT",QUEUE,"DENT ADT",HL778IEN)) Q:'HL778IEN  D

 .. S CNT=CNT+1

 .. I CNT#1000=1 W "."

 .. S MSG=$G(^HLB(HL778IEN,0))

 .. I MSG="" K ^HLB("QUEUE","OUT",QUEUE,"DENT ADT",HL778IEN) S CNT2=CNT2+1 Q

 .. I MSG'["DENT ADT" K ^HLB("QUEUE","OUT",QUEUE,"DENT ADT",HL778IEN) S CNT2=CNT2+1 Q

 .. I $P(MSG,U,9),$P(MSG,U,20)="SU" K ^HLB("QUEUE","OUT",QUEUE,"DENT ADT",HL778IEN) S CNT2=CNT2+1 Q

 D BMES^XPDUTL("    "_CNT2_" entries corrected")

 Q

CNT ; Find latest message number that was used in each category and reset the message IEN counters.

 N INTCP,INNOTCP,OUTTCP,OUTNOTCP,OUT

 D BMES^XPDUTL("  Checking/resetting HLO message counters")

 ; Global ^HLA; File 777

 ;^HLC("FILE777","OUT") 0 thru 99999999999

 S OUT=$O(^HLA(100000000000),-1)

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

 ;^HLC("FILE777","IN","TCP") 100000000000 thru 199999999999

 S INTCP=$O(^HLA(200000000000),-1)

 I INTCP<100000000000 S INTCP=0

 E  S INTCP=INTCP#100000000000

 S ^HLC("FILE777","IN","TCP")=INTCP

 ;^HLC("FILE777","IN","NOT TCP") 200000000000 thru 299999999999

 S INNOTCP=$O(^HLA(300000000000),-1)

 I INNOTCP<200000000000 S INNOTCP=0

 E  S INNOTCP=INNOTCP#200000000000

 S ^HLC("FILE777","IN","NOT TCP")=INNOTCP

 ; Global HLB; File 778

 ;^HLC("FILE778","OUT","TCP") 0 thru 99999999999

 S OUTTCP=$O(^HLB(100000000000),-1)

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

 ;^HLC("FILE778","OUT","NOT TCP") 100000000000 thru 199999999999

 S OUTNOTCP=$O(^HLB(200000000000),-1)

 I OUTNOTCP<100000000000 S OUTNOTCP=0

 E  S OUTTCP=OUTTCP#100000000000

 S ^HLC("FILE778","OUT","NOT TCP")=OUTNOTCP

 ;^HLC("FILE778","IN","TCP") 200000000000 thru 299999999999

 S INTCP=$O(^HLB(300000000000),-1)

 I INTCP<200000000000 S INTCP=0

 E  S INTCP=INTCP#200000000000

 S ^HLC("FILE778","IN","TCP")=INTCP

 ;^HLC("FILE778","IN","NOT TCP") 300000000000 thru 399999999999

 S INNOTCP=$O(^HLB(400000000000),-1)

 I INNOTCP<300000000000 S INNOTCP=0

 E  S INNOTCP=INNOTCP#300000000000

 S ^HLC("FILE778","IN","NOT TCP")=INNOTCP

 Q

BADE10P3  ;IHS/GDIT/DMB - Dentrix HL7 interface ;20-Feb-2013

 +1       ;;1.0;DENTAL/EDR INTERFACE;**3**;FEB 20, 2013;Build 4

 +2       ;

 +3        QUIT 

POST      ; Post Install Entry Point

 +1        DO BMES^XPDUTL("Starting Post-Install")

 +2        DO HLO

 +3        DO CNT

 +4        DO BMES^XPDUTL("Post-Install is complete")

 +5        QUIT 

 +6       ;

HLO       ;

 +1        NEW QUEUE,HL778IEN,MSG,CNT,CNT2

 +2        DO BMES^XPDUTL("  Clearing Invalid Entries on the HLO queue")

 +3        SET QUEUE=""

           SET CNT=0

           SET CNT2=0

 +4        FOR 

               SET QUEUE=$ORDER(^HLB("QUEUE","OUT",QUEUE))

               IF QUEUE=""

                   QUIT 

               Begin DoDot:1

 +5                SET HL778IEN=""

 +6                FOR 

                       SET HL778IEN=$ORDER(^HLB("QUEUE","OUT",QUEUE,"DENT ADT",HL778IEN))

                       IF 'HL778IEN

                           QUIT 

                       Begin DoDot:2

 +7                        SET CNT=CNT+1

 +8                        IF CNT#1000=1

                               WRITE "."

 +9                        SET MSG=$GET(^HLB(HL778IEN,0))

 +10                       IF MSG=""

                               KILL ^HLB("QUEUE","OUT",QUEUE,"DENT ADT",HL778IEN)

                               SET CNT2=CNT2+1

                               QUIT 

 +11                       IF MSG'["DENT ADT"

                               KILL ^HLB("QUEUE","OUT",QUEUE,"DENT ADT",HL778IEN)

                               SET CNT2=CNT2+1

                               QUIT 

 +12                       IF $PIECE(MSG,U,9)

                               IF $PIECE(MSG,U,20)="SU"

                                   KILL ^HLB("QUEUE","OUT",QUEUE,"DENT ADT",HL778IEN)

                                   SET CNT2=CNT2+1

                                   QUIT 

                       End DoDot:2

               End DoDot:1

 +13       DO BMES^XPDUTL("    "_CNT2_" entries corrected")

 +14       QUIT 

CNT       ; Find latest message number that was used in each category and reset the message IEN counters.

 +1        NEW INTCP,INNOTCP,OUTTCP,OUTNOTCP,OUT

 +2        DO BMES^XPDUTL("  Checking/resetting HLO message counters")

 +3       ; Global ^HLA; File 777

 +4       ;^HLC("FILE777","OUT") 0 thru 99999999999

 +5        SET OUT=$ORDER(^HLA(100000000000),-1)

 +6        SET ^HLC("FILE777","OUT")=OUT

 +7       ;^HLC("FILE777","IN","TCP") 100000000000 thru 199999999999

 +8        SET INTCP=$ORDER(^HLA(200000000000),-1)

 +9        IF INTCP<100000000000

               SET INTCP=0

 +10      IF '$TEST

               SET INTCP=INTCP#100000000000

 +11       SET ^HLC("FILE777","IN","TCP")=INTCP

 +12      ;^HLC("FILE777","IN","NOT TCP") 200000000000 thru 299999999999

 +13       SET INNOTCP=$ORDER(^HLA(300000000000),-1)

 +14       IF INNOTCP<200000000000

               SET INNOTCP=0

 +15      IF '$TEST

               SET INNOTCP=INNOTCP#200000000000

 +16       SET ^HLC("FILE777","IN","NOT TCP")=INNOTCP

 +17      ; Global HLB; File 778

 +18      ;^HLC("FILE778","OUT","TCP") 0 thru 99999999999

 +19       SET OUTTCP=$ORDER(^HLB(100000000000),-1)

 +20       SET ^HLC("FILE778","OUT","TCP")=OUTTCP

 +21      ;^HLC("FILE778","OUT","NOT TCP") 100000000000 thru 199999999999

 +22       SET OUTNOTCP=$ORDER(^HLB(200000000000),-1)

 +23       IF OUTNOTCP<100000000000

               SET OUTNOTCP=0

 +24      IF '$TEST

               SET OUTTCP=OUTTCP#100000000000

 +25       SET ^HLC("FILE778","OUT","NOT TCP")=OUTNOTCP

 +26      ;^HLC("FILE778","IN","TCP") 200000000000 thru 299999999999

 +27       SET INTCP=$ORDER(^HLB(300000000000),-1)

 +28       IF INTCP<200000000000

               SET INTCP=0

 +29      IF '$TEST

               SET INTCP=INTCP#200000000000

 +30       SET ^HLC("FILE778","IN","TCP")=INTCP

 +31      ;^HLC("FILE778","IN","NOT TCP") 300000000000 thru 399999999999

 +32       SET INNOTCP=$ORDER(^HLB(400000000000),-1)

 +33       IF INNOTCP<300000000000

               SET INNOTCP=0

 +34      IF '$TEST

               SET INNOTCP=INNOTCP#300000000000

 +35       SET ^HLC("FILE778","IN","NOT TCP")=INNOTCP

 +36       QUIT