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