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

BPMXFIX.m

Go to the documentation of this file. 
  1. BPMXFIX ;IHS/OIT/NKD - CLEANUP UTILITY DRIVER - 6/26/12 ;
  1.  ;;1.0;IHS PATIENT MERGE;**2**;MAR 01, 2010;Build 1
  1.  ;IHS/OIT/NKD  6/13/2012 Correct bad 3P claim data
  1.  ;                       Correct invalid HRN data
  1.  ;                       Batch issue cleanup
  1.  ;
  1. EN1 ;EP
  1.  ; IF CALLED FROM MENU [BPM AUDIT] SET VARIABLE TO PRINT TO SCREEN
  1.  S BPMMENU=1
  1.  D RSLT($TR($J(" ",80)," ","*"))
  1.  D RSLT($TR($J(" ",10)," ","*")_"   This utility should only be run during off-peak hours.   "_$TR($J(" ",10)," ","*"))
  1.  D RSLT($TR($J(" ",10)," ","*")_"   Users must ensure the following before continuing:       "_$TR($J(" ",10)," ","*"))
  1.  D RSLT($TR($J(" ",10)," ","*")_"   1) No patient merge process are running or scheduled.    "_$TR($J(" ",10)," ","*"))
  1.  D RSLT($TR($J(" ",10)," ","*")_"   2) Data entry on merged patients has been halted.        "_$TR($J(" ",10)," ","*"))
  1.  D RSLT($TR($J(" ",10)," ","*")_"   3) Screen output is being logged for review.             "_$TR($J(" ",10)," ","*"))
  1.  D RSLT($TR($J(" ",80)," ","*"))
  1.  S DIR("A")="Proceed"
  1.  S DIR("B")="NO"
  1.  S DIR(0)="Y"
  1.  D ^DIR
  1.  Q:'Y
  1.  K DIR,X,Y
  1. EN ;EP
  1.  ; MAIN EP FROM KIDS, PRINTS TO INSTALL LOG FILE
  1.  N I,BPMT
  1.  D TIME("Cleanup Utility",1)
  1.  D BUILD
  1.  F I=1:1 S BPMT=$P($T(RTNS+I),";;",2) Q:BPMT["$$END"  D
  1.  . D TIME($P(BPMT,";",1),1)
  1.  . D @$P(BPMT,";",2)
  1.  . D TIME($P(BPMT,";",1),2)
  1.  D TIME("Cleanup Utility",2)
  1.  Q
  1.  ;
  1. FIXAUPN ;
  1.  ;----- IHS/OIT/NKD BPM*1.0*2 Remove blank HRNs from all Patients
  1.  N BPMP,BPMPL,BPMCNT,BPMDOT
  1.  S (BPMCNT,BPMDOT,BPMP)=0
  1.  F  S BPMP=$O(^AUPNPAT(BPMP)) Q:BPMP'=+BPMP  D
  1.  . S BPMDOT=BPMDOT+1 I '(BPMDOT#10000) W "."
  1.  . Q:'$D(^AUPNPAT(BPMP,41))
  1.  . S BPMPL=0 F  S BPMPL=$O(^AUPNPAT(BPMP,41,BPMPL)) Q:BPMPL'=+BPMPL  D
  1.  . . Q:$L($P($G(^AUPNPAT(BPMP,41,BPMPL,0)),"^",2))>0
  1.  . . D HDR(BPMP,BPMPL)
  1.  . . K ^AUPNPAT(BPMP,41,BPMPL,0)
  1.  . . S BPMCNT=BPMCNT+1
  1.  D RSLT^BPMXFIX("  *** Total Found: "_BPMCNT_" ***")
  1.  Q
  1.  ;
  1. BUILD ;
  1.  ;----- IHS/OIT/NKD BPM*1.0*2 Build TMP global for utility processing
  1.  ;
  1.  N XIEN,OIEN,BPMFR,BPMTO
  1.  K ^TMP("BPM")
  1.  S XIEN=0
  1.  F  S XIEN=$O(^XDRM(XIEN)) Q:+XIEN'=XIEN  D
  1.  . S BPMFR=$P($P(^XDRM(XIEN,0),"^",1),";"),BPMTO=$P($P(^XDRM(XIEN,0),"^",2),";")
  1.  . I '$D(^DPT(BPMFR,-9)) D RSLT("PT NOT MERGED "_BPMFR) Q
  1.  . I $G(^DPT(BPMFR,-9))'=BPMTO D RSLT("POINTING TO WRONG PATIENT "_BPMFR) Q
  1.  . I $P($G(^DPT(BPMFR,0)),"^",1)["*" D RSLT("PREVIOUS VERSION OF MERGE SKIPPED "_BPMFR) Q
  1.  . I '$D(^TMP("BPM",$J,"FROM",BPMFR)) S ^TMP("BPM",$J,"FROM",BPMFR)=XIEN,^TMP("BPM",$J,XIEN,BPMFR,BPMTO)=XIEN
  1.  . E  D
  1.  . . S OIEN=^TMP("BPM",$J,"FROM",BPMFR)
  1.  . . S ^TMP("BPM",$J,OIEN,BPMFR,BPMTO)=^TMP("BPM",$J,OIEN,BPMFR,BPMTO)_"^"_XIEN
  1.  . I '$D(^TMP("BPM",$J,"TO",BPMTO)) S ^TMP("BPM",$J,"TO",BPMTO)=BPMFR_$S($D(^TMP("BPM",$J,"TO",BPMFR)):"^"_^TMP("BPM",$J,"TO",BPMFR),1:"")
  1.  . E  S:'(^TMP("BPM",$J,"TO",BPMTO)[BPMFR) ^TMP("BPM",$J,"TO",BPMTO)=^TMP("BPM",$J,"TO",BPMTO)_"^"_BPMFR_$S($D(^TMP("BPM",$J,"TO",BPMFR)):"^"_^TMP("BPM",$J,"TO",BPMFR),1:"")
  1.  Q
  1. RSLT(%,BPMLINE) ;--- ISSUE MESSAGES DURING INSTALL/MENU
  1.  I $D(BPMMENU) D
  1.  .I $D(BPMLINE) W !!,%
  1.  .E  W !,%
  1.  I '$D(BPMMENU) D
  1.  .I $D(BPMLINE) D BMES^XPDUTL(%)
  1.  .I '$D(BPMLINE) D MES^XPDUTL(%)
  1.  Q
  1.  ;
  1. TIME(BPMSTEP,TYPE) ;
  1.  ; TIME MESSAGE DISPLAY
  1.  N STR
  1.  S STR="***** "_BPMSTEP_" "_$S(TYPE=1:"Start time: ",1:"End time: ")_$$HTE^XLFDT($H)_" *****"
  1.  I TYPE=1 D RSLT(STR,TYPE) Q
  1.  E  D RSLT(STR)
  1.  Q
  1. HDR(DFN,FAC,EIEN,HDR,ETXT,DTXT) ;EP
  1.  ; HEADER MESSAGE DISPLAY
  1.  N MSG,MSG2,MSG3,MSG4
  1.  S MSG=$J("",3)_$S($D(DTXT):DTXT_" ",1:"")_"Patient IEN: "_DFN_$J("",9-$L(DFN))
  1.  S MSG2="HRN: "_$P($G(^AUTTLOC(FAC,0)),"^",7)_" "_$$HRN(FAC,DFN)_$J("",12-$L($$HRN(FAC,DFN)))
  1.  S MSG3=$S($D(EIEN):"Entry: "_EIEN,1:"")
  1.  S MSG4=$S($D(ETXT):ETXT_"(s): ",1:"")
  1.  I $L(MSG3)>0&$L(MSG4)>0 S MSG4=MSG4_EIEN,MSG3=""
  1.  S:'$D(HDR) HDR=1
  1.  D RSLT($S(HDR:MSG_MSG2,1:$J("",$L(MSG_MSG2)))_MSG3_MSG4)
  1.  Q
  1. ENTRY(IEN,FROM,TXT) ;EP
  1.  ; MERGED ENTRY MESSAGE DISPLAY
  1.  N BPMT
  1.  S BPMT=$J("",4)_"Merging "_$S($D(TXT):TXT,1:"Entry")_" #"_IEN
  1.  D RSLT(BPMT_$J("",42-$L(BPMT))_"From PT IEN: "_FROM)
  1.  Q
  1. ENTRIES(BPMTMP) ;EP
  1.  ; MERGED ENTRIES MESSAGE DISPLAY
  1.  N BPMT,I
  1.  S BPMT=$J("",4),I=0
  1.  F  S I=$O(BPMTMP(I)) Q:$L(I)<1  D
  1.  . S BPMT=BPMT_I_$J("",12-$L(I))
  1.  . I $L(BPMT)>70 D RSLT(BPMT) S BPMT=$J("",4)
  1.  I $L(BPMT)>4 D RSLT(BPMT)
  1.  Q
  1. HIST(DFN) ;EP
  1.  ; FORWARD HISTORY OF MERGES FOR A PATIENT
  1.  Q:$L(DFN)<1 DFN
  1.  Q:'$D(^DPT(DFN,-9)) DFN
  1.  Q DFN_"^"_$$HIST(^DPT(DFN,-9))
  1. LAST(DFN) ;EP
  1.  ; LAST PATIENT IN A CHAIN OF MERGES
  1.  Q:$L(DFN)<1 DFN
  1.  Q:'$D(^DPT(DFN,-9)) DFN
  1.  Q $$LAST(^DPT(DFN,-9))
  1. BILL(BPMDUZ2,BPMCI) ;EP
  1.  ; RETURNS THE BILL # AND BILL PATIENT ASSOCIATED WITH A CLAIM
  1.  N BPMCB,BPMB
  1.  S BPMB=""
  1.  Q:'$D(^ABMDCLM(BPMDUZ2,BPMCI,65)) BPMB
  1.  S BPMCB=0 F  S BPMCB=$O(^ABMDCLM(BPMDUZ2,BPMCI,65,BPMCB)) Q:(BPMCB'=+BPMCB)!($L(BPMB)>0)  D
  1.  . Q:'$D(^ABMDBILL(BPMDUZ2,BPMCB,0))
  1.  . Q:BPMCI'=+$P(^ABMDBILL(BPMDUZ2,BPMCB,0),"^",1)
  1.  . S BPMB=$P(^ABMDBILL(BPMDUZ2,BPMCB,0),"^",5)_"^"_$P(^ABMDBILL(BPMDUZ2,BPMCB,0),"^",1)
  1.  Q BPMB
  1. VSIT(BPMDUZ2,BPMCI) ;EP
  1.  ; RETURNS THE VISIT # AND VISIT PATIENT ASSOCIATED WITH A CLAIM
  1.  N BPMCV,BPMV
  1.  S BPMV=""
  1.  Q:'$D(^ABMDCLM(BPMDUZ2,BPMCI,11)) BPMV
  1.  S BPMCV=0 F  S BPMCV=$O(^ABMDCLM(BPMDUZ2,BPMCI,11,BPMCV)) Q:(BPMCV'=+BPMCV)!($L(BPMV)>0)  D
  1.  . Q:'$D(^AUPNVSIT(BPMCV,0))
  1.  . S BPMV=$P(^AUPNVSIT(BPMCV,0),"^",5)_"^"_BPMCV
  1.  Q BPMV
  1. HRN(BPMDUZ2,BPMP) ;EP
  1.  ; RETURNS THE HRN FOR A PATIENT
  1.  Q $P($G(^AUPNPAT(BPMP,41,BPMDUZ2,0)),"^",2)
  1. MRG(BPMPAT,BPMDIR) ;EP
  1.  ; RETURNS 1 IF THE PATIENT WAS PART OF A MERGE
  1.  Q:$L(BPMPAT)<1 1
  1.  Q $S($D(^TMP("BPM",$J,BPMDIR,BPMPAT)):1,1:0)
  1. RTNS ;----- LIST OF CLEANUP ROUTINES - DISPLAY;LABEL^ROUTINE
  1.  ;;Blank HRNs;FIXAUPN^BPMXFIX
  1.  ;;iCare;BQI^BPMXFX1
  1.  ;;Problem List;PRB^BPMXFX1
  1.  ;;Word Processing;WP^BPMXFX2
  1.  ;;Lab;LAB^BPMXFX1
  1.  ;;3PB;TPB^BPMXFX1
  1.  ;;PT Taxonomy;ATX^BPMXFX1
  1.  ;;FILE #90050.02;I1^BPMXFX2
  1.  ;;FILE #9000043;I2^BPMXFX2
  1.  ;;FILE #9002274.3;I3^BPMXFX2
  1.  ;;FILE #9002274.4;I4^BPMXFX2
  1.  ;;FILE #100;V3^BPMXFX2
  1.  ;;Deleted Visits;VST^BPMXFX1
  1.  ;;EDR;EDR^BPMXFX1
  1.  ;;MPI;MPI^BPMXFX1
  1.  ;;$$END