- 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
