BADEVNT1 ;IHS/MSC/MGH - Dentrix HL7 interface (cont) ;08-Jul-2009 16:38;PLS
;;1.0;DENTAL/EDR INTERFACE;**1**;AUG 22, 2011
;; Modified - IHS/MSC/AMF - 11/23/10 - Updated Out of Order, alerts, removed H 2
Q
TPROV ;EP Taskman call to start provider load
N STOP,ZTDTH,ZTIO,ZTDESC,ZTRTN,ZTSAVE,ZTPRI,ZTSK
;Make sure its not already running
S STOP=$$GET^XPAR("ALL","BADE EDR PAUSE PROV UPLOAD",1,"E")
;Its already running and shouldn't be restarted
I STOP="NO" D H 3 Q
.W !,"Process is already running",!
I $$GET^XPAR("ALL","BADE LAST NEW PERSON") D H 3 Q
.W !,"Upload process has already begun. Please use Restart option.",!
S ZTIO=""
S ZTDESC="Load Provider Data to EDR"
S ZTRTN="LOADPRV^BADEVNT1"
S ZTPRI=1
S ZTSAVE("DUZ")=""
D ^%ZTLOAD
I $G(ZTSK) D
.D EN^XPAR("SYS","BADE EDR PRV TSK",1,ZTSK)
.W !,"Task number "_ZTSK H 2
Q
LOADPRV ;EP Load the dental providers
N IEN,CNT,DATA,TOTAL,STOP,MFNTYP
;Set the stop parameter to NO
D EN^XPAR("SYS","BADE EDR PAUSE PROV UPLOAD",1,"NO")
;Make sure the last used IEN is set to null
S IEN=$$GET^XPAR("ALL","BADE EDR LAST NEW PERSON")
;Loop through providers
S IEN=$S(IEN>0:IEN,1:0),CNT=0,STOP="NO",TOTAL=0
S MFNTYP="MAD"
F S IEN=$O(^VA(200,IEN)) Q:+IEN'>0!(STOP="YES") D
.Q:$$INACTPRV(IEN) ; Do not send Inactive/Terminated providers
.D MFN^BADEVNT1(IEN)
.;Set the IEN into the PROVIDER parameter
.D EN^XPAR("SYS","BADE EDR LAST NEW PERSON",1,"`"_IEN)
.;Set the total count
.S TOTAL=TOTAL+1
.D EN^XPAR("SYS","BADE EDR TOTAL PROVIDERS",1,TOTAL)
.;Check to see if we should stop
.S STOP=$$GET^XPAR("ALL","BADE EDR PAUSE PROV UPLOAD",1,"E")
.Q:STOP="YES"
;Finish up by resetting the provider parameter and the stop parameter to YES
I STOP="NO" D
.D EN^XPAR("SYS","BADE EDR PAUSE PROV UPLOAD",1,"YES")
.D EN^XPAR("SYS","BADE EDR PRV TSK",1,"Upload Complete")
.N DA,DIE,DR
.D COMPLETE
Q
TRELPRV ;EP Taskman call to restart provider load
N STOP,ZTDTH,ZTIO,ZTPRI,ZTDESC,ZTRTN,ZTSAVE,ZTSK
;First, check to see if its already running
S STOP=$$GET^XPAR("ALL","BADE EDR PAUSE PATIENT LOAD",1,"E")
;Its already running and shouldn't be restarted
I STOP="NO" W !,"Process is already running",!!! H 3 Q
;S ZTDTH=$H
S ZTIO=""
S ZTPRI=1
S ZTDESC="Load Provider Data to EDR"
S ZTRTN="RESTPRV^BADEVNT1"
S ZTSAVE("DUZ")=""
D ^%ZTLOAD
I $G(ZTSK) D
.D EN^XPAR("SYS","BADE EDR PRV TSK",,ZTSK)
.W !,"Task number "_ZTSK H 2
Q
RESTPRV ;EP Restart the provider load
N IEN,TOTAL,DATA,STOP,MFNTYP
;Get the last used IEN from the parameter
S IEN=$$GET^XPAR("ALL","BADE LAST NEW PERSON")
;Get the total count
S TOTAL=$$GET^XPAR("ALL","BADE EDR TOTAL PROVIDERS")
;Set the stop parameter to NO
;S STOP=$$GET^XPAR("ALL","BADE EDR PAUSE PROV UPLOAD",1,"E")
;Q:STOP="NO"
D EN^XPAR("SYS","BADE EDR PAUSE PROV UPLOAD",1,"NO")
;Loop through providers
S STOP="NO"
S IEN=$S(IEN>0:IEN,1:0)
F S IEN=$O(^VA(200,IEN)) Q:+IEN'>0!(STOP="YES") D
.Q:$$INACTPRV(IEN) ; Do not send Inactive/Terminated providers
.S MFNTYP="MAD"
.D MFN^BADEVNT1(IEN)
.;Set the IEN into the PROVIDER parameter
.D EN^XPAR("SYS","BADE EDR LAST NEW PERSON",1,"`"_IEN)
.;Add to the total count
.S TOTAL=TOTAL+1
.D EN^XPAR("SYS","BADE EDR TOTAL PROVIDERS",1,TOTAL)
.;Check to see if we should stop
.S STOP=$$GET^XPAR("ALL","BADE EDR PAUSE PROV UPLOAD",1,"E")
.Q:STOP="YES"
.;Finish up by resetting the provider parameter and the stop parameter to YES
I STOP="NO" D
.D EN^XPAR("SYS","BADE EDR PAUSE PROV UPLOAD",1,"YES")
.D EN^XPAR("SYS","BADE EDR PRV TSK",1,"")
.D COMPLETE
Q
; ----- IHS/MSC/AMF 10/9/10 modified to mark all provider upload options complete
COMPLETE ;Mark options out of order
N MSG,MENU,I
S MENU(1)="BADE EDR UPLOAD ALL PROVIDERS"
S MENU(2)="BADE EDR RESTART PROV UPLOAD"
S MENU(3)="BADE EDR PAUSE PROV UPLOAD"
F I=1:1:3 D
.N DA,DIE,DR
.S MSG="Upload completed"
.S DA=$O(^DIC(19,"B",MENU(I),""))
.I DA'="" D
..S DIE="^DIC(19,",DR="2///^S X=MSG"
..D ^DIE
; ----- end IHS/MSC/AMF 10/9/10
; Enable event protocol
D EDPROT^BADEUTIL("BADE PROVIDER UPDATE MFN-M02")
Q
STATUS ;EP Display the status
N THROTTLE,CNT,DATA,TOTAL,TASK,PDATA,PTOTAL,PSTOP,PTASK,DFN,USR
;Get the patient processed and total number processed
S DFN=$$GET^XPAR("ALL","BADE EDR LAST DFN")
S DATA=$$GET1^DIQ(2,DFN,.01)_$S(DFN>0:" ("_DFN_")",1:"")
S TOTAL=$$GET^XPAR("ALL","BADE EDR TOTAL PROCESSED")
;Display throttle and processing status
S THROTTLE=$$GET^XPAR("ALL","BADE EDR PT THROTTLE")
S CNT=$$GET^XPAR("ALL","BADE EDR THROTTLE CT")
S STOP=$$GET^XPAR("ALL","BADE EDR PAUSE PATIENT LOAD",1,"E")
S TASK=$$GET^XPAR("ALL","BADE EDR LOAD TSK")
;Get the providers processed and total number processed
S USR=$$GET^XPAR("ALL","BADE EDR LAST NEW PERSON")
S PDATA=$$GET1^DIQ(200,USR,.01)_$S(USR>0:" ("_USR_")",1:"")
S PTOTAL=$$GET^XPAR("ALL","BADE EDR TOTAL PROVIDERS")
;Display the processing status
S PSTOP=$$GET^XPAR("ALL","BADE EDR PAUSE PROV UPLOAD",1,"E")
S PTASK=$$GET^XPAR("ALL","BADE EDR PRV TSK")
; ----- IHS/SAIC/FJE 3/9/11 added to complete display for merge
;Get MERGED PATIENTS processed and total number processed
S MRGDFN=$$GET^XPAR("ALL","BADE EDR MRG DFN")
S MRGDATA=$$GET1^DIQ(2,MRGDFN,.01)_$S(MRGDFN>0:" ("_MRGDFN_")",1:"")
S MRGTOTAL=$$GET^XPAR("ALL","BADE EDR MRG TOTAL")
;Display the processing status
S MRGSTOP=$$GET^XPAR("ALL","BADE EDR PAUSE MRG LOAD",1,"E")
S MRGTASK=$$GET^XPAR("ALL","BADE EDR MRG LOAD TSK")
; ----- end IHS/SAIC/FJE 3/9/11
; Display statistics
Q:$E($G(IOST),1,2)'="C-"
N X,%ZIS,IORVON,IORVOFF,MNU
S VER="Version "_$G(VER,1.0),PKG=$G(PKG,"RPMS-Dentrix Upload")
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 Upload Data"
W !,?5,"Last Patient Processed: "_DATA
W !,?5,"Total Pts processed: "_TOTAL
W !,?5,"Throttle seconds: "_THROTTLE,?40,"Throttle Pt. Ct.: "_CNT
W !,?5,"Currently stopped: "_STOP,?40,"Task: "_TASK
W !,"Provider Upload Data"
W !,?5,"Last Provider Processed: "_PDATA
W !,?5,"Total Prov processed: "_PTOTAL
W !,?5,"Currently stopped: "_PSTOP,?40,"Task: "_PTASK
W !,"Merge Upload Data"
W !,?5,"Last Merged Patient Processed: "_MRGDATA
W !,?5,"Total Merged Patients processed: "_MRGTOTAL
W !,?5,"Currently stopped: "_MRGSTOP,?40,"Task: "_MRGTASK
W !!
S DIR(0)="EA",DIR("?")="",DIR("A")="Press ENTER to continue..." D ^DIR K DIR
Q
SENDMFN ;Send one MFN message
N ERR,INDA,DIC,D,MFNTYP
S DIC=200,DIC(0)="AEQ",DIC("A")="Select DENTIST: "
S D="AK.PROVIDER",DIC("S")="I $$ISDENTST^BADEVNT1(+Y)"
D IX^DIC I +Y>0 D
.S INDA=+Y
.I $$NPI^XUSNPI("Individual_ID",INDA)<0 D Q
..W !,"Selected provider lacks NPI number"
.D MFN^BADEVNT1(INDA)
.W !,$S($D(ERR):"Unable to send HL7 message...",$G(MSG):MSG,1:"Message was sent...")
; IHS/MSC/AMF 10/9/10 modified - removed H, replaced with Enter to continue.
S DIR(0)="EA",DIR("?")="",DIR("A")="Press ENTER to continue..." D ^DIR K DIR
Q
MFN(INDA) ;EP Create and send one MFN message
;Make sure its a dentist
N PC,DENT
Q:'$D(^VA(200,INDA,0))
Q:$P($G(^VA(200,INDA,0)),U,1)=""
S PC=$P($G(^VA(200,INDA,"PS")),U,5)
S DENT="" S DENT=$O(^DIC(7,"D",52,DENT))
I $D(MFNTYP)=0 S MFNTYP=$$FINDTYP^BADEHL2(INDA)
I PC=DENT D NEWMSG^BADEHL2(INDA,MFNTYP) Q
E S MSG="Not a dentist, message not sent..."
Q
MSA ;EP
N MSA,HLST
D SET(.ARY,"MSA",0)
D SET(.ARY,"AA",1)
D SET(.ARY,"TODO-MSGID",2)
D SET(.ARY,"Transaction Successful",3)
D SET(.ARY,"todo-010",4)
S MSA=$$ADDSEG^HLOAPI(.HLST,.ARY)
Q
SET(ARY,V,F,C,S,R) ;EP
D SET^HLOAPI(.ARY,.V,.F,.C,.S,.R)
Q
; Edit a parameter from a menu option
EDITPAR(PARAM) ;EP
S PARAM=$G(PARAM,$P(XQY0,U))
D TITLE(),EDITPAR^XPAREDIT(PARAM):$$CHECK(8989.51,PARAM,"Parameter")
Q
; Display required header for menus
TITLE(PKG,VER) ;EP
Q:$E($G(IOST),1,2)'="C-"
N X,%ZIS,IORVON,IORVOFF,MNU
S MNU=$P(XQY0,U,2),VER="Version "_$G(VER,1.0),PKG=$G(PKG,"RPMS-Dentrix Upload")
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,?(IOM-$L(MNU)\2-$X),MNU
Q
CHECK(FIL,VAL,ENT) ;
Q:$$FIND1^DIC(FIL,"","X",VAL) 1
W !,ENT," ",VAL," was not found.",!
D PAUSE
Q 0
; Pause for user response
PAUSE ;EP
N X
S DIR(0)="EA",DIR("?")="",DIR("A")="Press ENTER to continue..." D ^DIR K DIR
Q
; Returns true if user is a dentist (52)
ISDENTST(USR) ;EP
N PCLS,CODE
S PCLS=+$P($G(^VA(200,USR,"PS")),U,5) ; Provider Class
S CODE=+$P($G(^DIC(7,PCLS,9999999)),U) ; IHS Code
Q CODE=52
; Returns Inactive status of provider
; Input: USR = IEN to File 200
INACTPRV(USR) ;EP
Q:'$G(USR) 1
Q:$P($G(^VA(200,USR,0)),U,11) 1 ; Provider has been terminated
Q:$P($G(^VA(200,USR,"PS")),U,4) 1 ; Provider is inactive
Q 0 ; Provider is active
BADEVNT1 ;IHS/MSC/MGH - Dentrix HL7 interface (cont) ;08-Jul-2009 16:38;PLS
+1 ;;1.0;DENTAL/EDR INTERFACE;**1**;AUG 22, 2011
+2 ;; Modified - IHS/MSC/AMF - 11/23/10 - Updated Out of Order, alerts, removed H 2
+3 QUIT
TPROV ;EP Taskman call to start provider load
+1 NEW STOP,ZTDTH,ZTIO,ZTDESC,ZTRTN,ZTSAVE,ZTPRI,ZTSK
+2 ;Make sure its not already running
+3 SET STOP=$$GET^XPAR("ALL","BADE EDR PAUSE PROV UPLOAD",1,"E")
+4 ;Its already running and shouldn't be restarted
+5 IF STOP="NO"
Begin DoDot:1
+6 WRITE !,"Process is already running",!
End DoDot:1
HANG 3
QUIT
+7 IF $$GET^XPAR("ALL","BADE LAST NEW PERSON")
Begin DoDot:1
+8 WRITE !,"Upload process has already begun. Please use Restart option.",!
End DoDot:1
HANG 3
QUIT
+9 SET ZTIO=""
+10 SET ZTDESC="Load Provider Data to EDR"
+11 SET ZTRTN="LOADPRV^BADEVNT1"
+12 SET ZTPRI=1
+13 SET ZTSAVE("DUZ")=""
+14 DO ^%ZTLOAD
+15 IF $GET(ZTSK)
Begin DoDot:1
+16 DO EN^XPAR("SYS","BADE EDR PRV TSK",1,ZTSK)
+17 WRITE !,"Task number "_ZTSK
HANG 2
End DoDot:1
+18 QUIT
LOADPRV ;EP Load the dental providers
+1 NEW IEN,CNT,DATA,TOTAL,STOP,MFNTYP
+2 ;Set the stop parameter to NO
+3 DO EN^XPAR("SYS","BADE EDR PAUSE PROV UPLOAD",1,"NO")
+4 ;Make sure the last used IEN is set to null
+5 SET IEN=$$GET^XPAR("ALL","BADE EDR LAST NEW PERSON")
+6 ;Loop through providers
+7 SET IEN=$SELECT(IEN>0:IEN,1:0)
SET CNT=0
SET STOP="NO"
SET TOTAL=0
+8 SET MFNTYP="MAD"
+9 FOR
SET IEN=$ORDER(^VA(200,IEN))
IF +IEN'>0!(STOP="YES")
QUIT
Begin DoDot:1
+10 ; Do not send Inactive/Terminated providers
IF $$INACTPRV(IEN)
QUIT
+11 DO MFN^BADEVNT1(IEN)
+12 ;Set the IEN into the PROVIDER parameter
+13 DO EN^XPAR("SYS","BADE EDR LAST NEW PERSON",1,"`"_IEN)
+14 ;Set the total count
+15 SET TOTAL=TOTAL+1
+16 DO EN^XPAR("SYS","BADE EDR TOTAL PROVIDERS",1,TOTAL)
+17 ;Check to see if we should stop
+18 SET STOP=$$GET^XPAR("ALL","BADE EDR PAUSE PROV UPLOAD",1,"E")
+19 IF STOP="YES"
QUIT
End DoDot:1
+20 ;Finish up by resetting the provider parameter and the stop parameter to YES
+21 IF STOP="NO"
Begin DoDot:1
+22 DO EN^XPAR("SYS","BADE EDR PAUSE PROV UPLOAD",1,"YES")
+23 DO EN^XPAR("SYS","BADE EDR PRV TSK",1,"Upload Complete")
+24 NEW DA,DIE,DR
+25 DO COMPLETE
End DoDot:1
+26 QUIT
TRELPRV ;EP Taskman call to restart provider load
+1 NEW STOP,ZTDTH,ZTIO,ZTPRI,ZTDESC,ZTRTN,ZTSAVE,ZTSK
+2 ;First, check to see if its already running
+3 SET STOP=$$GET^XPAR("ALL","BADE EDR PAUSE PATIENT LOAD",1,"E")
+4 ;Its already running and shouldn't be restarted
+5 IF STOP="NO"
WRITE !,"Process is already running",!!!
HANG 3
QUIT
+6 ;S ZTDTH=$H
+7 SET ZTIO=""
+8 SET ZTPRI=1
+9 SET ZTDESC="Load Provider Data to EDR"
+10 SET ZTRTN="RESTPRV^BADEVNT1"
+11 SET ZTSAVE("DUZ")=""
+12 DO ^%ZTLOAD
+13 IF $GET(ZTSK)
Begin DoDot:1
+14 DO EN^XPAR("SYS","BADE EDR PRV TSK",,ZTSK)
+15 WRITE !,"Task number "_ZTSK
HANG 2
End DoDot:1
+16 QUIT
RESTPRV ;EP Restart the provider load
+1 NEW IEN,TOTAL,DATA,STOP,MFNTYP
+2 ;Get the last used IEN from the parameter
+3 SET IEN=$$GET^XPAR("ALL","BADE LAST NEW PERSON")
+4 ;Get the total count
+5 SET TOTAL=$$GET^XPAR("ALL","BADE EDR TOTAL PROVIDERS")
+6 ;Set the stop parameter to NO
+7 ;S STOP=$$GET^XPAR("ALL","BADE EDR PAUSE PROV UPLOAD",1,"E")
+8 ;Q:STOP="NO"
+9 DO EN^XPAR("SYS","BADE EDR PAUSE PROV UPLOAD",1,"NO")
+10 ;Loop through providers
+11 SET STOP="NO"
+12 SET IEN=$SELECT(IEN>0:IEN,1:0)
+13 FOR
SET IEN=$ORDER(^VA(200,IEN))
IF +IEN'>0!(STOP="YES")
QUIT
Begin DoDot:1
+14 ; Do not send Inactive/Terminated providers
IF $$INACTPRV(IEN)
QUIT
+15 SET MFNTYP="MAD"
+16 DO MFN^BADEVNT1(IEN)
+17 ;Set the IEN into the PROVIDER parameter
+18 DO EN^XPAR("SYS","BADE EDR LAST NEW PERSON",1,"`"_IEN)
+19 ;Add to the total count
+20 SET TOTAL=TOTAL+1
+21 DO EN^XPAR("SYS","BADE EDR TOTAL PROVIDERS",1,TOTAL)
+22 ;Check to see if we should stop
+23 SET STOP=$$GET^XPAR("ALL","BADE EDR PAUSE PROV UPLOAD",1,"E")
+24 IF STOP="YES"
QUIT
+25 ;Finish up by resetting the provider parameter and the stop parameter to YES
End DoDot:1
+26 IF STOP="NO"
Begin DoDot:1
+27 DO EN^XPAR("SYS","BADE EDR PAUSE PROV UPLOAD",1,"YES")
+28 DO EN^XPAR("SYS","BADE EDR PRV TSK",1,"")
+29 DO COMPLETE
End DoDot:1
+30 QUIT
+31 ; ----- IHS/MSC/AMF 10/9/10 modified to mark all provider upload options complete
COMPLETE ;Mark options out of order
+1 NEW MSG,MENU,I
+2 SET MENU(1)="BADE EDR UPLOAD ALL PROVIDERS"
+3 SET MENU(2)="BADE EDR RESTART PROV UPLOAD"
+4 SET MENU(3)="BADE EDR PAUSE PROV UPLOAD"
+5 FOR I=1:1:3
Begin DoDot:1
+6 NEW DA,DIE,DR
+7 SET MSG="Upload completed"
+8 SET DA=$ORDER(^DIC(19,"B",MENU(I),""))
+9 IF DA'=""
Begin DoDot:2
+10 SET DIE="^DIC(19,"
SET DR="2///^S X=MSG"
+11 DO ^DIE
End DoDot:2
End DoDot:1
+12 ; ----- end IHS/MSC/AMF 10/9/10
+13 ; Enable event protocol
+14 DO EDPROT^BADEUTIL("BADE PROVIDER UPDATE MFN-M02")
+15 QUIT
STATUS ;EP Display the status
+1 NEW THROTTLE,CNT,DATA,TOTAL,TASK,PDATA,PTOTAL,PSTOP,PTASK,DFN,USR
+2 ;Get the patient processed and total number processed
+3 SET DFN=$$GET^XPAR("ALL","BADE EDR LAST DFN")
+4 SET DATA=$$GET1^DIQ(2,DFN,.01)_$SELECT(DFN>0:" ("_DFN_")",1:"")
+5 SET TOTAL=$$GET^XPAR("ALL","BADE EDR TOTAL PROCESSED")
+6 ;Display throttle and processing status
+7 SET THROTTLE=$$GET^XPAR("ALL","BADE EDR PT THROTTLE")
+8 SET CNT=$$GET^XPAR("ALL","BADE EDR THROTTLE CT")
+9 SET STOP=$$GET^XPAR("ALL","BADE EDR PAUSE PATIENT LOAD",1,"E")
+10 SET TASK=$$GET^XPAR("ALL","BADE EDR LOAD TSK")
+11 ;Get the providers processed and total number processed
+12 SET USR=$$GET^XPAR("ALL","BADE EDR LAST NEW PERSON")
+13 SET PDATA=$$GET1^DIQ(200,USR,.01)_$SELECT(USR>0:" ("_USR_")",1:"")
+14 SET PTOTAL=$$GET^XPAR("ALL","BADE EDR TOTAL PROVIDERS")
+15 ;Display the processing status
+16 SET PSTOP=$$GET^XPAR("ALL","BADE EDR PAUSE PROV UPLOAD",1,"E")
+17 SET PTASK=$$GET^XPAR("ALL","BADE EDR PRV TSK")
+18 ; ----- IHS/SAIC/FJE 3/9/11 added to complete display for merge
+19 ;Get MERGED PATIENTS processed and total number processed
+20 SET MRGDFN=$$GET^XPAR("ALL","BADE EDR MRG DFN")
+21 SET MRGDATA=$$GET1^DIQ(2,MRGDFN,.01)_$SELECT(MRGDFN>0:" ("_MRGDFN_")",1:"")
+22 SET MRGTOTAL=$$GET^XPAR("ALL","BADE EDR MRG TOTAL")
+23 ;Display the processing status
+24 SET MRGSTOP=$$GET^XPAR("ALL","BADE EDR PAUSE MRG LOAD",1,"E")
+25 SET MRGTASK=$$GET^XPAR("ALL","BADE EDR MRG LOAD TSK")
+26 ; ----- end IHS/SAIC/FJE 3/9/11
+27 ; Display statistics
+28 IF $EXTRACT($GET(IOST),1,2)'="C-"
QUIT
+29 NEW X,%ZIS,IORVON,IORVOFF,MNU
+30 SET VER="Version "_$GET(VER,1.0)
SET PKG=$GET(PKG,"RPMS-Dentrix Upload")
+31 SET X="IORVON;IORVOFF"
+32 DO ENDR^%ZISS
+33 USE IO
+34 WRITE @IOF,IORVON,$$GET1^DIQ(4,DUZ(2),.01),?(IOM-$LENGTH(PKG)\2),PKG,?(IOM-$LENGTH(VER)),VER,!,IORVOFF
+35 WRITE !!!!,"Patient Upload Data"
+36 WRITE !,?5,"Last Patient Processed: "_DATA
+37 WRITE !,?5,"Total Pts processed: "_TOTAL
+38 WRITE !,?5,"Throttle seconds: "_THROTTLE,?40,"Throttle Pt. Ct.: "_CNT
+39 WRITE !,?5,"Currently stopped: "_STOP,?40,"Task: "_TASK
+40 WRITE !,"Provider Upload Data"
+41 WRITE !,?5,"Last Provider Processed: "_PDATA
+42 WRITE !,?5,"Total Prov processed: "_PTOTAL
+43 WRITE !,?5,"Currently stopped: "_PSTOP,?40,"Task: "_PTASK
+44 WRITE !,"Merge Upload Data"
+45 WRITE !,?5,"Last Merged Patient Processed: "_MRGDATA
+46 WRITE !,?5,"Total Merged Patients processed: "_MRGTOTAL
+47 WRITE !,?5,"Currently stopped: "_MRGSTOP,?40,"Task: "_MRGTASK
+48 WRITE !!
+49 SET DIR(0)="EA"
SET DIR("?")=""
SET DIR("A")="Press ENTER to continue..."
DO ^DIR
KILL DIR
+50 QUIT
SENDMFN ;Send one MFN message
+1 NEW ERR,INDA,DIC,D,MFNTYP
+2 SET DIC=200
SET DIC(0)="AEQ"
SET DIC("A")="Select DENTIST: "
+3 SET D="AK.PROVIDER"
SET DIC("S")="I $$ISDENTST^BADEVNT1(+Y)"
+4 DO IX^DIC
IF +Y>0
Begin DoDot:1
+5 SET INDA=+Y
+6 IF $$NPI^XUSNPI("Individual_ID",INDA)<0
Begin DoDot:2
+7 WRITE !,"Selected provider lacks NPI number"
End DoDot:2
QUIT
+8 DO MFN^BADEVNT1(INDA)
+9 WRITE !,$SELECT($DATA(ERR):"Unable to send HL7 message...",$GET(MSG):MSG,1:"Message was sent...")
End DoDot:1
+10 ; IHS/MSC/AMF 10/9/10 modified - removed H, replaced with Enter to continue.
+11 SET DIR(0)="EA"
SET DIR("?")=""
SET DIR("A")="Press ENTER to continue..."
DO ^DIR
KILL DIR
+12 QUIT
MFN(INDA) ;EP Create and send one MFN message
+1 ;Make sure its a dentist
+2 NEW PC,DENT
+3 IF '$DATA(^VA(200,INDA,0))
QUIT
+4 IF $PIECE($GET(^VA(200,INDA,0)),U,1)=""
QUIT
+5 SET PC=$PIECE($GET(^VA(200,INDA,"PS")),U,5)
+6 SET DENT=""
SET DENT=$ORDER(^DIC(7,"D",52,DENT))
+7 IF $DATA(MFNTYP)=0
SET MFNTYP=$$FINDTYP^BADEHL2(INDA)
+8 IF PC=DENT
DO NEWMSG^BADEHL2(INDA,MFNTYP)
QUIT
+9 IF '$TEST
SET MSG="Not a dentist, message not sent..."
+10 QUIT
MSA ;EP
+1 NEW MSA,HLST
+2 DO SET(.ARY,"MSA",0)
+3 DO SET(.ARY,"AA",1)
+4 DO SET(.ARY,"TODO-MSGID",2)
+5 DO SET(.ARY,"Transaction Successful",3)
+6 DO SET(.ARY,"todo-010",4)
+7 SET MSA=$$ADDSEG^HLOAPI(.HLST,.ARY)
+8 QUIT
SET(ARY,V,F,C,S,R) ;EP
+1 DO SET^HLOAPI(.ARY,.V,.F,.C,.S,.R)
+2 QUIT
+3 ; Edit a parameter from a menu option
EDITPAR(PARAM) ;EP
+1 SET PARAM=$GET(PARAM,$PIECE(XQY0,U))
+2 DO TITLE()
IF $$CHECK(8989.51,PARAM,"Parameter")
DO EDITPAR^XPAREDIT(PARAM)
+3 QUIT
+4 ; Display required header for menus
TITLE(PKG,VER) ;EP
+1 IF $EXTRACT($GET(IOST),1,2)'="C-"
QUIT
+2 NEW X,%ZIS,IORVON,IORVOFF,MNU
+3 SET MNU=$PIECE(XQY0,U,2)
SET VER="Version "_$GET(VER,1.0)
SET PKG=$GET(PKG,"RPMS-Dentrix Upload")
+4 SET X="IORVON;IORVOFF"
+5 DO ENDR^%ZISS
+6 USE IO
+7 WRITE @IOF,IORVON,$$GET1^DIQ(4,DUZ(2),.01),?(IOM-$LENGTH(PKG)\2),PKG,?(IOM-$LENGTH(VER)),VER,!,IORVOFF,?(IOM-$LENGTH(MNU)\2-$X),MNU
+8 QUIT
CHECK(FIL,VAL,ENT) ;
+1 IF $$FIND1^DIC(FIL,"","X",VAL)
QUIT 1
+2 WRITE !,ENT," ",VAL," was not found.",!
+3 DO PAUSE
+4 QUIT 0
+5 ; Pause for user response
PAUSE ;EP
+1 NEW X
+2 SET DIR(0)="EA"
SET DIR("?")=""
SET DIR("A")="Press ENTER to continue..."
DO ^DIR
KILL DIR
+3 QUIT
+4 ; Returns true if user is a dentist (52)
ISDENTST(USR) ;EP
+1 NEW PCLS,CODE
+2 ; Provider Class
SET PCLS=+$PIECE($GET(^VA(200,USR,"PS")),U,5)
+3 ; IHS Code
SET CODE=+$PIECE($GET(^DIC(7,PCLS,9999999)),U)
+4 QUIT CODE=52
+5 ; Returns Inactive status of provider
+6 ; Input: USR = IEN to File 200
INACTPRV(USR) ;EP
+1 IF '$GET(USR)
QUIT 1
+2 ; Provider has been terminated
IF $PIECE($GET(^VA(200,USR,0)),U,11)
QUIT 1
+3 ; Provider is inactive
IF $PIECE($GET(^VA(200,USR,"PS")),U,4)
QUIT 1
+4 ; Provider is active
QUIT 0
