AGACXREF ; IHS/ASDS/EFG - DELETE AND REBUILD THE AC (CURRENT COMMUNITY) X-REF, STUFF CUR COMM FIELD ;
;;7.1;PATIENT REGISTRATION;;AUG 25,2005
;
W $$S^AGVDF("IOF"),!
W ?30,"*** AGACXREF ***",!
W ?5,"=== CURRENT COMMUNITY (AC) and TRIBE OF MEMBERSHIP indices ==="
W *7,!!,"Because of a bug in IHS REGISTRATION v 4.22, the 'AC' cross-reference",!
W "of the Patient file was set only when a patient was edited, not when the",!
W "patient was first entered."
W !!,"This routine will kill and rebuild the 'AC' (Current Community) and 'AE'",!
W "(Tribe of Membership) cross-references on the PATIENT File (^AUPNPAT).",!!
W "It will also reset the Current Community field from LAST(PREVIOUS COMMUNITY)."
W !!,"It should take approximately ",$J(1244/36277*+$P(^AUPNPAT(0),U,4)/60,3,1)," minutes to complete",!
W "on your ",+$P(^AUPNPAT(0),U,4)," patients.",!!
W "Q'ing to TaskMan is possible."
;
K DIR,DTOUT,DUOUT,DFOUT,DQOUT,DIRUT,DIROUT,DLOUT
S DIR(0)="Y"
S DIR("A")="Do you want to continue? (Y/N) "
W !!
D ^DIR
I Y=0 W *7,!!,"Please 'D ^AGACXREF' at your convenience." Q
QUE ;
K DIR,DTOUT,DUOUT,DFOUT,DQOUT,DIRUT,DIROUT,DLOUT
S DIR(0)="Y"
W !!
S DIR("A")="Do you want to q this process? "
S DIR("B")="YES"
D ^DIR
G END:$D(DTOUT)!(Y["^") ; EXIT IF TIME OUT OR ^
G ENTRY:Y=0 ; RUN THE XREF NOW
DEV ;
X ^%ZOSF("UCI")
S ZTRTN="ENTRY^AGACXREF"
S ZTUCI=Y
S ZTIO=""
S ZTDESC="Rebuild PATIENT AC index, for "_$P(^AUTTLOC(DUZ(2),0),U,2)_"."
S ZTSAVE=""
D ^%ZTLOAD G:'$D(ZTSK) QUE W !!,"Task Number = ",ZTSK,!!,"Press RETURN..." R Y:DTIME K AG,AGIO,AGQIO,G,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZTUCI D ^%ZISC Q
ENTRY ;EP - TaskMan.
I '$D(ZTQUEUED) W ! S IOP=ION D ^%ZIS,WAIT^DICD W !,+$P(^AUPNPAT(0),U,4)," patients.",! S DX=$X,DY=$Y+1
K ^AUPNPAT("AC"),^("AE") F DFN=0:0 S DFN=$O(^AUPNPAT(DFN)) Q:DFN'=+DFN D C1,AE
END K AGCC,AGCCSV,AGCCPTR,AGCCNAME,DFN,DX,DY,X,XY,Y
D:$D(ZTQUEUED) KILL^%ZTLOAD
Q
C1 ;
F AGCC=0:0 S AGCC=$O(^AUPNPAT(DFN,51,AGCC)) Q:AGCC'=+AGCC S AGCCSV=AGCC
Q:'$D(^AUPNPAT(DFN,51,AGCCSV,0))
S AGCCPTR=$P($G(^AUPNPAT(DFN,51,AGCC,0)),U,3) Q:AGCCPTR=""
Q:'$D(^AUTTCOM(AGCCPTR,0))
S AGCCNAME=$P($G(^AUTTCOM(AGCCPTR,0)),U) Q:AGCCNAME=""
S $P(^AUPNPAT(DFN,11),U,18)=AGCCNAME,^AUPNPAT("AC",AGCCNAME,DFN)=""
Q
AE I $D(^AUPNPAT(DFN,11)),$P(^(11),U,8)]"" S ^AUPNPAT("AE",$P(^AUPNPAT(DFN,11),U,8),DFN)=""
Q
AGACXREF ; IHS/ASDS/EFG - DELETE AND REBUILD THE AC (CURRENT COMMUNITY) X-REF, STUFF CUR COMM FIELD ;
+1 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
+2 ;
+3 WRITE $$S^AGVDF("IOF"),!
+4 WRITE ?30,"*** AGACXREF ***",!
+5 WRITE ?5,"=== CURRENT COMMUNITY (AC) and TRIBE OF MEMBERSHIP indices ==="
+6 WRITE *7,!!,"Because of a bug in IHS REGISTRATION v 4.22, the 'AC' cross-reference",!
+7 WRITE "of the Patient file was set only when a patient was edited, not when the",!
+8 WRITE "patient was first entered."
+9 WRITE !!,"This routine will kill and rebuild the 'AC' (Current Community) and 'AE'",!
+10 WRITE "(Tribe of Membership) cross-references on the PATIENT File (^AUPNPAT).",!!
+11 WRITE "It will also reset the Current Community field from LAST(PREVIOUS COMMUNITY)."
+12 WRITE !!,"It should take approximately ",$JUSTIFY(1244/36277*+$PIECE(^AUPNPAT(0),U,4)/60,3,1)," minutes to complete",!
+13 WRITE "on your ",+$PIECE(^AUPNPAT(0),U,4)," patients.",!!
+14 WRITE "Q'ing to TaskMan is possible."
+15 ;
+16 KILL DIR,DTOUT,DUOUT,DFOUT,DQOUT,DIRUT,DIROUT,DLOUT
+17 SET DIR(0)="Y"
+18 SET DIR("A")="Do you want to continue? (Y/N) "
+19 WRITE !!
+20 DO ^DIR
+21 IF Y=0
WRITE *7,!!,"Please 'D ^AGACXREF' at your convenience."
QUIT
QUE ;
+1 KILL DIR,DTOUT,DUOUT,DFOUT,DQOUT,DIRUT,DIROUT,DLOUT
+2 SET DIR(0)="Y"
+3 WRITE !!
+4 SET DIR("A")="Do you want to q this process? "
+5 SET DIR("B")="YES"
+6 DO ^DIR
+7 ; EXIT IF TIME OUT OR ^
IF $DATA(DTOUT)!(Y["^")
GOTO END
+8 ; RUN THE XREF NOW
IF Y=0
GOTO ENTRY
DEV ;
+1 XECUTE ^%ZOSF("UCI")
+2 SET ZTRTN="ENTRY^AGACXREF"
+3 SET ZTUCI=Y
+4 SET ZTIO=""
+5 SET ZTDESC="Rebuild PATIENT AC index, for "_$PIECE(^AUTTLOC(DUZ(2),0),U,2)_"."
+6 SET ZTSAVE=""
+7 DO ^%ZTLOAD
IF '$DATA(ZTSK)
GOTO QUE
WRITE !!,"Task Number = ",ZTSK,!!,"Press RETURN..."
READ Y:DTIME
KILL AG,AGIO,AGQIO,G,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZTUCI
DO ^%ZISC
QUIT
ENTRY ;EP - TaskMan.
+1 IF '$DATA(ZTQUEUED)
WRITE !
SET IOP=ION
DO ^%ZIS
DO WAIT^DICD
WRITE !,+$PIECE(^AUPNPAT(0),U,4)," patients.",!
SET DX=$X
SET DY=$Y+1
+2 KILL ^AUPNPAT("AC"),^("AE")
FOR DFN=0:0
SET DFN=$ORDER(^AUPNPAT(DFN))
IF DFN'=+DFN
QUIT
DO C1
DO AE
END KILL AGCC,AGCCSV,AGCCPTR,AGCCNAME,DFN,DX,DY,X,XY,Y
+1 IF $DATA(ZTQUEUED)
DO KILL^%ZTLOAD
+2 QUIT
C1 ;
+1 FOR AGCC=0:0
SET AGCC=$ORDER(^AUPNPAT(DFN,51,AGCC))
IF AGCC'=+AGCC
QUIT
SET AGCCSV=AGCC
+2 IF '$DATA(^AUPNPAT(DFN,51,AGCCSV,0))
QUIT
+3 SET AGCCPTR=$PIECE($GET(^AUPNPAT(DFN,51,AGCC,0)),U,3)
IF AGCCPTR=""
QUIT
+4 IF '$DATA(^AUTTCOM(AGCCPTR,0))
QUIT
+5 SET AGCCNAME=$PIECE($GET(^AUTTCOM(AGCCPTR,0)),U)
IF AGCCNAME=""
QUIT
+6 SET $PIECE(^AUPNPAT(DFN,11),U,18)=AGCCNAME
SET ^AUPNPAT("AC",AGCCNAME,DFN)=""
+7 QUIT
AE IF $DATA(^AUPNPAT(DFN,11))
IF $PIECE(^(11),U,8)]""
SET ^AUPNPAT("AE",$PIECE(^AUPNPAT(DFN,11),U,8),DFN)=""
+1 QUIT
