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

BPMXTAX.m

Go to the documentation of this file.
  1. BPMXTAX ;IHS/PHXAO/AEF - REPOINT PT TAXONOMY FILE POINTERS - 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. ;
  1. DESC ;----- ROUTINE DESCRIPTION
  1. ;;
  1. ;;BPMXTAX:
  1. ;;THIS ROUTINE LOOPS THROUGH EACH ENTRY IN THE PATIENT SUBFILE
  1. ;;OF THE PT TAXONOMY FILE AND REPOINTS THE NAME FIELD TO THE
  1. ;;SPECIFIED VA PATIENT 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 U PBY 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. ;;
  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. 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 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 REPOINT(BPMFR,BPMTO)
  1. Q
  1. REPOINT(BPMFR,BPMTO) ;EP
  1. ;----- FIND AND REPOINT POINTERS
  1. ;
  1. N BPMD0,BPMD1
  1. ;
  1. S BPMD0=0
  1. F S BPMD0=$O(^ATXPAT(BPMD0)) Q:'BPMD0 D
  1. . S BPMD1=0
  1. . F S BPMD1=$O(^ATXPAT(BPMD0,11,BPMD1)) Q:'BPMD1 D
  1. . . Q:$P($G(^ATXPAT(BPMD0,11,BPMD1,0)),U)'=BPMFR
  1. . . D ONE(BPMD0,BPMD1,BPMFR,BPMTO)
  1. ;
  1. Q
  1. ONE(BPMD0,BPMD1,BPMFR,BPMTO) ;
  1. ;----- PROCESS ONE ENTRY
  1. ;
  1. N BPMCNT,DA,DD,DIC,DIE,DIK,DINUM,DO,DR,X,Y,BPM02P2
  1. ;
  1. S BPMCNT=$P($G(^ATXPAT(BPMD0,11,BPMFR,0)),U,2)+$P($G(^ATXPAT(BPMD0,11,BPMTO,0)),U,2)
  1. ;
  1. S DA(1)=BPMD0
  1. S DA=BPMD1
  1. S DIK="^ATXPAT("_DA(1)_",11,"
  1. D ^DIK
  1. ;
  1. I '$D(^ATXPAT(BPMD0,11,BPMTO)) D
  1. . S DIC="^ATXPAT("_DA(1)_",11,"
  1. . S DIC(0)=""
  1. . S X=BPMTO
  1. . S DINUM=X
  1. . K DD,DO
  1. . D FILE^DICN
  1. ;
  1. Q:'$D(^ATXPAT(BPMD0,11,BPMTO))
  1. ;
  1. S BPM02P2=$P($G(^DD(9002227.01101,.02,0)),U,2)
  1. S $P(^DD(9002227.01101,.02,0),U,2)=$TR(BPM02P2,"I","")
  1. ;
  1. S DA=BPMTO
  1. S DIE="^ATXPAT("_DA(1)_",11,"
  1. S DR=".02///"_BPMCNT
  1. D ^DIE
  1. ;
  1. S $P(^DD(9002227.01101,.02,0),U,2)=BPM02P2
  1. ;
  1. Q