APCDCHKI ; IHS/CMI/LAB - I-LINKER ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;
;IHS/CMI - patch 4 added check for mfi created visits
W !!,"This routine will find all In-Hospital visits that are not linked to a",!,"hospitalization and link them if possible."
W !!,"This process could take some time so you may want to queue the report to ",!,"print after-hours.",!
W !,"A report will be printed -- please enter the device for printing."
W !! S %ZIS="PQ" D ^%ZIS G:POP EOJ G:$D(IO("Q")) TSKMN
INIT ;
S:$D(ZTQUEUED) ZTREQ="@"
K ^XTMP("ILINK",$J)
S U="^",APCDIDFN=""
DRIVER F S APCDIDFN=$O(^AUPNVSIT("AI",APCDIDFN)) Q:APCDIDFN'=+APCDIDFN D PROCESS
D ^APCDCHKP
D EOJ
Q
;
PROCESS ; Process each "In hospital" record
; Set variables
I '$D(^AUPNVSIT(APCDIDFN,0)) K ^AUPNVSIT("AI",APCDIDFN) Q
S APCDIVR=^AUPNVSIT(APCDIDFN,0)
I $P(APCDIVR,U,11) K ^AUPNVSIT("AI",APCDIDFN) Q
I $P(APCDIVR,U,23)=.5 K ^AUPNVSIT("AI",APCDIDFN) Q
I $P($G(^AUPNVSIT(APCDIDFN,11)),U,13) K ^AUPNVSIT("AI",APCDIDFN) Q
I $P(APCDIVR,U,12) K ^AUPNVSIT("AI",APCDIDFN) Q
S APCDIDAT=+$P(APCDIVR,U),DFN=$P(APCDIVR,U,5),APCDITYP=$P(APCDIVR,U,3),APCDILOC=$P(APCDIVR,U,6),(APCDFND,APCDOLD,APCDHDFN)=0,APCDVD=$P(APCDIDAT,".") K APCDHOSP
; Check for hospitalization prior to (or on same day) as the "I" visit
S APCDVDH=(9999999-APCDVD),APCDSVD=(APCDVDH-1)_".9999",APCDHDFN=""
F S APCDSVD=$O(^AUPNVSIT("AAH",DFN,APCDSVD)) Q:APCDSVD'=+APCDSVD!($P(APCDSVD,".")<APCDVDH) D PROC2
I APCDFND>1 S APCDHDFN=0 F APCDL=0:0 S APCDHDFN=$O(APCDHOSP(APCDHDFN)) Q:APCDHDFN'=+APCDHDFN S ^XTMP("ILINK",$J,"TWOHITS",APCDIDFN,APCDHDFN)=""
I 'APCDFND D CHKYR
;
I APCDFND=1 S APCDHDFN=$O(APCDHOSP("")),DIE="^AUPNVSIT(",DA=APCDIDFN,DR=".12///`"_APCDHDFN D
.D ^DIE K DA,DR,DIE
.S ^XTMP("ILINK",$J,"HIT",APCDHDFN,APCDIDFN)=APCDDCD
.D CHKPROC
.S AUPNVSIT=APCDHDFN D MOD^AUPNVSIT
. ; -- IHS/DAOU/EJN for HL7
. Q:'$G(APCDIDFN)
. I $T(A08^BTSEVENT)]"" S APCDHLER=$$A08^BTSEVENT(APCDIDFN) K APCDHLER
. ; -- END HL7 mods
I 'APCDFND,'APCDOLD S ^XTMP("ILINK",$J,"NOHIT",APCDIDFN)=""
Q
;
PROC2 ;
S APCDHDFN=0 F S APCDHDFN=$O(^AUPNVSIT("AAH",DFN,APCDSVD,APCDHDFN)) Q:APCDHDFN'=+APCDHDFN I APCDHDFN]"",$D(^AUPNVSIT(APCDHDFN,0)),'$P(^(0),U,11),$P(^(0),U,9) D CHECK
Q
CHECK ;
S APCDHVR=^AUPNVSIT(APCDHDFN,0)
S APCDHDAT=+$P(APCDHVR,U),APCDHTYP=$P(APCDHVR,U,3),APCDHLOC=$P(APCDHVR,U,6)
CHKHOSP ; Check corresponding V Hospitalization for discharge date
S APCDINPD="",APCDINPD=$S(APCDITYP="C":$O(^AUPNVCHS("AD",APCDHDFN,"")),1:$O(^AUPNVINP("AD",APCDHDFN,"")))
Q:APCDINPD=""
S:APCDITYP="C" APCDDCD=$P(^AUPNVCHS(APCDINPD,0),U,7)
S:APCDITYP'="C" APCDDCD=$P(^AUPNVINP(APCDINPD,0),U)
I APCDDCD'<APCDVD S APCDFND=APCDFND+1,APCDHOSP(APCDHDFN)=""
Q
CHKYR ;
S %=DT-APCDVD I %>10000 I 'APCDFND S ^XTMP("ILINK",$J,"ONEYR",APCDIDFN)="",APCDOLD=1 K ^AUPNVSIT("AI",APCDIDFN)
Q
CHKPROC ;
S APCDVPRC=0 F S APCDVPRC=$O(^AUPNVPRC("AD",APCDHDFN,APCDVPRC)) Q:APCDVPRC'=+APCDVPRC I $D(^AUPNVPRC(APCDVPRC,0)) S APCDHPRC($P(^AUPNVPRC(APCDVPRC,0),U))=APCDVPRC
S APCDVPRC=0 F S APCDVPRC=$O(^AUPNVPRC("AD",APCDIDFN,APCDVPRC)) Q:APCDVPRC'=+APCDVPRC I $D(^AUPNVPRC(APCDVPRC,0)) S APCDICDP=$P(^AUPNVPRC(APCDVPRC,0),U) I $D(APCDHPRC(APCDICDP)) D DELPRC
Q
DELPRC ;
I $P(^AUPNVPRC(APCDHPRC(APCDICDP),0),U,4)'=$P(^AUPNVPRC(APCDVPRC,0),U,4) Q
;quit if provider narratives are NOT the same - per Diana 7/12/90
S ^XTMP("ILINK",$J,"PROC ERROR",APCDVPRC)=^AUPNVPRC(APCDVPRC,0)
S DA=APCDVPRC,DIE="^AUPNVPRC(",DR=".01///@" D ^DIE K DA,DR,DIE
I $D(Y) K ^XTMP("ILINK",$J,"PROC ERROR",APCDVPRC) Q
Q
EOJ ; Clean up and XIT
D ^%ZISC
K ^XTMP("ILINK",$J)
K APCDIDFN,APCDFND,APCDOLD,APCDHDFN,DFN,APCDINPD,APCDVD,APCDIDAT,APCDSVD,APCDVDH,APCDDCD,APCDDT,APCDHDFN,APCDHOSP,APCDHV,APCDHDAT,APCDHLOC,APCDHTYP,APCDHVR,APCDILOC,APCDIVR,APCDTYPE,APCDITYP,IO("Q"),APCDPG,APCDT
K APCDHPRC,APCDICDP,APCDL,APCDVPRC
Q
TSKMN ;
K ZTSAVE
S ZTCPU=$G(IOCPU),ZTIO=ION,ZTRTN="INIT^APCDCHKI",ZTDTH="",ZTDESC="PCC DATA ENTRY - IN HOSP LINK" D ^%ZTLOAD D EOJ Q
APCDCHKI ; IHS/CMI/LAB - I-LINKER ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;
+3 ;IHS/CMI - patch 4 added check for mfi created visits
+4 WRITE !!,"This routine will find all In-Hospital visits that are not linked to a",!,"hospitalization and link them if possible."
+5 WRITE !!,"This process could take some time so you may want to queue the report to ",!,"print after-hours.",!
+6 WRITE !,"A report will be printed -- please enter the device for printing."
+7 WRITE !!
SET %ZIS="PQ"
DO ^%ZIS
IF POP
GOTO EOJ
IF $DATA(IO("Q"))
GOTO TSKMN
INIT ;
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 KILL ^XTMP("ILINK",$JOB)
+3 SET U="^"
SET APCDIDFN=""
DRIVER FOR
SET APCDIDFN=$ORDER(^AUPNVSIT("AI",APCDIDFN))
IF APCDIDFN'=+APCDIDFN
QUIT
DO PROCESS
+1 DO ^APCDCHKP
+2 DO EOJ
+3 QUIT
+4 ;
PROCESS ; Process each "In hospital" record
+1 ; Set variables
+2 IF '$DATA(^AUPNVSIT(APCDIDFN,0))
KILL ^AUPNVSIT("AI",APCDIDFN)
QUIT
+3 SET APCDIVR=^AUPNVSIT(APCDIDFN,0)
+4 IF $PIECE(APCDIVR,U,11)
KILL ^AUPNVSIT("AI",APCDIDFN)
QUIT
+5 IF $PIECE(APCDIVR,U,23)=.5
KILL ^AUPNVSIT("AI",APCDIDFN)
QUIT
+6 IF $PIECE($GET(^AUPNVSIT(APCDIDFN,11)),U,13)
KILL ^AUPNVSIT("AI",APCDIDFN)
QUIT
+7 IF $PIECE(APCDIVR,U,12)
KILL ^AUPNVSIT("AI",APCDIDFN)
QUIT
+8 SET APCDIDAT=+$PIECE(APCDIVR,U)
SET DFN=$PIECE(APCDIVR,U,5)
SET APCDITYP=$PIECE(APCDIVR,U,3)
SET APCDILOC=$PIECE(APCDIVR,U,6)
SET (APCDFND,APCDOLD,APCDHDFN)=0
SET APCDVD=$PIECE(APCDIDAT,".")
KILL APCDHOSP
+9 ; Check for hospitalization prior to (or on same day) as the "I" visit
+10 SET APCDVDH=(9999999-APCDVD)
SET APCDSVD=(APCDVDH-1)_".9999"
SET APCDHDFN=""
+11 FOR
SET APCDSVD=$ORDER(^AUPNVSIT("AAH",DFN,APCDSVD))
IF APCDSVD'=+APCDSVD!($PIECE(APCDSVD,".")<APCDVDH)
QUIT
DO PROC2
+12 IF APCDFND>1
SET APCDHDFN=0
FOR APCDL=0:0
SET APCDHDFN=$ORDER(APCDHOSP(APCDHDFN))
IF APCDHDFN'=+APCDHDFN
QUIT
SET ^XTMP("ILINK",$JOB,"TWOHITS",APCDIDFN,APCDHDFN)=""
+13 IF 'APCDFND
DO CHKYR
+14 ;
+15 IF APCDFND=1
SET APCDHDFN=$ORDER(APCDHOSP(""))
SET DIE="^AUPNVSIT("
SET DA=APCDIDFN
SET DR=".12///`"_APCDHDFN
Begin DoDot:1
+16 DO ^DIE
KILL DA,DR,DIE
+17 SET ^XTMP("ILINK",$JOB,"HIT",APCDHDFN,APCDIDFN)=APCDDCD
+18 DO CHKPROC
+19 SET AUPNVSIT=APCDHDFN
DO MOD^AUPNVSIT
+20 ; -- IHS/DAOU/EJN for HL7
+21 IF '$GET(APCDIDFN)
QUIT
+22 IF $TEXT(A08^BTSEVENT)]""
SET APCDHLER=$$A08^BTSEVENT(APCDIDFN)
KILL APCDHLER
+23 ; -- END HL7 mods
End DoDot:1
+24 IF 'APCDFND
IF 'APCDOLD
SET ^XTMP("ILINK",$JOB,"NOHIT",APCDIDFN)=""
+25 QUIT
+26 ;
PROC2 ;
+1 SET APCDHDFN=0
FOR
SET APCDHDFN=$ORDER(^AUPNVSIT("AAH",DFN,APCDSVD,APCDHDFN))
IF APCDHDFN'=+APCDHDFN
QUIT
IF APCDHDFN]""
IF $DATA(^AUPNVSIT(APCDHDFN,0))
IF '$PIECE(^(0),U,11)
IF $PIECE(^(0),U,9)
DO CHECK
+2 QUIT
CHECK ;
+1 SET APCDHVR=^AUPNVSIT(APCDHDFN,0)
+2 SET APCDHDAT=+$PIECE(APCDHVR,U)
SET APCDHTYP=$PIECE(APCDHVR,U,3)
SET APCDHLOC=$PIECE(APCDHVR,U,6)
CHKHOSP ; Check corresponding V Hospitalization for discharge date
+1 SET APCDINPD=""
SET APCDINPD=$SELECT(APCDITYP="C":$ORDER(^AUPNVCHS("AD",APCDHDFN,"")),1:$ORDER(^AUPNVINP("AD",APCDHDFN,"")))
+2 IF APCDINPD=""
QUIT
+3 IF APCDITYP="C"
SET APCDDCD=$PIECE(^AUPNVCHS(APCDINPD,0),U,7)
+4 IF APCDITYP'="C"
SET APCDDCD=$PIECE(^AUPNVINP(APCDINPD,0),U)
+5 IF APCDDCD'<APCDVD
SET APCDFND=APCDFND+1
SET APCDHOSP(APCDHDFN)=""
+6 QUIT
CHKYR ;
+1 SET %=DT-APCDVD
IF %>10000
IF 'APCDFND
SET ^XTMP("ILINK",$JOB,"ONEYR",APCDIDFN)=""
SET APCDOLD=1
KILL ^AUPNVSIT("AI",APCDIDFN)
+2 QUIT
CHKPROC ;
+1 SET APCDVPRC=0
FOR
SET APCDVPRC=$ORDER(^AUPNVPRC("AD",APCDHDFN,APCDVPRC))
IF APCDVPRC'=+APCDVPRC
QUIT
IF $DATA(^AUPNVPRC(APCDVPRC,0))
SET APCDHPRC($PIECE(^AUPNVPRC(APCDVPRC,0),U))=APCDVPRC
+2 SET APCDVPRC=0
FOR
SET APCDVPRC=$ORDER(^AUPNVPRC("AD",APCDIDFN,APCDVPRC))
IF APCDVPRC'=+APCDVPRC
QUIT
IF $DATA(^AUPNVPRC(APCDVPRC,0))
SET APCDICDP=$PIECE(^AUPNVPRC(APCDVPRC,0),U)
IF $DATA(APCDHPRC(APCDICDP))
DO DELPRC
+3 QUIT
DELPRC ;
+1 IF $PIECE(^AUPNVPRC(APCDHPRC(APCDICDP),0),U,4)'=$PIECE(^AUPNVPRC(APCDVPRC,0),U,4)
QUIT
+2 ;quit if provider narratives are NOT the same - per Diana 7/12/90
+3 SET ^XTMP("ILINK",$JOB,"PROC ERROR",APCDVPRC)=^AUPNVPRC(APCDVPRC,0)
+4 SET DA=APCDVPRC
SET DIE="^AUPNVPRC("
SET DR=".01///@"
DO ^DIE
KILL DA,DR,DIE
+5 IF $DATA(Y)
KILL ^XTMP("ILINK",$JOB,"PROC ERROR",APCDVPRC)
QUIT
+6 QUIT
EOJ ; Clean up and XIT
+1 DO ^%ZISC
+2 KILL ^XTMP("ILINK",$JOB)
+3 KILL APCDIDFN,APCDFND,APCDOLD,APCDHDFN,DFN,APCDINPD,APCDVD,APCDIDAT,APCDSVD,APCDVDH,APCDDCD,APCDDT,APCDHDFN,APCDHOSP,APCDHV,APCDHDAT,APCDHLOC,APCDHTYP,APCDHVR,APCDILOC,APCDIVR,APCDTYPE,APCDITYP,IO("Q"),APCDPG,APCDT
+4 KILL APCDHPRC,APCDICDP,APCDL,APCDVPRC
+5 QUIT
TSKMN ;
+1 KILL ZTSAVE
+2 SET ZTCPU=$GET(IOCPU)
SET ZTIO=ION
SET ZTRTN="INIT^APCDCHKI"
SET ZTDTH=""
SET ZTDESC="PCC DATA ENTRY - IN HOSP LINK"
DO ^%ZTLOAD
DO EOJ
QUIT
