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

BADEPROV.m

Go to the documentation of this file. 
  1. 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
  1.  Q
  1. DISPPROV ; EP for BADE EDR DISP PROV
  1.  ; consolidates FINDPRV and UPLDPROV
  1.  ;
  1.  N WHICH,IEN,NAME,CODE,PCLS,TP,TPX,IP,IPX,NPI,COUNT,TITLE
  1.  N X,%ZIS,IORVON,IORVOFF,VER,PKG,DASH
  1.  S DASH="---------------------------------------------------------------------------------"
  1.  W !!,"This option will display dentists in your RPMS system.",!,"You may include dentists who are inactive, or only active dentists.",!
  1.  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"
  1.  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
  1.  Q:Y=U  S WHICH=Y
  1.  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
  1.  S TITLE=$S(WHICH="O":"RPMS-Dentrix Active Provider Upload Display",1:"RPMS-Dentrix All Provider Display")
  1.  S VER="Version "_$G(VER,1.0),PKG=$G(PKG,TITLE)
  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.  I WHICH="A" W !!,"Provider",?32,"Terminated Inactivated",?56,"NPI",?70,"IEN",!,$E(DASH,1,80)
  1.  I WHICH="O" W !!,"Provider",?32,"NPI",?46,"IEN",!,$E(DASH,1,55)
  1.  ;
  1.  S IEN=0,NAME="",COUNT=0
  1.  F  S NAME=$O(^VA(200,"B",NAME)) Q:NAME=""  D
  1.  .S IEN=0 F  S IEN=$O(^VA(200,"B",NAME,IEN)) Q:+IEN'>0  D
  1.  ..Q:'$D(^VA(200,IEN,0))
  1.  ..S PCLS=+$P($G(^VA(200,IEN,"PS")),U,5)  ; Provider Class
  1.  ..S CODE=+$P($G(^DIC(7,PCLS,9999999)),U)     ; IHS Code
  1.  ..Q:CODE'=52  ;Not a Dentist
  1.  ..S NAME=$P($G(^VA(200,IEN,0)),U,1)  ;Provider Name
  1.  ..S TP=$P($G(^VA(200,IEN,0)),U,11) ; Provider has been terminated
  1.  ..S TPX=$S(+TP:"Yes",1:"No")
  1.  ..S IP=$P($G(^VA(200,IEN,"PS")),U,4) ; Provider is inactive
  1.  ..S IPX=$S(+IP:"Yes",1:"No")
  1.  ..S NPI=$P($G(^VA(200,IEN,"NPI")),U,1) ; Provider NPI
  1.  ..I WHICH="O" Q:+TP!+IP!'+NPI
  1.  ..S COUNT=COUNT+1
  1.  ..I WHICH="A" W !,NAME,?32,TPX,?43,IPX,?56,NPI,?70,IEN
  1.  ..I WHICH="O" W !,NAME,?32,NPI,?46,IEN
  1.  W !!,"A total of ",COUNT," providers.",!!
  1.  S DIR(0)="EA",DIR("?")="",DIR("A")="Press ENTER to continue..." D ^DIR K DIR
  1.  Q
  1.  ;
  1. PURGEMAN ;EP - Entry point for manual PURGE from menu
  1.  N PURDT,MSGIEN,PURNOW,QNM,DIR,HMDAYS,TYPE,COUNT,STR
  1.  W !!,"This option will purge all Dentrix messages which are older than a certain date."
  1.  ;
  1.  S HMDAYS=$$GET^XPAR("ALL","BADE EDR DEFAULT PURGE DAYS")
  1.  S:HMDAYS="" HMDAYS=7
  1. PM1 ;
  1.  S DIR(0)="NO^0:100:0",DIR("A")="For how many days would you like to keep messages",DIR("B")=HMDAYS
  1.  S DIR("?")="Enter a number indicating the number of days for message retention.  All older messages will be purged." D ^DIR K DIR
  1.  Q:Y=U  S HMDAYS=Y
  1. PM2 ;
  1.  S DIR(0)="Y",DIR("A")="Do you want to continue with the purge",DIR("B")="No"
  1.  D ^DIR K DIR
  1.  G:Y=U PM1 Q:(X="N")!'Y
  1. PM3 ; 
  1.  S QNM="DENTRIX",COUNT=0
  1.  S PURNOW=$$NOW^XLFDT
  1.  S PURDT=PURNOW-HMDAYS
  1.  S MSGIEN=0 F  S MSGIEN=$O(^HLB(MSGIEN)) Q:+MSGIEN=0  D
  1.  .S STR=$G(^HLB(MSGIEN,0))
  1.  .Q:$P(STR,U,16)>PURDT
  1.  .Q:'$$PM4(MSGIEN)
  1.  .S COUNT=COUNT+1
  1.  .D DELETE^HLOPURGE(MSGIEN)
  1.  W !!,COUNT," messages have been purged. ",!
  1.  S DIR(0)="EA",DIR("?")="",DIR("A")="Press ENTER to continue..." D ^DIR K DIR
  1.  Q
  1.  ; Verifies that message is for DENTRIX
  1. PM4(MSGIEN) ;EP-
  1.  N MSG,RES
  1.  S RES=$$STARTMSG^HLOPRS(.MSG,MSGIEN)
  1.  S RES=RES&($G(MSG("HDR","RECEIVING APPLICATION"))=QNM)
  1.  Q RES
  1.  ;
  1. AC ;DELETE "AC" XREF FOR IEN
  1.  ;EXAMPLE:  ^HLB("AC","Dental^198.45.6.101:5027^DNSDENTRIXDental 1",1)=""
  1.  S (BADE1,BADE2,BADE3)=""
  1.  S BADE1="AC"
  1.  F  S BADE2=$O(^HLB(BADE1,BADE2)) Q:BADE2=""  D
  1.  .S BADE3=0 F  S BADE3=$O(^HLB(BADE1,BADE2,BADE3)) Q:+BADE3<1  D
  1.  ..K:BADE3=BADEIEN ^HLB(BADE1,BADE2,BADE3)
  1.  Q
  1. ADI ;DELETE "AD" XREF FOR "IN" IEN
  1.  ;EXAMPLE:  ^HLB("AD","IN",3)=""
  1.  S (BADE1,BADE2,BADE3)=""
  1.  S BADE1="AD",BADE2="IN"
  1.  S BADE3=0 F  S BADE3=$O(^HLB(BADE1,BADE2,BADE3)) Q:+BADE3<1  D
  1.  .K:BADE3=BADEIEN ^HLB(BADE1,BADE2,BADE3)
  1.  Q
  1. ADO ;DELETE "AD" XREF FOR "OUT" IEN
  1.  ;EXAMPLE:  ^HLB("AD","OUT",3090819.1143,3)=""
  1.  S (BADE1,BADE2,BADE3,BADE4)=""
  1.  S BADE1="AD",BADE2="OUT"
  1.   F  S BADE3=$O(^HLB(BADE1,BADE2,BADE3)) Q:BADE3=""  D
  1.  .S BADE4=0 F  S BADE4=$O(^HLB(BADE1,BADE2,BADE3,BADE4)) Q:+BADE4<1  D
  1.  ..K:BADE4=BADEIEN ^HLB(BADE1,BADE2,BADE3,BADE4)
  1.  Q
  1. QUEUEI ;DELETE "QUEUE" XREF FOR IEN
  1.  ;EXAMPLE:  ^HLB("QUEUE","IN",3100218.220529,"RPMS-DEN","DFT","P03",1)=""
  1.  S (BADE1,BADE2,BADE3,BADE4,BADE5,BADE6,BADE7)=""
  1.  S BADE1="QUEUE"
  1.  F  S BADE2=$O(^HLB(BADE1,BADE2)) Q:BADE2=""  D
  1.  .S BADE3="" F  S BADE3=$O(^HLB(BADE1,BADE2,BADE3)) Q:BADE3=""  D
  1.  ..S BADE4="" F  S BADE4=$O(^HLB(BADE1,BADE2,BADE3,BADE4)) Q:BADE4=""  D
  1.  ...S BADE5="" F  S BADE5=$O(^HLB(BADE1,BADE2,BADE3,BADE4,BADE5)) Q:BADE5=""  D
  1.  ....S BADE6="" F  S BADE6=$O(^HLB(BADE1,BADE2,BADE3,BADE4,BADE5,BADE6)) Q:BADE6=""  D
  1.  .....S BADE7="" F  S BADE7=$O(^HLB(BADE1,BADE2,BADE3,BADE4,BADE5,BADE6,BADE7)) Q:BADE7=""  D
  1.  ......K:BADE7=BADEIEN ^HLB(BADE1,BADE2,BADE3,BADE4,BADE5,BADE6,BADE7)
  1.  Q
  1. QUEUEO ;DELETE "QUEUE" XREF FOR IEN
  1.  ;EXAMPLE:  ^HLB("QUEUE","IN",3100218.220529,"RPMS-DEN","DFT","P03",1)=""
  1.  S (BADE1,BADE2,BADE3,BADE4,BADE5,BADE6,BADE7)=""
  1.  S BADE1="QUEUE",BADE2="OUT"
  1.  F  S BADE3=$O(^HLB(BADE1,BADE2,BADE3)) Q:BADE3=""  D
  1.  .S BADE4="" F  S BADE4=$O(^HLB(BADE1,BADE2,BADE3,BADE4)) Q:BADE4=""  D
  1.  ..S BADE5="" F  S BADE5=$O(^HLB(BADE1,BADE2,BADE3,BADE4,BADE5)) Q:BADE5=""  D
  1.  ...K:BADE5=BADEIEN ^HLB(BADE1,BADE2,BADE3,BADE4,BADE5)
  1.  Q
  1. TOTCNT  ;Displays Patient Count Info
  1.  ;Loop through the patients and send data
  1.  N BADEDFN,BADECNTD,BADECNTA,BADEAPAT,BADEDPAT,BADEA41,BADEBPAT
  1.  S (BADEDFN,BADECNTD,BADECNTA,BADEAPAT,BADEDPAT,BADEA41,BADEBPAT)=0
  1.  F  S BADEDFN=$O(^DPT(BADEDFN)) Q:+BADEDFN'>0  D
  1.  .S BADECNTD=BADECNTD+1
  1.  .I '$D(^AUPNPAT(BADEDFN,0)) S BADEAPAT=BADEAPAT+1 Q
  1.  .I '$D(^AUPNPAT(BADEDFN,41)) S BADEA41=BADEA41+1 Q
  1.  .S BADENAME=$P($G(^DPT(BADEDFN,0)),"^",1)
  1.  .Q:BADENAME=""
  1.  .I '$D(^DPT("B",BADENAME,BADEDFN)) S BADEBPAT=BADEBPAT+1 Q
  1.  S BADEDFN=0 F  S BADEDFN=$O(^AUPNPAT(BADEDFN)) Q:+BADEDFN'>0  D
  1.  .S BADECNTA=BADECNTA+1
  1.  .I '$D(^DPT(BADEDFN,0)) S BADEDPAT=BADEDPAT+1 Q
  1.  ; Display statistics
  1.  Q:$E($G(IOST),1,2)'="C-"
  1.  S VER="Version "_$G(VER,1.0),PKG=$G(PKG,"RPMS-Dentrix Patient Count Display")
  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 Counts"
  1.  W !,"----------------------------------------------------------------------"
  1.  W !,"VA PATIENT (DPT) COUNT:  ",BADECNTD
  1.  W !,"PATIENT (AUPNPAT) COUNT:  ",BADECNTA
  1.  W !,"AUPNPAT ENTRY MISSING DPT COUNT:  ",BADEDPAT
  1.  W !,"DPT ENTRY MISSING AUPNPAT COUNT:  ",BADEAPAT
  1.  W !,"AUPNPAT ENTRY MISSING A DIVISION/HRCN (A41) COUNT:  ",BADEA41
  1.  W !,"DPT MISSING ""B"" XREF COUNT:  ",BADEBPAT
  1.  W !!
  1.  S DIR(0)="EA",DIR("?")="",DIR("A")="Press ENTER to continue..." D ^DIR K DIR
  1.  Q