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

BPMX3PB.m

Go to the documentation of this file. 
  1. BPMX3PB ;IHS/PHXAO/AEF - REPOINT 3P CLAIM AND BILL PATIENTS - 6/26/12 ;
  1.  ;;1.0;IHS PATIENT MERGE;**2**;MAR 01, 2010;Build 1
  1.  ;IHS/OIT/LJF 10/26/2006 routine originated from Phoenix Area Office
  1.  ;                       changed namespace from BZXM to BPM
  1.  ;IHS/OIT/NKD  6/13/2012 Removed unnecessary modifications to HRNs
  1.  ;                       Corrected re-pointing of Patient entry in
  1.  ;                       3P Claim file
  1.  ;                       Added re-index of "ADR" x-ref on 3P BILL file
  1.  ;;
  1. DESC ;----- ROUTINE DESCRIPTION
  1.  ;;BPMX3PB:
  1.  ;;THIS ROUTINE LOOPS THROUGH EACH ENTRY IN THE 3P CLAIM DATA #9002274.3
  1.  ;;AND REPOINTS THE PATIENT NAME IN FIELD .01.  IT ALSO LOOPS THROUGH
  1.  ;;THE 3P BILL #9002274.4 FILE AND REPOINTS THE PATIENT NAME IN FIELD
  1.  ;;.05. THESE NAME FIELDS ARE REPOINTED TO THE SPECIFIED VA/IHS PATIENT
  1.  ;;FILE ENTRY.
  1.  ;;
  1.  ;;THIS ROUTINE IS CALLED BY THE SPECIAL MERGE ROUTINE DRIVER - ^BPMXDRV
  1.  ;;
  1.  ;;THE IHS PATIENT MERGE SOFTWARE ENTERS AT EN LINE LABEL.  IT IS EXPECTED
  1.  ;;THAT THE FOLLOWING GLOBAL WOULD HAVE BEEN SET UP BY THE PATIENT MERGE
  1.  ;;SOFTWARE:
  1.  ;;^TMP("XDRFROM",$J,FROMIEN,TOIEN,FROMIEN_GLOBROOT,TOIEN_GLOBROOT)=FILE
  1.  ;;EXAMPLE:
  1.  ;;^TMP("XDRFROM",2804,6364,1991,"6364;DPT(","1991;DPT(")=2
  1.  ;;WHERE =2 IS THE PARENT FILE (VA PATIENT FILE).
  1.  ;;
  1.  ;;$$END
  1.  ;
  1.  N I,X F I=1:1 S X=$P($T(DESC+I),";;",2) Q:X["$$END"  W !,X
  1.  Q
  1.  ;
  1. EN(BPMRY) ;EP
  1.  ;----- MAIN ENTRY POINT FROM DUPLICATE PATIENT MERGE SOFTWARE
  1.  ;
  1.  ;      BPMRY  =  TEMP GLOBAL SET UP BY THE PATIENT MERGE SOFTWARE,
  1.  ;                 I.E., "^TMP(""XDFROM"",$J)"
  1.  ;
  1.  N BPM41,BPMFR,BPMTO
  1.  ;
  1.  S BPMFR=$O(@BPMRY@(0))
  1.  Q:'BPMFR
  1.  S BPMTO=$O(@BPMRY@(BPMFR,0))
  1.  Q:'BPMTO
  1.  ;
  1.  ;D ACT1(BPMTO,.BPM41)  ;IHS/OIT/NKD BPM*1.0*2 REMOVED UNNECESSARY HRN EDITS
  1.  D CLAIM(BPMFR,BPMTO)
  1.  D BILL(BPMFR,BPMTO)
  1.  ;D ACT2(BPMTO,.BPM41)  ;IHS/OIT/NKD BPM*1.0*2 REMOVED UNNECESSARY HRN EDITS
  1.  ;
  1.  Q
  1. CLAIM(BPMFR,BPMTO) ;
  1.  ;----- REPOINT 3P CLAIM DATA PATIENTS
  1.  ;
  1.  N BPMD0,BPMDUZ2
  1.  ;
  1.  S BPMDUZ2=0
  1.  F  S BPMDUZ2=$O(^ABMDCLM(BPMDUZ2)) Q:'BPMDUZ2  D
  1.  . S BPMD0=0
  1.  . F  S BPMD0=$O(^ABMDCLM(BPMDUZ2,"B",BPMFR,BPMD0)) Q:'BPMD0  D
  1.  . . Q:$P($G(^ABMDCLM(BPMDUZ2,BPMD0,0)),U)'=BPMFR
  1.  . . D ONECLAIM(BPMDUZ2,BPMD0,BPMTO)
  1.  Q
  1. ONECLAIM(BPMDUZ2,BPMD0,BPMTO) ;
  1.  ;----- REPOINT ONE CLAIM
  1.  ;
  1.  N BPMDUZ,FDA
  1.  N DIC,XDRMRG,DIE,DA,DR
  1.  ;
  1.  S BPMDUZ(2)=DUZ(2)
  1.  S DUZ(2)=BPMDUZ2   ;sets DUZ(2) because xref on .01 field requires it
  1.  ;IHS/OIT/NKD BPM*1.0*2 USING DBS CALLS TO ENSURE PROPER EDIT - START OLD CODE
  1.  ;I '$D(AUPNPAT(BPMTO,41,DUZ(2))) D
  1.  ;. S ^AUPNPAT(BPMTO,41,DUZ(2),0)=DUZ(2)
  1.  ;S DIC(0)=$G(DIC(0))_"I"
  1.  ;S XDRMRG=1
  1.  ;S DIE="^ABMDCLM("_DUZ(2)_","
  1.  ;S DA=BPMD0
  1.  ;S DR=".01///^S X=BPMTO"
  1.  ;K DD,DO
  1.  ;D ^DIE
  1.  ;IHS/OIT/NKD BPM*1.0*2 END OLD CODE
  1.  S FDA(9002274.3,BPMD0_",",.01)=BPMTO
  1.  D UPDATE^DIE(,"FDA",)
  1.  ;
  1.  S DUZ(2)=BPMDUZ(2)  ;resetting DUZ(2) back to original value
  1.  ;
  1.  Q
  1. BILL(BPMFR,BPMTO) ;
  1.  ;----- REPOINT 3P BILL PATIENTS
  1.  ;
  1.  N BPMD0,BPMDUZ2
  1.  ;
  1.  S BPMDUZ2=0
  1.  F  S BPMDUZ2=$O(^ABMDBILL(BPMDUZ2)) Q:'BPMDUZ2  D
  1.  . S BPMD0=0
  1.  . F  S BPMD0=$O(^ABMDBILL(BPMDUZ2,"D",BPMFR,BPMD0)) Q:'BPMD0  D
  1.  . . Q:$P($G(^ABMDBILL(BPMDUZ2,BPMD0,0)),U,5)'=BPMFR
  1.  . . D ONEBILL(BPMDUZ2,BPMD0,BPMTO)
  1.  Q
  1. ONEBILL(BPMDUZ2,BPMD0,BPMTO) ;
  1.  ;----- REPOINT ONE BILL
  1.  ;
  1.  N BPMDUZ,DA,DIE,DR,X,Y
  1.  ;
  1.  S BPMDUZ(2)=DUZ(2)
  1.  S DUZ(2)=BPMDUZ2   ;sets DUZ(2) because xref on .05 field requires it
  1.  S DIE="^ABMDBILL("_DUZ(2)_","
  1.  S DA=BPMD0
  1.  S DR=".05////"_BPMTO
  1.  D ^DIE
  1.  ;
  1.  ;IHS/OIT/NKD BPM*1.0*2 RE-INDEX "ADR" X-REF
  1.  S DA=BPMD0
  1.  S X=$$GET1^DIQ(9002274.4,DA,.71,"I")
  1.  X ^DD(9002274.4,.71,1,2,2)
  1.  X ^DD(9002274.4,.71,1,2,1)
  1.  ;
  1.  S DUZ(2)=BPMDUZ(2)  ;resetting DUZ(2) back to original value
  1.  Q
  1. ACT1(D0,BPM41) ;
  1.  ;----- MAKE SURE ALL HRNS IN IHS PATIENT FILE ARE ACTIVE FOR MERGE TO
  1.  ;      OCCUR
  1.  ;
  1.  N D1,X
  1.  ;
  1.  S D1=0
  1.  F  S D1=$O(^AUPNPAT(D0,41,D1)) Q:'D1  D
  1.  . S X=$G(^AUPNPAT(D0,41,D1,0))
  1.  . S BPM41(D0,41,D1,0)=X
  1.  . S ^AUPNPAT(D0,41,D1,0)=$P(X,U,1,2)
  1.  Q
  1. ACT2(D0,BPM41) ;
  1.  ;----- PUT ALL HRNS BACK THE WAY THEY WERE BEFORE THE MERGE
  1.  ;
  1.  N D1
  1.  ;
  1.  Q:'$D(BPM41(D0))
  1.  S D1=0
  1.  F  S D1=$O(BPM41(D0,41,D1)) Q:'D1  D
  1.  . S ^AUPNPAT(D0,41,D1,0)=BPM41(D0,41,D1,0)
  1.  Q