- 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
