- PXDELFIX ;BAY/RJV-CLEAN ENCOUNTERS POINTING TO VISITS THAT DON'T EXIST PART 2. ;14-JUN-2005
- ;;1.0;PCE;**153**;14-JUL-2004
- Q
- ;**********************************************************
- ;Two entry points. FIXALL and FIXIND. Called from PXDELENC.
- ;**********************************************************
- FIXALL ; Fix all encounters.
- N DA,DIK,PXPAT,PXSDATE,PXENC,PXSEC,PXCOUNT,PXPATNM,Y
- S PXPAT="",PXSDATE="",PXENC=""
- S PXCOUNT=$G(^XTMP("PXDELENC","PXENC","PXCOUNT"))
- I PXCOUNT=0 D Q
- .W !!,"There are no build entries to correct!"
- .D WAIT^PXDELENC
- I $G(^XTMP("PXDELENC","END BUILD"))="RUNNING" D Q
- .W !!,"Build is running, please wait until complete!"
- .D WAIT^PXDELENC
- W !!,"There are "_$G(PXCOUNT)_" entries to correct."
- S DIR("A")="Do you wish to continue? "
- S DIR(0)="Y",DIR("B")="YES"
- D ^DIR Q:$D(DIRUT)
- Q:Y=0
- K DIR,DA,DIRUT
- F S PXPAT=$O(^XTMP("PXDELENC","PXENC",PXPAT)) Q:PXPAT="" D
- .F S PXSDATE=$O(^XTMP("PXDELENC","PXENC",PXPAT,PXSDATE)) Q:PXSDATE="" D
- ..F S PXENC=$O(^XTMP("PXDELENC","PXENC",PXPAT,PXSDATE,PXENC)) Q:PXENC="" D
- ...S PXSEC=$G(^XTMP("PXDELENC","PXENC",PXPAT,PXSDATE,PXENC))
- ...S PXPATNM=$P($G(^DPT(PXPAT,0)),"^",1)
- ...S $P(^DPT(PXPAT,"S",PXSDATE,0),"^",2)="NT"
- ...S $P(^DPT(PXPAT,"S",PXSDATE,0),"^",20)=""
- ...S DIK="^SCE(",DA=PXENC D ^DIK
- ...I $G(PXSEC)'="" S DIK="^SCE(",DA=PXSEC D ^DIK
- ...S PXCOUNT=PXCOUNT-1
- ...K ^XTMP("PXDELENC","PXENC",PXPAT,PXSDATE,PXENC)
- ...W !!,?3,"Encounter: ",?12,$G(PXENC)_" - "_$G(PXPATNM),?45," Fixed!",!
- ...S DA=PXPAT D FIXIHS
- S ^XTMP("PXDELENC","PXENC","PXCOUNT")=PXCOUNT
- D WAIT^PXDELENC
- Q
- FIXIND ; Fix individual encounters.
- N PXPAT,PXSDATE,PXSDTE,PXENC,PXVISIT,PXPRIM,PXEXIST,PXCOUNT,DIC,PXSEC,Y
- I $G(^XTMP("PXDELENC","END BUILD"))="RUNNING" D Q
- .W !!,"Build is running, please wait until complete!"
- .D WAIT^PXDELENC
- S DIC(0)="AEMQ"
- D ^DPTLK I Y=-1 Q
- Q:$D(DIRUT)
- S PXPAT=$P(Y,"^")
- S PXSDATE=0,PXENC="",PXPRIM="",PXSEC="",PXEXIST=0
- S PXCOUNT=$G(^XTMP("PXDELENC","PXENC","PXCOUNT"))
- W !!,"Processing...."
- D HEADER
- DISPLAY ;
- F S PXSDATE=$O(^SCE("ADFN",PXPAT,PXSDATE)) Q:PXSDATE=""!($D(DIRUT)) D Q:$D(DIRUT)
- .F S PXENC=$O(^SCE("ADFN",PXPAT,PXSDATE,PXENC)) Q:PXENC=""!($D(DIRUT)) D
- ..S PXVISIT=$P($G(^SCE(PXENC,0)),"^",5)
- ..S PXPRIM=$P($G(^SCE(PXENC,0)),"^",6)
- ..I $G(PXVISIT)'="" Q
- ..I $G(PXPRIM)'="" Q
- ..I $G(PXVISIT)="",$G(PXPRIM)="",$D(^DPT(PXPAT,"S",PXSDATE,0)) D
- ...S Y=PXSDATE D DD^%DT S PXSDTE=Y,PXEXIST=1
- ...S PXPATNM=$P($G(^DPT(PXPAT,0)),"^",1)
- ...W ?3,PXPAT_" - "_PXPATNM,?35,PXSDTE,?55,PXENC,!
- ...S ^XTMP("PXDELENC","FIXIND",PXPAT,PXSDATE,PXENC)=""
- I $G(PXEXIST)=0 G NONE
- S DIR("A")="This will fix all entries for this Patient. Continue? "
- S DIR(0)="Y",DIR("B")="YES"
- D ^DIR
- G:$D(DIRUT) FIXIND
- K DIR,DA,DIRUT
- I Y=0 G FIXIND
- FIX ;
- N PXPAT,PXSDTE,PXENC
- S PXPAT="",PXSDTE="",PXENC=""
- F S PXPAT=$O(^XTMP("PXDELENC","FIXIND",PXPAT)) Q:PXPAT="" D
- .F S PXSDTE=$O(^XTMP("PXDELENC","FIXIND",PXPAT,PXSDTE)) Q:PXSDTE="" D
- ..F S PXENC=$O(^XTMP("PXDELENC","FIXIND",PXPAT,PXSDTE,PXENC)) Q:PXENC="" D
- ...S $P(^DPT(PXPAT,"S",PXSDTE,0),"^",20)=""
- ...S $P(^DPT(PXPAT,"S",PXSDTE,0),"^",2)="NT"
- ...I $P($G(^SCE(PXENC+1,0)),"^",6)=PXENC S PXSEC=PXENC+1
- ...S DIK="^SCE(",DA=PXENC D ^DIK
- ...I $G(PXSEC)'="" S DIK="^SCE(",DA=PXSEC D ^DIK
- ...I $D(^XTMP("PXDELENC","PXENC",PXPAT,PXSDTE,PXENC)) S PXCOUNT=PXCOUNT-1
- ...K ^XTMP("PXDELENC","PXENC",PXPAT,PXSDTE,PXENC)
- ...K ^XTMP("PXDELENC","FIXIND",PXPAT,PXSDTE,PXENC)
- ...W !!,?3,"Encounter: ",?12,$G(PXENC)_" - "_$G(PXPATNM),?45," Fixed!",!
- ...S DA=PXPAT D FIXIHS
- S ^XTMP("PXDELENC","PXENC","PXCOUNT")=PXCOUNT
- Q:$D(DIRUT)
- I PXEXIST=1 D
- .W !!,"No more missing visits to correct for this patient!"
- .D WAIT^PXDELENC
- NONE ;
- I PXEXIST=0 D
- .W !!,"No missing visits found for this patient!"
- .D WAIT^PXDELENC
- K ^XTMP("PXDELENC","FIXIND")
- G FIXIND
- Q
- W !,?3,"Patient IEN - Name",?35,"Appt Date",?55,"Encounter"
- W !,?3,"==================",?35,"=========",?55,"=========",!
- Q
- FIXIHS ; Will fix the IHS Patient (9000001) file entries.
- N PX
- S U="^"
- D CHECK^PXXDPT Q:'$T
- S PX=$P($G(^DPT(DA,0)),U,9)
- D SETSSN^PXXDPT
- K DR,DIE,DA,PXDA
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXDELFIX 4250 printed Feb 18, 2025@23:54:55 Page 2
- PXDELFIX ;BAY/RJV-CLEAN ENCOUNTERS POINTING TO VISITS THAT DON'T EXIST PART 2. ;14-JUN-2005
- +1 ;;1.0;PCE;**153**;14-JUL-2004
- +2 QUIT
- +3 ;**********************************************************
- +4 ;Two entry points. FIXALL and FIXIND. Called from PXDELENC.
- +5 ;**********************************************************
- FIXALL ; Fix all encounters.
- +1 NEW DA,DIK,PXPAT,PXSDATE,PXENC,PXSEC,PXCOUNT,PXPATNM,Y
- +2 SET PXPAT=""
- SET PXSDATE=""
- SET PXENC=""
- +3 SET PXCOUNT=$GET(^XTMP("PXDELENC","PXENC","PXCOUNT"))
- +4 IF PXCOUNT=0
- Begin DoDot:1
- +5 WRITE !!,"There are no build entries to correct!"
- +6 DO WAIT^PXDELENC
- End DoDot:1
- QUIT
- +7 IF $GET(^XTMP("PXDELENC","END BUILD"))="RUNNING"
- Begin DoDot:1
- +8 WRITE !!,"Build is running, please wait until complete!"
- +9 DO WAIT^PXDELENC
- End DoDot:1
- QUIT
- +10 WRITE !!,"There are "_$GET(PXCOUNT)_" entries to correct."
- +11 SET DIR("A")="Do you wish to continue? "
- +12 SET DIR(0)="Y"
- SET DIR("B")="YES"
- +13 DO ^DIR
- if $DATA(DIRUT)
- QUIT
- +14 if Y=0
- QUIT
- +15 KILL DIR,DA,DIRUT
- +16 FOR
- SET PXPAT=$ORDER(^XTMP("PXDELENC","PXENC",PXPAT))
- if PXPAT=""
- QUIT
- Begin DoDot:1
- +17 FOR
- SET PXSDATE=$ORDER(^XTMP("PXDELENC","PXENC",PXPAT,PXSDATE))
- if PXSDATE=""
- QUIT
- Begin DoDot:2
- +18 FOR
- SET PXENC=$ORDER(^XTMP("PXDELENC","PXENC",PXPAT,PXSDATE,PXENC))
- if PXENC=""
- QUIT
- Begin DoDot:3
- +19 SET PXSEC=$GET(^XTMP("PXDELENC","PXENC",PXPAT,PXSDATE,PXENC))
- +20 SET PXPATNM=$PIECE($GET(^DPT(PXPAT,0)),"^",1)
- +21 SET $PIECE(^DPT(PXPAT,"S",PXSDATE,0),"^",2)="NT"
- +22 SET $PIECE(^DPT(PXPAT,"S",PXSDATE,0),"^",20)=""
- +23 SET DIK="^SCE("
- SET DA=PXENC
- DO ^DIK
- +24 IF $GET(PXSEC)'=""
- SET DIK="^SCE("
- SET DA=PXSEC
- DO ^DIK
- +25 SET PXCOUNT=PXCOUNT-1
- +26 KILL ^XTMP("PXDELENC","PXENC",PXPAT,PXSDATE,PXENC)
- +27 WRITE !!,?3,"Encounter: ",?12,$GET(PXENC)_" - "_$GET(PXPATNM),?45," Fixed!",!
- +28 SET DA=PXPAT
- DO FIXIHS
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +29 SET ^XTMP("PXDELENC","PXENC","PXCOUNT")=PXCOUNT
- +30 DO WAIT^PXDELENC
- +31 QUIT
- FIXIND ; Fix individual encounters.
- +1 NEW PXPAT,PXSDATE,PXSDTE,PXENC,PXVISIT,PXPRIM,PXEXIST,PXCOUNT,DIC,PXSEC,Y
- +2 IF $GET(^XTMP("PXDELENC","END BUILD"))="RUNNING"
- Begin DoDot:1
- +3 WRITE !!,"Build is running, please wait until complete!"
- +4 DO WAIT^PXDELENC
- End DoDot:1
- QUIT
- +5 SET DIC(0)="AEMQ"
- +6 DO ^DPTLK
- IF Y=-1
- QUIT
- +7 if $DATA(DIRUT)
- QUIT
- +8 SET PXPAT=$PIECE(Y,"^")
- +9 SET PXSDATE=0
- SET PXENC=""
- SET PXPRIM=""
- SET PXSEC=""
- SET PXEXIST=0
- +10 SET PXCOUNT=$GET(^XTMP("PXDELENC","PXENC","PXCOUNT"))
- +11 WRITE !!,"Processing...."
- +12 DO HEADER
- DISPLAY ;
- +1 FOR
- SET PXSDATE=$ORDER(^SCE("ADFN",PXPAT,PXSDATE))
- if PXSDATE=""!($DATA(DIRUT))
- QUIT
- Begin DoDot:1
- +2 FOR
- SET PXENC=$ORDER(^SCE("ADFN",PXPAT,PXSDATE,PXENC))
- if PXENC=""!($DATA(DIRUT))
- QUIT
- Begin DoDot:2
- +3 SET PXVISIT=$PIECE($GET(^SCE(PXENC,0)),"^",5)
- +4 SET PXPRIM=$PIECE($GET(^SCE(PXENC,0)),"^",6)
- +5 IF $GET(PXVISIT)'=""
- QUIT
- +6 IF $GET(PXPRIM)'=""
- QUIT
- +7 IF $GET(PXVISIT)=""
- IF $GET(PXPRIM)=""
- IF $DATA(^DPT(PXPAT,"S",PXSDATE,0))
- Begin DoDot:3
- +8 SET Y=PXSDATE
- DO DD^%DT
- SET PXSDTE=Y
- SET PXEXIST=1
- +9 SET PXPATNM=$PIECE($GET(^DPT(PXPAT,0)),"^",1)
- +10 WRITE ?3,PXPAT_" - "_PXPATNM,?35,PXSDTE,?55,PXENC,!
- +11 SET ^XTMP("PXDELENC","FIXIND",PXPAT,PXSDATE,PXENC)=""
- End DoDot:3
- End DoDot:2
- End DoDot:1
- if $DATA(DIRUT)
- QUIT
- +12 IF $GET(PXEXIST)=0
- GOTO NONE
- +13 SET DIR("A")="This will fix all entries for this Patient. Continue? "
- +14 SET DIR(0)="Y"
- SET DIR("B")="YES"
- +15 DO ^DIR
- +16 if $DATA(DIRUT)
- GOTO FIXIND
- +17 KILL DIR,DA,DIRUT
- +18 IF Y=0
- GOTO FIXIND
- FIX ;
- +1 NEW PXPAT,PXSDTE,PXENC
- +2 SET PXPAT=""
- SET PXSDTE=""
- SET PXENC=""
- +3 FOR
- SET PXPAT=$ORDER(^XTMP("PXDELENC","FIXIND",PXPAT))
- if PXPAT=""
- QUIT
- Begin DoDot:1
- +4 FOR
- SET PXSDTE=$ORDER(^XTMP("PXDELENC","FIXIND",PXPAT,PXSDTE))
- if PXSDTE=""
- QUIT
- Begin DoDot:2
- +5 FOR
- SET PXENC=$ORDER(^XTMP("PXDELENC","FIXIND",PXPAT,PXSDTE,PXENC))
- if PXENC=""
- QUIT
- Begin DoDot:3
- +6 SET $PIECE(^DPT(PXPAT,"S",PXSDTE,0),"^",20)=""
- +7 SET $PIECE(^DPT(PXPAT,"S",PXSDTE,0),"^",2)="NT"
- +8 IF $PIECE($GET(^SCE(PXENC+1,0)),"^",6)=PXENC
- SET PXSEC=PXENC+1
- +9 SET DIK="^SCE("
- SET DA=PXENC
- DO ^DIK
- +10 IF $GET(PXSEC)'=""
- SET DIK="^SCE("
- SET DA=PXSEC
- DO ^DIK
- +11 IF $DATA(^XTMP("PXDELENC","PXENC",PXPAT,PXSDTE,PXENC))
- SET PXCOUNT=PXCOUNT-1
- +12 KILL ^XTMP("PXDELENC","PXENC",PXPAT,PXSDTE,PXENC)
- +13 KILL ^XTMP("PXDELENC","FIXIND",PXPAT,PXSDTE,PXENC)
- +14 WRITE !!,?3,"Encounter: ",?12,$GET(PXENC)_" - "_$GET(PXPATNM),?45," Fixed!",!
- +15 SET DA=PXPAT
- DO FIXIHS
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +16 SET ^XTMP("PXDELENC","PXENC","PXCOUNT")=PXCOUNT
- +17 if $DATA(DIRUT)
- QUIT
- +18 IF PXEXIST=1
- Begin DoDot:1
- +19 WRITE !!,"No more missing visits to correct for this patient!"
- +20 DO WAIT^PXDELENC
- End DoDot:1
- NONE ;
- +1 IF PXEXIST=0
- Begin DoDot:1
- +2 WRITE !!,"No missing visits found for this patient!"
- +3 DO WAIT^PXDELENC
- End DoDot:1
- +4 KILL ^XTMP("PXDELENC","FIXIND")
- +5 GOTO FIXIND
- +6 QUIT
- +1 WRITE !,?3,"Patient IEN - Name",?35,"Appt Date",?55,"Encounter"
- +2 WRITE !,?3,"==================",?35,"=========",?55,"=========",!
- +3 QUIT
- FIXIHS ; Will fix the IHS Patient (9000001) file entries.
- +1 NEW PX
- +2 SET U="^"
- +3 DO CHECK^PXXDPT
- if '$TEST
- QUIT
- +4 SET PX=$PIECE($GET(^DPT(DA,0)),U,9)
- +5 DO SETSSN^PXXDPT
- +6 KILL DR,DIE,DA,PXDA
- +7 QUIT
- +8 ;
