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

AUMXPORT.m

Go to the documentation of this file. 
  1. AUMXPORT ;IHS/OIT/NKD - MARK PT'S FOR REG EXPORT 05/23/2012 ; 
  1.  ;;12.0;TABLE MAINTENANCE;**3**;SEP 27,2011;Build 1
  1.  ;
  1.  ;10.1;TABLE MAINTENANCE;**1**;OCT 16, 2009
  1.  ;IHS/SET/GTH AUM*3.1*4 12/02/2002 - Communities dif Area same name.
  1.  Q
  1.  ;
  1.  ; ----------------------------------------------------------------
  1.  ;
  1. SETUP ;
  1.  ;Begin New Code;IHS/SET/GTH AUM*3.1*4 12/02/2002
  1.  I '$D(ZTQUEUED) D
  1.  . ;W !,"Checking Patients for Export...",!,"NOTE:  Inactive Patients are no longer exported.",!,"       CURRENT COMMUNITY for Patients will be updated if",!,"       a Community's NAME changed."
  1.  . W !,"Checking Patients for Export..."     ;AUM*9.1*4 IHS/OIT/FCJ CHG ABOVE LINE
  1.  . D WAIT^DICD
  1.  .Q
  1.  ;End New Code;IHS/SET/GTH AUM*3.1*4 12/02/2002
  1.  D NOW^%DTC
  1.  S N=%
  1.  S W="W:'$D(ZTQUEUED) ""."""
  1.  ;I '$D(ZTQUEUED) W !,"Checking Patients for Export...",!,"NOTE:  Inactive Patients are no longer exported." D WAIT^DICD;IHS/SET/GTH AUM*3.1*4 12/02/2002
  1.  Q
  1.  ;
  1.  ; ----------------------------------------------------------------
  1.  ;
  1. COMMMOD(FROM,TO) ;EP - SET ^AGPATCH for Community Code Changes.
  1.  ;
  1.  ;  SET ^AGPATCH(NOW,DUZ(2),DFN)="" for a changed community.
  1.  ;  The above was confirmed and agreed upon with the owner of
  1.  ;  ^AGPATCH (Registration).
  1.  ;
  1.  ;  Patients are not marked if the only change is to Name of Community.
  1.  ;  Inactivated patients are not marked.
  1.  ;
  1.  ;  AUMRTN is the name of the routine containing the Community
  1.  ;  Code changes, usually named in the form "AUM"_vv_pp_"A",
  1.  ;  where vv is the last 2 digits of the version of AUM, and pp
  1.  ;  is the patch number.
  1.  ;
  1.  NEW D,DFN,L,N,T,W
  1.  ;
  1.  ; D = Site DUZ(2).
  1.  ; L = Name of the community being processed.
  1.  ; FROM = "FROM" string.
  1.  ; TO = "TO" string.
  1.  ; N = NOW
  1.  ; T = Counter
  1.  ; W = Write dot if not q'd.
  1.  ;
  1.  D SETUP
  1.  ;
  1.  X W
  1.  ;I $P(FROM,U,1,3)=$P(TO,U,1,3),$P(FROM,U,5,6)=$P(TO,U,5,6) Q;IHS/SET/GTH AUM*3.1*4 12/02/2002
  1.  I $P(FROM,U,1,3)=$P(TO,U,1,3),$P(FROM,U,5,6)=$P(TO,U,5,6) D COMNAM($P(FROM,U,4),$TR($P(TO,U,1,3),"^")) Q 0 ;IHS/SET/GTH AUM*3.1*4 12/02/2002
  1.  S L=$P(TO,U,4),DFN=0
  1.  F  S DFN=$O(^AUPNPAT("AC",L,DFN)) Q:'DFN  D
  1.  . X W
  1.  . ;S D=$O(^AUPNPAT(DFN,41,0));IHS/SET/GTH AUM*3.1*4 12/02/2002
  1.  . ;X W;IHS/SET/GTH AUM*3.1*4 12/02/2002
  1.  . ;I D,'$$INAC(DFN,D) S ^AGPATCH(N,D,DFN)="";IHS/SET/GTH AUM*3.1*4 12/02/2002
  1.  . I $$ACT(DFN),$$COM(DFN,$TR($P(TO,U,1,3),"^")) S ^AGPATCH(N,$P($$ACT(DFN),U,2),DFN)="" ;IHS/SET/GTH AUM*3.1*4 12/02/2002
  1.  ; --- If the Name changed, use the old name, too, since the
  1.  ; --- CURRENT COMMUNITY field in PATIENT is free text, and
  1.  ; --- doubtful to be updated.
  1.  I $P(FROM,U,4)'=$P(TO,U,4) S L=$P(FROM,U,4),DFN=0 D
  1.  . F  S DFN=$O(^AUPNPAT("AC",L,DFN)) Q:'DFN  D
  1.  .. X W
  1.  .. ;S D=$O(^AUPNPAT(DFN,41,0));IHS/SET/GTH AUM*3.1*4 12/02/2002
  1.  .. ;X W;IHS/SET/GTH AUM*3.1*4 12/02/2002
  1.  .. ;I D,'$$INAC(DFN,D) S ^AGPATCH(N,D,DFN)="";IHS/SET/GTH AUM*3.1*4 12/02/2002
  1.  .. I $$ACT(DFN),$$COM(DFN,$TR($P(TO,U,1,3),"^")) S ^AGPATCH(N,$P($$ACT(DFN),U,2),DFN)="" ;IHS/SET/GTH AUM*3.1*4 12/02/2002
  1.  ..Q
  1.  . D COMNAM($P(FROM,U,4),$TR($P(TO,U,1,3),"^")) ;IHS/SET/GTH AUM*3.1*4 12/02/2002
  1.  G COUNT
  1.  ;
  1.  ; ----------------------------------------------------------------
  1.  ;
  1. LOCMOD(FROM,TO) ;EP - SET ^AGPATCH for Location Code Changes.
  1.  ;  See Community Code documentation.
  1.  ;
  1.  NEW D,DFN,L,N,T,W
  1.  ;
  1.  D SETUP
  1.  ;
  1.  KILL ^TMP("AUMXPORT",$J)
  1.  ;
  1.  X W
  1.  I $P(FROM,U,1,3)=$P(TO,U,1,3) Q 0
  1.  S L=$P(TO,U,1,3),L=$TR(L,"^",""),D=$O(^AUTTLOC("C",L,0))
  1.  I D S ^TMP("AUMXPORT",$J,D)=""
  1.  ;
  1.  S %="^AUPNPAT(""D"",0,0,0)"
  1.  F  S %=$Q(@%) Q:'$L(%)  D
  1.  .X:'((+$P(%,",",3))#1000) W
  1.  .I $D(^TMP("AUMXPORT",$J,+$P(%,",",4))),'$$INAC(+$P(%,",",3),+$P(%,",",4)) S ^AGPATCH(N,+$P(%,",",4),+$P(%,",",3))=""
  1.  ;
  1.  KILL ^TMP("AUMXPORT",$J)
  1.  ;
  1.  G COUNT
  1.  ;
  1.  ; ----------------------------------------------------------------
  1.  ;
  1.  ;
  1. CLINMOD(AUMRTN) D SETUP G COUNT ; Not used as of Sep 2002.
  1.  ; ----------------------------------------------------------------
  1. CNTYMOD(AUMRTN) D SETUP G COUNT ; Not used as of Sep 2002.
  1.  ; ----------------------------------------------------------------
  1. RESMOD(AUMRTN) D SETUP G COUNT ; Not used as of Sep 2002.
  1.  ; ----------------------------------------------------------------
  1. TRIBMOD(AUMRTN) D SETUP G COUNT ; Not used as of Sep 2002.
  1.  ; ----------------------------------------------------------------
  1.  ;
  1. COUNT ; Return the number of patients marked for export because of change.
  1.  ; All EPs come here.
  1.  ; T is what gets returned, regardless of entry point.
  1.  S (D,T)=0
  1.  F  S D=$O(^AGPATCH(N,D)) Q:'D  D
  1.  . X W
  1.  . S DFN=0
  1.  . F  S DFN=$O(^AGPATCH(N,D,DFN)) Q:'DFN  X W S T=T+1
  1.  Q T
  1.  ;
  1. ALL() ; W $$ALL^AUMXPORT() to mark all active Pts for export.
  1.  NEW D,DFN,L,N,T,W
  1.  D SETUP
  1.  S DFN=0,L=$P(^AUPNPAT(0),U,3)
  1.  W:'$D(ZTQUEUED) !
  1.  S DX=$X,DY=$Y
  1.  F  S DFN=$O(^AUPNPAT(DFN)) Q:'DFN  D
  1.  . Q:'$D(^DPT(DFN))
  1.  . S D=0
  1.  . F  S D=$O(^AUPNPAT(DFN,41,D)) Q:'D  I '$$INAC(DFN,D) S ^AGPATCH(N,D,DFN)=""
  1.  . I '(DFN#100),'$D(ZTQUEUED) X IOXY W "On IEN ",DFN," of ",L," in ^AUPNPAT(..."
  1.  .Q
  1.  ;
  1.  W:'$D(ZTQUEUED) !!,"If you change your mind, you need to KILL ^AGPATCH(",N,").",!!
  1.  S DX=$X,DY=$Y,W=$S('$D(ZTQUEUED):"X IOXY W ""Counting..."",T",1:"")
  1.  G COUNT
  1.  ;
  1. INAC(DFN,D) ; Pt is inactive if inactive date, or status is Deleted or Inactive.
  1.  ;
  1.  I $P($G(^AUPNPAT(DFN,41,D,0)),U,3) Q 1 ; Inactive Date
  1.  I '$L($P($G(^AUPNPAT(DFN,41,D,0)),U,5)) Q 0
  1.  I "DI"[$P($G(^AUPNPAT(DFN,41,D,0)),U,5) Q 1 ; Deleted or Inactive
  1.  Q 0
  1.  ;
  1.  ;Begin New Code;IHS/SET/GTH AUM*3.1*4 12/02/2002
  1. COM(DFN,AUMCC) ; Is Current Res for DFN the same as the Community changed?
  1.  ;
  1.  NEW D,FROM,L,N,T,TO,W
  1.  ;
  1.  Q:$$COMMRES^AUPNPAT(DFN)=AUMCC 1
  1.  Q 0
  1.  ;
  1. ACT(DFN) ; Pt is Active if at least one ORF HRN is not Inactive AND not Deleted.
  1.  ;
  1.  NEW A,D
  1.  ;
  1.  S (A,D)=0
  1.  F  S D=$O(^AUPNPAT(DFN,41,D)) Q:'D  D  Q:A
  1.  . Q:'$D(^AGFAC("AC",D,"Y"))  ; Not an ORF.
  1.  . Q:$P($G(^AUPNPAT(DFN,41,D,0)),U,3)  ; Inactive Date
  1.  . I $L($P($G(^AUPNPAT(DFN,41,D,0)),U,5)),"DI"[$P(^(0),U,5) Q  ; Deleted or Inactive
  1.  . S A=1_U_D ; Got one.  Pt is Active at an ORF.
  1.  .Q
  1.  Q A
  1.  ;
  1. COMNAM(AUMCNAME,AUMSCC) ;Community NAME changed.  Update CURRENT COMMUNITY.
  1.  ;
  1.  ; AUMCNAME = OLD Community Name.
  1.  ; AUMSCC = NEW Community Sta/County/Code, since it's been updated.
  1.  ;
  1.  ; Find all Pts with a CURRENT COMMUNITY name of the OLD value,
  1.  ; and update the free text CURRENT COMMUNITY.
  1.  ;
  1.  NEW D,FROM,L,N,T,TO,W,DA,DIE,DR
  1.  ;
  1.  S DA=0,DIE=9000001
  1.  F  S DA=$O(^AUPNPAT("AC",AUMCNAME,DA)) Q:'DA  D
  1.  . W:'$D(ZTQUEUED) "."
  1.  . Q:'$$COM(DA,AUMSCC)  ; Quit if not CurrComm for Pt.
  1.  . S DR="1118///"_$$GET1^DIQ(9000001,DA,1117)
  1.  . D ^DIE
  1.  .Q
  1.  Q
  1.  ;End New Code;IHS/SET/GTH AUM*3.1*4 12/02/2002