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

PXQPPUTIL.m

Go to the documentation of this file. 
  1. PXQPPUTIL ;SLS/PKR - Utility for primary provider repair. ;08/14/2020
  1.  ;;1.0;PCE PATIENT CARE ENCOUNTER;**211**;Aug 12, 1996;Build 454
  1.  ;
  1.  ;ICR #3125 covers references to ^RADPT, file #70.
  1.  ;ICR #5605 covers references to ^RARPT, file #74.
  1.  ;===============
  1. ASKCONTINUE() ;Ask the user if they want to continue.
  1.  N DIR,DIRUT,X,Y
  1.  S DIR(0)="SABX^0:NO;1:YES"
  1.  S DIR("A")="Continue checking encounters? "
  1.  S DIR("B")="YES"
  1.  D ^DIR
  1.  I $D(DIRUT) Q 0
  1.  Q Y
  1.  ;
  1.  ;===============
  1. DISCLAIMER ;Display the disclaimer.
  1.  W !,"=============== NOTE ==============="
  1.  W !,"This utility searches for Lab and Radiology Encounters in the specified"
  1.  W !,"date range. Those that do not have a primary provider will be processed."
  1.  W !,"===================================="
  1.  W !
  1.  Q
  1.  ;
  1.  ;===============
  1. DISPIMPTEXT(VISITIEN) ;
  1.  N CASENUM,CPT,CPTLIST,DFN,IENS,IENT,IMPTEXT,IND,INVDT,JND,MSG,NL
  1.  N RADCPT,REPORT,RESULT,TEXT,VCPTIEN,X
  1.  ;Find the Radiology Examination(s) for this Visit.
  1.  I '$D(^RADPT("AVSIT",VISITIEN)) D  Q
  1.  . S ^TMP("PXQPPR",$J,"RAD","NO EXAM",VISITIEN)=""
  1.  . W !,"No Radiology exam can be found for Visit IEN ",VISITIEN,"."
  1.  . W !,"Therefore, no Impresion Text can be displayed."
  1.  . H 2
  1.  ;Build the list of CPT codes for this encounter.
  1.  S VCPTIEN=""
  1.  F  S VCPTIEN=$O(^AUPNVCPT("AD",VISITIEN,VCPTIEN)) Q:VCPTIEN=""  D
  1.  . S CPT=$P(^AUPNVCPT(VCPTIEN,0),U,1)
  1.  . S CPTLIST(CPT)=""
  1.  S DFN=$P(^AUPNVSIT(VISITIEN,0),U,5)
  1.  S INVDT=$O(^RADPT("AVSIT",VISITIEN,DFN,""))
  1.  S IENT=INVDT_","_DFN_","
  1.  S IND=""
  1.  F  S IND=$O(^RADPT("AVSIT",VISITIEN,DFN,INVDT,IND)) Q:IND=""  D
  1.  . S IENS=IND_","_IENT
  1.  . S RADCPT(IND)=$$GET1^DIQ(70.03,IENS,"2:9","","","MSG")
  1.  . I '$D(CPTLIST(RADCPT(IND))) Q
  1.  . S REPORT(IND)=$$GET1^DIQ(70.03,IENS,17,"I","","MSG")
  1.  I '$D(REPORT) D  Q
  1.  . W !,"No Radiology Reports were found for this encounter, cannot display the Impression Text."
  1.  . H 2
  1.  S IND="",NL=0
  1.  F  S IND=$O(REPORT(IND)) Q:IND=""  D
  1.  . K IMPTEXT
  1.  . S IENS=REPORT(IND)_","
  1.  . S NL=NL+1,TEXT(NL)=" "
  1.  . S CASENUM=$$GET1^DIQ(74,IENS,4,"","","MSG")
  1.  . S NL=NL+1,TEXT(NL)="Case Number - "_CASENUM
  1.  . S NL=NL+1,TEXT(NL)="CPT Code - "_RADCPT(IND)
  1.  . S NL=NL+1,TEXT(NL)="Impression Text:"
  1.  . S RESULT=$$GET1^DIQ(74,IENS,300,"","IMPTEXT","MSG")
  1.  . I RESULT'="" D
  1.  .. S JND=0
  1.  .. F  S JND=$O(IMPTEXT(JND)) Q:JND=""  S NL=NL+1,TEXT(NL)=IMPTEXT(JND)
  1.  S X="IORESET"
  1.  D ENDR^%ZISS
  1.  D BROWSE^DDBR("TEXT","NR","Radiology Report Impression Text")
  1.  W IORESET
  1.  D KILL^%ZISS
  1.  Q
  1.  ;
  1.  ;===============
  1. FINDEXAM(VISITIEN) ;Try to link the Visit to the Radiology Exam.
  1.  N CPT,CPTLIST,DFN,FDA,HLOC,IENS,IENT,IMLOC,IND,INVDT,MSG,RADCPT
  1.  N VCPTIEN,VISITDT,TEMP
  1.  S TEMP=^AUPNVSIT(VISITIEN,0)
  1.  S VISITDT=$P(TEMP,U,1)
  1.  S DFN=$P(TEMP,U,5)
  1.  ;ICR #65
  1.  I '$D(^RADPT("AR",VISITDT,DFN)) Q
  1.  S HLOC=$P(TEMP,U,22)
  1.  S INVDT=9999999.9999-VISITDT
  1.  S IENT=INVDT_","_DFN_","
  1.  S IMLOC=$$GET1^DIQ(70.02,IENT,"4:.01","I","","MSG")
  1.  I IMLOC'=HLOC Q
  1.  ;Build the list of CPT codes for this encounter.
  1.  S VCPTIEN=""
  1.  F  S VCPTIEN=$O(^AUPNVCPT("AD",VISITIEN,VCPTIEN)) Q:VCPTIEN=""  D
  1.  . S CPT=$P(^AUPNVCPT(VCPTIEN,0),U,1)
  1.  . S CPTLIST(CPT)=""
  1.  ;Look for a match on the CPT code.
  1.  S IND=0
  1.  F  S IND=+$O(^RADPT(DFN,"DT",INVDT,"P",IND)) Q:IND=0  D
  1.  . S IENS=IND_","_IENT
  1.  . S RADCPT=$$GET1^DIQ(70.03,IENS,"2:9","I","","MSG")
  1.  . I RADCPT="" Q
  1.  . I '$D(CPTLIST(RADCPT)) Q
  1.  . K FDA
  1.  .;ICR #7186
  1.  . S FDA(70.03,IENS,27)=VISITIEN
  1.  . D FILE^DIE("K","FDA","MSG")
  1.  . I '$D(MSG) S ^TMP("PXQPPR",$J,"RAD","VISIT",VISITIEN)=IENS
  1.  Q
  1.  ;
  1.  ;===============
  1. GETDATE(DEFAULT,PROMPT,MINDATE) ;Ask the user for a date.
  1.  N DIR,DIRUT,X,Y
  1.  S DIR(0)="D::DT:AE"
  1.  I $G(MINDATE)>0 S DIR(0)=DIR(0)_U_MINDATE
  1.  S DIR("A")=PROMPT
  1.  S DIR("B")=DEFAULT
  1.  D ^DIR
  1.  I $D(DIRUT) S Y="^"
  1.  Q Y
  1.  ;
  1.  ;===============
  1. OPENENCOUNTER(VISITIEN) ;Open the encounter in List Manger so the primary
  1.  ;provider can be edited.
  1.  N PXCEEXIT,PXCEKEYS,PXCEPKG,PXCESOR,PXCEVIEN,PXCEVIEW
  1.  N SPE,TEMP
  1.  S TEMP=$G(^AUPNVSIT(VISITIEN,812))
  1.  S PXCEPKG=$P(TEMP,U,2),PXCESOR=$P(TEMP,U,3)
  1.  S PXCEKEYS="SPCD"
  1.  S PXCEVIEN=VISITIEN
  1.  S PXCEVIEW="P^V^"
  1.  D EN^PXCEAE
  1.  Q
  1.  ;
  1.  ;===============
  1. PPREPAIR ;Find and repair encounters that do not have a primary provider.
  1.  N CONTINUE,DATASOURCE,ENDDATE,LABDS,LABPKG,NPRIM,NPROV
  1.  N PACKAGE,PORS,PRIMARY,PROVIDER,PROVIDERLIST,RADPKG,RADDS,RADPROXY
  1.  N SC,STARTDATE,TEMP,VISITIEN,VISITDT,VPRVIEN
  1.  K ^TMP("PXQPPR",$J)
  1.  ;ICR #10048
  1.  S LABPKG=$$FIND1^DIC(9.4,"","B","LAB SERVICE")
  1.  S LABDS=$$FIND1^DIC(839.7,"","B","LAB DATA")
  1.  S RADPKG=$$FIND1^DIC(9.4,"","B","RADIOLOGY/NUCLEAR MEDICINE")
  1.  S RADDS=$$FIND1^DIC(839.7,"","B","RAD/NUC MED")
  1.  S RADPROXY=$$FIND1^DIC(200,"","B","RADIOLOGY,OUTSIDE SERVICE")
  1.  S ^TMP("PXQPPR",$J,"REPSTART")=$$NOW^XLFDT
  1.  D DISCLAIMER
  1.  W !,"Set the date range for searching for encounters."
  1.  S STARTDATE=$$GETDATE("","Input the starting date")
  1.  I STARTDATE="^" Q
  1.  S ENDDATE=$$GETDATE("T","Input the ending date: ",STARTDATE)
  1.  I ENDDATE="^" Q
  1.  S ENDDATE=ENDDATE+0.235959
  1.  S ^TMP("PXQPPR",$J,"STARTDATE")=STARTDATE
  1.  S ^TMP("PXQPPR",$J,"ENDDATE")=ENDDATE
  1.  S VISITDT=STARTDATE
  1.  S CONTINUE=1
  1.  F  S VISITDT=$O(^AUPNVSIT("B",VISITDT)) Q:(CONTINUE=0)!(VISITDT>ENDDATE)!(VISITDT="")  D
  1.  . S VISITIEN=0
  1.  . F  S VISITIEN=$O(^AUPNVSIT("B",VISITDT,VISITIEN)) Q:VISITIEN=""  D
  1.  .. S SC=$P(^AUPNVSIT(VISITIEN,0),U,7)
  1.  ..;Historical encounters do not need to be checked.
  1.  .. I SC="E" Q
  1.  .. S NPRIM=0
  1.  ..;Get the list of providers for this encounter.
  1.  .. K PROVIDERLIST
  1.  .. S (NPROV,VPRVIEN)=0
  1.  .. F  S VPRVIEN=+$O(^AUPNVPRV("AD",VISITIEN,VPRVIEN)) Q:VPRVIEN=0  D
  1.  ... S NPROV=NPROV+1
  1.  ... S TEMP=^AUPNVPRV(VPRVIEN,0)
  1.  ... S PROVIDER=$P(TEMP,U,1)
  1.  ... S PORS=$P(TEMP,U,4)
  1.  ... S PROVIDERLIST(PROVIDER)=VPRVIEN_U_PORS
  1.  ... I PORS="P" S NPRIM=NPRIM+1,PRIMARY=PROVIDER
  1.  .. S TEMP=$G(^AUPNVSIT(VISITIEN,812))
  1.  .. S PACKAGE=$P(TEMP,U,2)
  1.  .. S DATASOURCE=$P(TEMP,U,3)
  1.  .. I (PACKAGE=LABPKG)!(DATASOURCE=LABDS) D
  1.  ... D LAB(VISITIEN,.NPRIM,.PRIMARY,.PROVIDERLIST,.CONTINUE)
  1.  .. I (PACKAGE=RADPKG)!(DATASOURCE=RADDS) D
  1.  ... D RAD(VISITIEN,.NPRIM,.PRIMARY,.PROVIDERLIST,RADPROXY,.CONTINUE)
  1.  ;Report what was done.
  1.  D REPORT^PXQPPUTILR
  1.  ;ICR #10052
  1.  D KILL^XUSCLEAN
  1.  K ^TMP("PXQPPR",$J)
  1.  Q
  1.  ;
  1.  ;===============
  1. LAB(VISITIEN,NPRIM,PRIMARY,PROVIDERLIST,CONTINUE) ;Handle Lab
  1.  ;encounters that do not have a primary provider.
  1.  I NPRIM=1 Q
  1.  N ENCPROV,IENS,FDA,MSG,ORDPROV,NENCPROV,NORDPROV,RESULT,TEMP,VCPTIEN
  1.  S (NENCPROV,NORDPROV)=0
  1.  S VCPTIEN=""
  1.  F  S VCPTIEN=$O(^AUPNVCPT("AD",VISITIEN,VCPTIEN)) Q:VCPTIEN=""  D
  1.  . S TEMP=$G(^AUPNVCPT(VCPTIEN,12))
  1.  . I TEMP="" Q
  1.  . S ORDPROV=$P(TEMP,U,2)
  1.  . S ENCPROV=$P(TEMP,U,4)
  1.  . I (ORDPROV'=""),('$D(ORDPROVLIST(ORDPROV))) S ORDPROVLIST(ORDPROV)="",NORDPROV=NORDPROV+1
  1.  . I (ENCPROV'=""),('$D(ENCPROVLIST(ENCPROV))) S ENCPROVLIST(ENCPROV)="",NENCPROV=NENCPROV+1
  1.  ;If there is only one ordering provider make sure they are primary.
  1.  I NORDPROV=1 D
  1.  . S ORDPROV=$O(ORDPROVLIST(""))
  1.  . S IENS=$P(PROVIDERLIST(ORDPROV),U,1)_","
  1.  . S FDA(9000010.06,IENS,.04)="P"
  1.  . D FILE^DIE("K","FDA","MSG")
  1.  . S RESULT=$S($D(MSG):FAILED,1:"SUCCESS")
  1.  . S ^TMP("PXQPPR",$J,"LAB","SETP",VISITIEN,ORDPROV)=RESULT
  1.  ;If the number of ordering providers is not one open the encounter for
  1.  ;editing.
  1.  I NORDPROV'=1 D
  1.  . D OPENENCOUNTER(VISITIEN)
  1.  . S ^TMP("PXQPPR",$J,"LAB","OPEN",VISITIEN)=""
  1.  ;Ask the user if they want to continue.
  1.  S CONTINUE=$$ASKCONTINUE
  1.  Q
  1.  ;
  1.  ;===============
  1. RAD(VISITIEN,NPRIM,PRIMARY,PROVIDERLIST,RADPROXY,CONTINUE) ;Handle Radiology
  1.  ;encounters that ;do not have a primary provider or the primary
  1.  ;provider is the proxy.
  1.  ;If there is no primary provider set one.
  1.  I NPRIM=0 D RADPRIM(VISITIEN,.PROVIDERLIST,.PRIMARY)
  1.  ;If there is no Radiology exam linked to this Visit try to link it.
  1.  I '$D(^RADPT("AVSIT",VISITIEN)) D FINDEXAM(VISITIEN)
  1.  ;If the Primary Provider is the proxy go to RADPROXYPP so the
  1.  ;user can easily edit the Primary Provider.
  1.  I PRIMARY=RADPROXY D RADPROXYPP(VISITIEN,.CONTINUE)
  1.  Q
  1.  ;
  1.  ;===============
  1. RADPRIM(VISITIEN,PROVIDERLIST,PRIMARY) ;Set a primary provider for
  1.  ;Radiology encounters that do not have one.
  1.  N ENCDT,ENCPROV,IENS,FDA,MSG,ORDPROV,PERSONCLASS,RESULT,VCPTIEN
  1.  ;Find the Encounter Provider and Ordering Provider in V CPT.
  1.  S VCPTIEN=$O(^AUPNVCPT("AD",VISITIEN,""))
  1.  I VCPTIEN="" Q
  1.  S ENCPROV=$P(^AUPNVCPT(VCPTIEN,12),U,4)
  1.  S ORDPROV=$P(^AUPNVCPT(VCPTIEN,12),U,2)
  1.  ;If there is an existing V Provider entry for the encounter provider
  1.  ;make it primary. If not, create a new V Provider entry.
  1.  I (ENCPROV'=""),$D(PROVIDERLIST(ENCPROV)) D
  1.  . I $P(PROVIDERLIST(ENCPROV),U,2)="P" Q
  1.  . S IENS=$P(PROVIDERLIST(ENCPROV),U,1)_","
  1.  . S FDA(9000010.06,IENS,.04)="P"
  1.  . D FILE^DIE("K","FDA","MSG")
  1.  . S RESULT=$S($D(MSG):FAILED,1:"SUCCESS")
  1.  . S ^TMP("PXQPPR",$J,"RAD","SETP",VISITIEN,ENCPROV)=RESULT
  1.  .;Make Ordering Provider secondary.
  1.  I (ORDPROV'=""),$D(PROVIDERLIST(ORDPROV)) D
  1.  . I $P(PROVIDERLIST(ORDPROV),U,2)="S" Q
  1.  . S IENS=$P(PROVIDERLIST(ORDPROV),U,1)_","
  1.  . K FDA,MSG
  1.  . S FDA(9000010.06,IENS,.04)="S"
  1.  . D FILE^DIE("K","FDA","MSG")
  1.  S ENCDT=$P($G(^AUPNVCPT(VCPTIEN,12)),U,1)
  1.  I ENCDT="" S ENCDT=$P(^AUPNVSIT(VISITIEN,0),U,1)
  1.  ;No V Provider entry found.
  1.  I (ENCPROV'=""),'$D(PROVIDERLIST(ENCPROV)) D
  1.  . K FDA,MSG
  1.  .;Get the values for Patient, Visit, Event Date and Time, Comments,
  1.  .;Package, and Data Source from the V CPT entry.
  1.  . S FDA(9000010.06,"+1,",.01)=ENCPROV
  1.  . S FDA(9000010.06,"+1,",.02)=$P(^AUPNVCPT(VCPTIEN,0),U,2)
  1.  . S FDA(9000010.06,"+1,",.03)=$P(^AUPNVCPT(VCPTIEN,0),U,3)
  1.  . S FDA(9000010.06,"+1,",.04)="P"
  1.  . S PERSONCLASS=$P($$GET^XUA4A72(ENCPROV,ENCDT),U,1)
  1.  . I +PERSONCLASS>0 S FDA(9000010.06,"+1,",.06)=PERSONCLASS
  1.  . S FDA(9000010.06,"+1,",1201)=$P($G(^AUPNVCPT(VCPTIEN,12)),U,1)
  1.  . S FDA(9000010.06,"+1,",81101)=$G(^AUPNVCPT(VCPTIEN,811))
  1.  . S FDA(9000010.06,"+1,",81202)=$P($G(^AUPNVCPT(VCPTIEN,812)),U,2)
  1.  . S FDA(9000010.06,"+1,",81203)=$P($G(^AUPNVCPT(VCPTIEN,812)),U,3)
  1.  . D UPDATE^DIE("","FDA","","MSG")
  1.  I (ORDPROV'=""),'$D(PROVIDERLIST(ORDPROV)) D
  1.  . K FDA,MSG
  1.  . S FDA(9000010.06,"+1,",.01)=ORDPROV
  1.  . S FDA(9000010.06,"+1,",.02)=$P(^AUPNVCPT(VCPTIEN,0),U,2)
  1.  . S FDA(9000010.06,"+1,",.03)=$P(^AUPNVCPT(VCPTIEN,0),U,3)
  1.  . S FDA(9000010.06,"+1,",.04)="S"
  1.  . S PERSONCLASS=$P($$GET^XUA4A72(ORDPROV,ENCDT),U,1)
  1.  . I +PERSONCLASS>0 S FDA(9000010.06,"+1,",.06)=PERSONCLASS
  1.  . S FDA(9000010.06,"+1,",1201)=$P($G(^AUPNVCPT(VCPTIEN,12)),U,1)
  1.  . S FDA(9000010.06,"+1,",81101)=$G(^AUPNVCPT(VCPTIEN,811))
  1.  . S FDA(9000010.06,"+1,",81202)=$P($G(^AUPNVCPT(VCPTIEN,812)),U,2)
  1.  . S FDA(9000010.06,"+1,",81203)=$P($G(^AUPNVCPT(VCPTIEN,812)),U,3)
  1.  . D UPDATE^DIE("","FDA","","MSG")
  1.  S PRIMARY=ENCPROV
  1.  Q
  1.  ;
  1.  ;===============
  1. RADPROXYPP(VISITIEN,CONTINUE) ;Radiology encounter has the proxy as the primary
  1.  ;provider.
  1.  ;Display the Impression Text, it should contain the name and NPI
  1.  ;of the teleradiology provider.
  1.  D DISPIMPTEXT(VISITIEN)
  1.  ;Open the Encounter for editing.
  1.  D OPENENCOUNTER(VISITIEN)
  1.  S ^TMP("PXQPPR",$J,"RAD","PROXY",VISITIEN)=""
  1.  ;Ask the user if they want to continue.
  1.  S CONTINUE=$$ASKCONTINUE
  1.  Q
  1.  ;
  1.  ;===============
  1. SETONEPRIME(PROVIDERLIST) ;There is only one provider for the encounter
  1.  ;and it is not marked primary provider, make it primary.
  1.  N FDA,IENS,MSG,PROVIDER,RESULT
  1.  S PROVIDER=$O(PROVIDERLIST(""))
  1.  S IENS=$P(PROVIDERLIST(PROVIDER),U,1)_","
  1.  S FDA(9000010.06,IENS,.04)="P"
  1.  D FILE^DIE("K","FDA","MSG")
  1.  S RESULT=$S($D(MSG):"FAILED",1:"SUCCESS")
  1.  S ^TMP("PXQPPR",$J,"SET1P",IENS,PROVIDER)=RESULT
  1.  Q
  1.  ;