Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BADEVNT1

BADEVNT1.m

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