BADEPROV ;IHS/SAIC/FJE /MSC/AMF - Dentrix HL7 interface ;31-Mar-2010 16:38;PLS
;;1.0;DENTAL/EDR INTERFACE;**1**;AUG 22, 2011
Q
DISPPROV ; EP for BADE EDR DISP PROV
; consolidates FINDPRV and UPLDPROV
;
N WHICH,IEN,NAME,CODE,PCLS,TP,TPX,IP,IPX,NPI,COUNT,TITLE
N X,%ZIS,IORVON,IORVOFF,VER,PKG,DASH
S DASH="---------------------------------------------------------------------------------"
W !!,"This option will display dentists in your RPMS system.",!,"You may include dentists who are inactive, or only active dentists.",!
S DIR(0)="S^A:All;O:Only Active",DIR("A")="Do you want to display (A)ll dentists or (O)nly active dentists?",DIR("B")="A"
S DIR("?")="Enter 'A' to include the dentists who have been terminated or inactivated. Otherwise enter 'O' for only the active dentists" D ^DIR K DIR
Q:Y=U S WHICH=Y
I $E($G(IOST),1,2)'="C-" W !,"Your terminal Type is not defined correctly for this report.",! S DIR(0)="EA",DIR("?")="",DIR("A")="Press ENTER to continue..." D ^DIR K DIR Q
S TITLE=$S(WHICH="O":"RPMS-Dentrix Active Provider Upload Display",1:"RPMS-Dentrix All Provider Display")
S VER="Version "_$G(VER,1.0),PKG=$G(PKG,TITLE)
S X="IORVON;IORVOFF"
D ENDR^%ZISS
U IO
W @IOF,IORVON,$$GET1^DIQ(4,DUZ(2),.01),?(IOM-$L(PKG)\2),PKG,?(IOM-$L(VER)),VER,!,IORVOFF
I WHICH="A" W !!,"Provider",?32,"Terminated Inactivated",?56,"NPI",?70,"IEN",!,$E(DASH,1,80)
I WHICH="O" W !!,"Provider",?32,"NPI",?46,"IEN",!,$E(DASH,1,55)
;
S IEN=0,NAME="",COUNT=0
F S NAME=$O(^VA(200,"B",NAME)) Q:NAME="" D
.S IEN=0 F S IEN=$O(^VA(200,"B",NAME,IEN)) Q:+IEN'>0 D
..Q:'$D(^VA(200,IEN,0))
..S PCLS=+$P($G(^VA(200,IEN,"PS")),U,5) ; Provider Class
..S CODE=+$P($G(^DIC(7,PCLS,9999999)),U) ; IHS Code
..Q:CODE'=52 ;Not a Dentist
..S NAME=$P($G(^VA(200,IEN,0)),U,1) ;Provider Name
..S TP=$P($G(^VA(200,IEN,0)),U,11) ; Provider has been terminated
..S TPX=$S(+TP:"Yes",1:"No")
..S IP=$P($G(^VA(200,IEN,"PS")),U,4) ; Provider is inactive
..S IPX=$S(+IP:"Yes",1:"No")
..S NPI=$P($G(^VA(200,IEN,"NPI")),U,1) ; Provider NPI
..I WHICH="O" Q:+TP!+IP!'+NPI
..S COUNT=COUNT+1
..I WHICH="A" W !,NAME,?32,TPX,?43,IPX,?56,NPI,?70,IEN
..I WHICH="O" W !,NAME,?32,NPI,?46,IEN
W !!,"A total of ",COUNT," providers.",!!
S DIR(0)="EA",DIR("?")="",DIR("A")="Press ENTER to continue..." D ^DIR K DIR
Q
;
PURGEMAN ;EP - Entry point for manual PURGE from menu
N PURDT,MSGIEN,PURNOW,QNM,DIR,HMDAYS,TYPE,COUNT,STR
W !!,"This option will purge all Dentrix messages which are older than a certain date."
;
S HMDAYS=$$GET^XPAR("ALL","BADE EDR DEFAULT PURGE DAYS")
S:HMDAYS="" HMDAYS=7
PM1 ;
S DIR(0)="NO^0:100:0",DIR("A")="For how many days would you like to keep messages",DIR("B")=HMDAYS
S DIR("?")="Enter a number indicating the number of days for message retention. All older messages will be purged." D ^DIR K DIR
Q:Y=U S HMDAYS=Y
PM2 ;
S DIR(0)="Y",DIR("A")="Do you want to continue with the purge",DIR("B")="No"
D ^DIR K DIR
G:Y=U PM1 Q:(X="N")!'Y
PM3 ;
S QNM="DENTRIX",COUNT=0
S PURNOW=$$NOW^XLFDT
S PURDT=PURNOW-HMDAYS
S MSGIEN=0 F S MSGIEN=$O(^HLB(MSGIEN)) Q:+MSGIEN=0 D
.S STR=$G(^HLB(MSGIEN,0))
.Q:$P(STR,U,16)>PURDT
.Q:'$$PM4(MSGIEN)
.S COUNT=COUNT+1
.D DELETE^HLOPURGE(MSGIEN)
W !!,COUNT," messages have been purged. ",!
S DIR(0)="EA",DIR("?")="",DIR("A")="Press ENTER to continue..." D ^DIR K DIR
Q
; Verifies that message is for DENTRIX
PM4(MSGIEN) ;EP-
N MSG,RES
S RES=$$STARTMSG^HLOPRS(.MSG,MSGIEN)
S RES=RES&($G(MSG("HDR","RECEIVING APPLICATION"))=QNM)
Q RES
;
AC ;DELETE "AC" XREF FOR IEN
;EXAMPLE: ^HLB("AC","Dental^198.45.6.101:5027^DNSDENTRIXDental 1",1)=""
S (BADE1,BADE2,BADE3)=""
S BADE1="AC"
F S BADE2=$O(^HLB(BADE1,BADE2)) Q:BADE2="" D
.S BADE3=0 F S BADE3=$O(^HLB(BADE1,BADE2,BADE3)) Q:+BADE3<1 D
..K:BADE3=BADEIEN ^HLB(BADE1,BADE2,BADE3)
Q
ADI ;DELETE "AD" XREF FOR "IN" IEN
;EXAMPLE: ^HLB("AD","IN",3)=""
S (BADE1,BADE2,BADE3)=""
S BADE1="AD",BADE2="IN"
S BADE3=0 F S BADE3=$O(^HLB(BADE1,BADE2,BADE3)) Q:+BADE3<1 D
.K:BADE3=BADEIEN ^HLB(BADE1,BADE2,BADE3)
Q
ADO ;DELETE "AD" XREF FOR "OUT" IEN
;EXAMPLE: ^HLB("AD","OUT",3090819.1143,3)=""
S (BADE1,BADE2,BADE3,BADE4)=""
S BADE1="AD",BADE2="OUT"
F S BADE3=$O(^HLB(BADE1,BADE2,BADE3)) Q:BADE3="" D
.S BADE4=0 F S BADE4=$O(^HLB(BADE1,BADE2,BADE3,BADE4)) Q:+BADE4<1 D
..K:BADE4=BADEIEN ^HLB(BADE1,BADE2,BADE3,BADE4)
Q
QUEUEI ;DELETE "QUEUE" XREF FOR IEN
;EXAMPLE: ^HLB("QUEUE","IN",3100218.220529,"RPMS-DEN","DFT","P03",1)=""
S (BADE1,BADE2,BADE3,BADE4,BADE5,BADE6,BADE7)=""
S BADE1="QUEUE"
F S BADE2=$O(^HLB(BADE1,BADE2)) Q:BADE2="" D
.S BADE3="" F S BADE3=$O(^HLB(BADE1,BADE2,BADE3)) Q:BADE3="" D
..S BADE4="" F S BADE4=$O(^HLB(BADE1,BADE2,BADE3,BADE4)) Q:BADE4="" D
...S BADE5="" F S BADE5=$O(^HLB(BADE1,BADE2,BADE3,BADE4,BADE5)) Q:BADE5="" D
....S BADE6="" F S BADE6=$O(^HLB(BADE1,BADE2,BADE3,BADE4,BADE5,BADE6)) Q:BADE6="" D
.....S BADE7="" F S BADE7=$O(^HLB(BADE1,BADE2,BADE3,BADE4,BADE5,BADE6,BADE7)) Q:BADE7="" D
......K:BADE7=BADEIEN ^HLB(BADE1,BADE2,BADE3,BADE4,BADE5,BADE6,BADE7)
Q
QUEUEO ;DELETE "QUEUE" XREF FOR IEN
;EXAMPLE: ^HLB("QUEUE","IN",3100218.220529,"RPMS-DEN","DFT","P03",1)=""
S (BADE1,BADE2,BADE3,BADE4,BADE5,BADE6,BADE7)=""
S BADE1="QUEUE",BADE2="OUT"
F S BADE3=$O(^HLB(BADE1,BADE2,BADE3)) Q:BADE3="" D
.S BADE4="" F S BADE4=$O(^HLB(BADE1,BADE2,BADE3,BADE4)) Q:BADE4="" D
..S BADE5="" F S BADE5=$O(^HLB(BADE1,BADE2,BADE3,BADE4,BADE5)) Q:BADE5="" D
...K:BADE5=BADEIEN ^HLB(BADE1,BADE2,BADE3,BADE4,BADE5)
Q
TOTCNT ;Displays Patient Count Info
;Loop through the patients and send data
N BADEDFN,BADECNTD,BADECNTA,BADEAPAT,BADEDPAT,BADEA41,BADEBPAT
S (BADEDFN,BADECNTD,BADECNTA,BADEAPAT,BADEDPAT,BADEA41,BADEBPAT)=0
F S BADEDFN=$O(^DPT(BADEDFN)) Q:+BADEDFN'>0 D
.S BADECNTD=BADECNTD+1
.I '$D(^AUPNPAT(BADEDFN,0)) S BADEAPAT=BADEAPAT+1 Q
.I '$D(^AUPNPAT(BADEDFN,41)) S BADEA41=BADEA41+1 Q
.S BADENAME=$P($G(^DPT(BADEDFN,0)),"^",1)
.Q:BADENAME=""
.I '$D(^DPT("B",BADENAME,BADEDFN)) S BADEBPAT=BADEBPAT+1 Q
S BADEDFN=0 F S BADEDFN=$O(^AUPNPAT(BADEDFN)) Q:+BADEDFN'>0 D
.S BADECNTA=BADECNTA+1
.I '$D(^DPT(BADEDFN,0)) S BADEDPAT=BADEDPAT+1 Q
; Display statistics
Q:$E($G(IOST),1,2)'="C-"
S VER="Version "_$G(VER,1.0),PKG=$G(PKG,"RPMS-Dentrix Patient Count Display")
S X="IORVON;IORVOFF"
D ENDR^%ZISS
U IO
W @IOF,IORVON,$$GET1^DIQ(4,DUZ(2),.01),?(IOM-$L(PKG)\2),PKG,?(IOM-$L(VER)),VER,!,IORVOFF
W !!,"Patient Counts"
W !,"----------------------------------------------------------------------"
W !,"VA PATIENT (DPT) COUNT: ",BADECNTD
W !,"PATIENT (AUPNPAT) COUNT: ",BADECNTA
W !,"AUPNPAT ENTRY MISSING DPT COUNT: ",BADEDPAT
W !,"DPT ENTRY MISSING AUPNPAT COUNT: ",BADEAPAT
W !,"AUPNPAT ENTRY MISSING A DIVISION/HRCN (A41) COUNT: ",BADEA41
W !,"DPT MISSING ""B"" XREF COUNT: ",BADEBPAT
W !!
S DIR(0)="EA",DIR("?")="",DIR("A")="Press ENTER to continue..." D ^DIR K DIR
Q
BADEPROV ;IHS/SAIC/FJE /MSC/AMF - Dentrix HL7 interface ;31-Mar-2010 16:38;PLS
+1 ;;1.0;DENTAL/EDR INTERFACE;**1**;AUG 22, 2011
+2 QUIT
DISPPROV ; EP for BADE EDR DISP PROV
+1 ; consolidates FINDPRV and UPLDPROV
+2 ;
+3 NEW WHICH,IEN,NAME,CODE,PCLS,TP,TPX,IP,IPX,NPI,COUNT,TITLE
+4 NEW X,%ZIS,IORVON,IORVOFF,VER,PKG,DASH
+5 SET DASH="---------------------------------------------------------------------------------"
+6 WRITE !!,"This option will display dentists in your RPMS system.",!,"You may include dentists who are inactive, or only active dentists.",!
+7 SET DIR(0)="S^A:All;O:Only Active"
SET DIR("A")="Do you want to display (A)ll dentists or (O)nly active dentists?"
SET DIR("B")="A"
+8 SET DIR("?")="Enter 'A' to include the dentists who have been terminated or inactivated. Otherwise enter 'O' for only the active dentists"
DO ^DIR
KILL DIR
+9 IF Y=U
QUIT
SET WHICH=Y
+10 IF $EXTRACT($GET(IOST),1,2)'="C-"
WRITE !,"Your terminal Type is not defined correctly for this report.",!
SET DIR(0)="EA"
SET DIR("?")=""
SET DIR("A")="Press ENTER to continue..."
DO ^DIR
KILL DIR
QUIT
+11 SET TITLE=$SELECT(WHICH="O":"RPMS-Dentrix Active Provider Upload Display",1:"RPMS-Dentrix All Provider Display")
+12 SET VER="Version "_$GET(VER,1.0)
SET PKG=$GET(PKG,TITLE)
+13 SET X="IORVON;IORVOFF"
+14 DO ENDR^%ZISS
+15 USE IO
+16 WRITE @IOF,IORVON,$$GET1^DIQ(4,DUZ(2),.01),?(IOM-$LENGTH(PKG)\2),PKG,?(IOM-$LENGTH(VER)),VER,!,IORVOFF
+17 IF WHICH="A"
WRITE !!,"Provider",?32,"Terminated Inactivated",?56,"NPI",?70,"IEN",!,$EXTRACT(DASH,1,80)
+18 IF WHICH="O"
WRITE !!,"Provider",?32,"NPI",?46,"IEN",!,$EXTRACT(DASH,1,55)
+19 ;
+20 SET IEN=0
SET NAME=""
SET COUNT=0
+21 FOR
SET NAME=$ORDER(^VA(200,"B",NAME))
IF NAME=""
QUIT
Begin DoDot:1
+22 SET IEN=0
FOR
SET IEN=$ORDER(^VA(200,"B",NAME,IEN))
IF +IEN'>0
QUIT
Begin DoDot:2
+23 IF '$DATA(^VA(200,IEN,0))
QUIT
+24 ; Provider Class
SET PCLS=+$PIECE($GET(^VA(200,IEN,"PS")),U,5)
+25 ; IHS Code
SET CODE=+$PIECE($GET(^DIC(7,PCLS,9999999)),U)
+26 ;Not a Dentist
IF CODE'=52
QUIT
+27 ;Provider Name
SET NAME=$PIECE($GET(^VA(200,IEN,0)),U,1)
+28 ; Provider has been terminated
SET TP=$PIECE($GET(^VA(200,IEN,0)),U,11)
+29 SET TPX=$SELECT(+TP:"Yes",1:"No")
+30 ; Provider is inactive
SET IP=$PIECE($GET(^VA(200,IEN,"PS")),U,4)
+31 SET IPX=$SELECT(+IP:"Yes",1:"No")
+32 ; Provider NPI
SET NPI=$PIECE($GET(^VA(200,IEN,"NPI")),U,1)
+33 IF WHICH="O"
IF +TP!+IP!'+NPI
QUIT
+34 SET COUNT=COUNT+1
+35 IF WHICH="A"
WRITE !,NAME,?32,TPX,?43,IPX,?56,NPI,?70,IEN
+36 IF WHICH="O"
WRITE !,NAME,?32,NPI,?46,IEN
End DoDot:2
End DoDot:1
+37 WRITE !!,"A total of ",COUNT," providers.",!!
+38 SET DIR(0)="EA"
SET DIR("?")=""
SET DIR("A")="Press ENTER to continue..."
DO ^DIR
KILL DIR
+39 QUIT
+40 ;
PURGEMAN ;EP - Entry point for manual PURGE from menu
+1 NEW PURDT,MSGIEN,PURNOW,QNM,DIR,HMDAYS,TYPE,COUNT,STR
+2 WRITE !!,"This option will purge all Dentrix messages which are older than a certain date."
+3 ;
+4 SET HMDAYS=$$GET^XPAR("ALL","BADE EDR DEFAULT PURGE DAYS")
+5 IF HMDAYS=""
SET HMDAYS=7
PM1 ;
+1 SET DIR(0)="NO^0:100:0"
SET DIR("A")="For how many days would you like to keep messages"
SET DIR("B")=HMDAYS
+2 SET DIR("?")="Enter a number indicating the number of days for message retention. All older messages will be purged."
DO ^DIR
KILL DIR
+3 IF Y=U
QUIT
SET HMDAYS=Y
PM2 ;
+1 SET DIR(0)="Y"
SET DIR("A")="Do you want to continue with the purge"
SET DIR("B")="No"
+2 DO ^DIR
KILL DIR
+3 IF Y=U
GOTO PM1
IF (X="N")!'Y
QUIT
PM3 ;
+1 SET QNM="DENTRIX"
SET COUNT=0
+2 SET PURNOW=$$NOW^XLFDT
+3 SET PURDT=PURNOW-HMDAYS
+4 SET MSGIEN=0
FOR
SET MSGIEN=$ORDER(^HLB(MSGIEN))
IF +MSGIEN=0
QUIT
Begin DoDot:1
+5 SET STR=$GET(^HLB(MSGIEN,0))
+6 IF $PIECE(STR,U,16)>PURDT
QUIT
+7 IF '$$PM4(MSGIEN)
QUIT
+8 SET COUNT=COUNT+1
+9 DO DELETE^HLOPURGE(MSGIEN)
End DoDot:1
+10 WRITE !!,COUNT," messages have been purged. ",!
+11 SET DIR(0)="EA"
SET DIR("?")=""
SET DIR("A")="Press ENTER to continue..."
DO ^DIR
KILL DIR
+12 QUIT
+13 ; Verifies that message is for DENTRIX
PM4(MSGIEN) ;EP-
+1 NEW MSG,RES
+2 SET RES=$$STARTMSG^HLOPRS(.MSG,MSGIEN)
+3 SET RES=RES&($GET(MSG("HDR","RECEIVING APPLICATION"))=QNM)
+4 QUIT RES
+5 ;
AC ;DELETE "AC" XREF FOR IEN
+1 ;EXAMPLE: ^HLB("AC","Dental^198.45.6.101:5027^DNSDENTRIXDental 1",1)=""
+2 SET (BADE1,BADE2,BADE3)=""
+3 SET BADE1="AC"
+4 FOR
SET BADE2=$ORDER(^HLB(BADE1,BADE2))
IF BADE2=""
QUIT
Begin DoDot:1
+5 SET BADE3=0
FOR
SET BADE3=$ORDER(^HLB(BADE1,BADE2,BADE3))
IF +BADE3<1
QUIT
Begin DoDot:2
+6 IF BADE3=BADEIEN
KILL ^HLB(BADE1,BADE2,BADE3)
End DoDot:2
End DoDot:1
+7 QUIT
ADI ;DELETE "AD" XREF FOR "IN" IEN
+1 ;EXAMPLE: ^HLB("AD","IN",3)=""
+2 SET (BADE1,BADE2,BADE3)=""
+3 SET BADE1="AD"
SET BADE2="IN"
+4 SET BADE3=0
FOR
SET BADE3=$ORDER(^HLB(BADE1,BADE2,BADE3))
IF +BADE3<1
QUIT
Begin DoDot:1
+5 IF BADE3=BADEIEN
KILL ^HLB(BADE1,BADE2,BADE3)
End DoDot:1
+6 QUIT
ADO ;DELETE "AD" XREF FOR "OUT" IEN
+1 ;EXAMPLE: ^HLB("AD","OUT",3090819.1143,3)=""
+2 SET (BADE1,BADE2,BADE3,BADE4)=""
+3 SET BADE1="AD"
SET BADE2="OUT"
+4 FOR
SET BADE3=$ORDER(^HLB(BADE1,BADE2,BADE3))
IF BADE3=""
QUIT
Begin DoDot:1
+5 SET BADE4=0
FOR
SET BADE4=$ORDER(^HLB(BADE1,BADE2,BADE3,BADE4))
IF +BADE4<1
QUIT
Begin DoDot:2
+6 IF BADE4=BADEIEN
KILL ^HLB(BADE1,BADE2,BADE3,BADE4)
End DoDot:2
End DoDot:1
+7 QUIT
QUEUEI ;DELETE "QUEUE" XREF FOR IEN
+1 ;EXAMPLE: ^HLB("QUEUE","IN",3100218.220529,"RPMS-DEN","DFT","P03",1)=""
+2 SET (BADE1,BADE2,BADE3,BADE4,BADE5,BADE6,BADE7)=""
+3 SET BADE1="QUEUE"
+4 FOR
SET BADE2=$ORDER(^HLB(BADE1,BADE2))
IF BADE2=""
QUIT
Begin DoDot:1
+5 SET BADE3=""
FOR
SET BADE3=$ORDER(^HLB(BADE1,BADE2,BADE3))
IF BADE3=""
QUIT
Begin DoDot:2
+6 SET BADE4=""
FOR
SET BADE4=$ORDER(^HLB(BADE1,BADE2,BADE3,BADE4))
IF BADE4=""
QUIT
Begin DoDot:3
+7 SET BADE5=""
FOR
SET BADE5=$ORDER(^HLB(BADE1,BADE2,BADE3,BADE4,BADE5))
IF BADE5=""
QUIT
Begin DoDot:4
+8 SET BADE6=""
FOR
SET BADE6=$ORDER(^HLB(BADE1,BADE2,BADE3,BADE4,BADE5,BADE6))
IF BADE6=""
QUIT
Begin DoDot:5
+9 SET BADE7=""
FOR
SET BADE7=$ORDER(^HLB(BADE1,BADE2,BADE3,BADE4,BADE5,BADE6,BADE7))
IF BADE7=""
QUIT
Begin DoDot:6
+10 IF BADE7=BADEIEN
KILL ^HLB(BADE1,BADE2,BADE3,BADE4,BADE5,BADE6,BADE7)
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+11 QUIT
QUEUEO ;DELETE "QUEUE" XREF FOR IEN
+1 ;EXAMPLE: ^HLB("QUEUE","IN",3100218.220529,"RPMS-DEN","DFT","P03",1)=""
+2 SET (BADE1,BADE2,BADE3,BADE4,BADE5,BADE6,BADE7)=""
+3 SET BADE1="QUEUE"
SET BADE2="OUT"
+4 FOR
SET BADE3=$ORDER(^HLB(BADE1,BADE2,BADE3))
IF BADE3=""
QUIT
Begin DoDot:1
+5 SET BADE4=""
FOR
SET BADE4=$ORDER(^HLB(BADE1,BADE2,BADE3,BADE4))
IF BADE4=""
QUIT
Begin DoDot:2
+6 SET BADE5=""
FOR
SET BADE5=$ORDER(^HLB(BADE1,BADE2,BADE3,BADE4,BADE5))
IF BADE5=""
QUIT
Begin DoDot:3
+7 IF BADE5=BADEIEN
KILL ^HLB(BADE1,BADE2,BADE3,BADE4,BADE5)
End DoDot:3
End DoDot:2
End DoDot:1
+8 QUIT
TOTCNT ;Displays Patient Count Info
+1 ;Loop through the patients and send data
+2 NEW BADEDFN,BADECNTD,BADECNTA,BADEAPAT,BADEDPAT,BADEA41,BADEBPAT
+3 SET (BADEDFN,BADECNTD,BADECNTA,BADEAPAT,BADEDPAT,BADEA41,BADEBPAT)=0
+4 FOR
SET BADEDFN=$ORDER(^DPT(BADEDFN))
IF +BADEDFN'>0
QUIT
Begin DoDot:1
+5 SET BADECNTD=BADECNTD+1
+6 IF '$DATA(^AUPNPAT(BADEDFN,0))
SET BADEAPAT=BADEAPAT+1
QUIT
+7 IF '$DATA(^AUPNPAT(BADEDFN,41))
SET BADEA41=BADEA41+1
QUIT
+8 SET BADENAME=$PIECE($GET(^DPT(BADEDFN,0)),"^",1)
+9 IF BADENAME=""
QUIT
+10 IF '$DATA(^DPT("B",BADENAME,BADEDFN))
SET BADEBPAT=BADEBPAT+1
QUIT
End DoDot:1
+11 SET BADEDFN=0
FOR
SET BADEDFN=$ORDER(^AUPNPAT(BADEDFN))
IF +BADEDFN'>0
QUIT
Begin DoDot:1
+12 SET BADECNTA=BADECNTA+1
+13 IF '$DATA(^DPT(BADEDFN,0))
SET BADEDPAT=BADEDPAT+1
QUIT
End DoDot:1
+14 ; Display statistics
+15 IF $EXTRACT($GET(IOST),1,2)'="C-"
QUIT
+16 SET VER="Version "_$GET(VER,1.0)
SET PKG=$GET(PKG,"RPMS-Dentrix Patient Count Display")
+17 SET X="IORVON;IORVOFF"
+18 DO ENDR^%ZISS
+19 USE IO
+20 WRITE @IOF,IORVON,$$GET1^DIQ(4,DUZ(2),.01),?(IOM-$LENGTH(PKG)\2),PKG,?(IOM-$LENGTH(VER)),VER,!,IORVOFF
+21 WRITE !!,"Patient Counts"
+22 WRITE !,"----------------------------------------------------------------------"
+23 WRITE !,"VA PATIENT (DPT) COUNT: ",BADECNTD
+24 WRITE !,"PATIENT (AUPNPAT) COUNT: ",BADECNTA
+25 WRITE !,"AUPNPAT ENTRY MISSING DPT COUNT: ",BADEDPAT
+26 WRITE !,"DPT ENTRY MISSING AUPNPAT COUNT: ",BADEAPAT
+27 WRITE !,"AUPNPAT ENTRY MISSING A DIVISION/HRCN (A41) COUNT: ",BADEA41
+28 WRITE !,"DPT MISSING ""B"" XREF COUNT: ",BADEBPAT
+29 WRITE !!
+30 SET DIR(0)="EA"
SET DIR("?")=""
SET DIR("A")="Press ENTER to continue..."
DO ^DIR
KILL DIR
+31 QUIT
