APCDCHKJ ; IHS/CMI/LAB - I-LINKER ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;IHS/CMI/LAB - patch 4 added check for MFI created visits
;
EN ;PEP - can be called by Billing, etc.
INIT ;
S:$D(ZTQUEUED) ZTREQ="@"
K ^XTMP("APCDCHKJ",$J)
S U="^",APCDIDFN=""
DRIVER F S APCDIDFN=$O(^AUPNVSIT("AI",APCDIDFN)) Q:APCDIDFN'=+APCDIDFN D PROCESS
D GENMSG
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("APCDCHKJ",$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("APCDCHKJ",$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("APCDCHKJ",$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("APCDCHKJ",$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("APCDCHKJ",$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("APCDCHKJ",$J,"PROC ERROR",APCDVPRC) Q
Q
GENMSG ;
K ^XTMP("APCDCHKJ",$J,"MESSAGE")
Q:$P($G(^APCDSITE(DUZ(2),0)),U,23)="" ;no one to send message to
I '$D(^XTMP("APCDCHKJ",$J,"TWOHITS"))&('$D(^XTMP("APCDCHKJ",$J,"PROC ERROR"))) Q
I $D(^XTMP("APCDCHKJ",$J,"TWOHITS")) D
.S X=1,^XTMP("APCDCHKJ",$J,"MESSAGE",X,0)="The following In-Hospital/Daily Hospitalization Visits could be linked"
.S X=2,^XTMP("APCDCHKJ",$J,"MESSAGE",X,0)="to two or more Hospitalizations. They must be linked manually."
.S Y=0 F S Y=$O(^XTMP("APCDCHKJ",$J,"TWOHITS",Y)) Q:Y'=+Y D
..S X=X+1,^XTMP("APCDCHKJ",$J,"MESSAGE",X,0)="IN-HOSP: "_$$VAL^XBDIQ1(9000010,Y,.01)_" "_$$VAL^XBDIQ1(9000010,Y,.05)
..S X=X+1,^XTMP("APCDCHKJ",$J,"MESSAGE",X,0)=" TYPE: "_$$VAL^XBDIQ1(9000010,Y,.03)_" LOCATION: "_$$VAL^XBDIQ1(9000010,Y,.06)
..S X=X+1,^XTMP("APCDCHKJ",$J,"MESSAGE",X,0)="HOSPITALIZATIONS:"
..S Z=0 F S Z=$O(^XTMP("APCDCHKJ",$J,"TWOHITS",Y,Z)) Q:Z'=+Z D
...S X=X+1,^XTMP("APCDCHKJ",$J,"MESSAGE",X,0)=" DATE: "_$$VAL^XBDIQ1(9000010,Z,.01)_" NAME: "_$$VAL^XBDIQ1(9000010,Z,.05)
...I $$VALI^XBDIQ1(9000010,Z,.03)="C" S APCDINPD=$O(^AUPNVCHS("AD",Z,0)) I APCDINPD]"" S APCDDCD=$P(^AUPNVCHS(APCDINPD,0),U,7)
...I $$VALI^XBDIQ1(9000010,Z,.03)'="C" S APCDINPD=$O(^AUPNVINP("AD",Z,0)) I APCDINPD]"" S APCDDCD=$P(^AUPNVINP(APCDINPD,0),U)
...S X=X+1,^XTMP("APCDCHKJ",$J,"MESSAGE",X,0)=" LOCATION: "_$$VAL^XBDIQ1(9000010,Z,.06)_" TYPE: "_$$VAL^XBDIQ1(9000010,Z,.03)_" D/C: "_$$FMTE^XLFDT(APCDDCD,"1P")
...Q
..Q
.Q
;SEND MESSAGE
S XMDUZ=.5
S XMTEXT="^XTMP(""APCDCHKJ"",$J,""MESSAGE"","
S XMSUB="IN-HOSPITAL LINK REPORT - ERRORS"
S X=$$VAL^XBDIQ1(9001001.2,DUZ(2),.23)
S XMY(X)=""
D ^XMD K XMY
Q
;
EOJ ; Clean up and XIT
K ^XTMP("APCDCHKJ",$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
APCDCHKJ ; IHS/CMI/LAB - I-LINKER ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;IHS/CMI/LAB - patch 4 added check for MFI created visits
+3 ;
EN ;PEP - can be called by Billing, etc.
INIT ;
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 KILL ^XTMP("APCDCHKJ",$JOB)
+3 SET U="^"
SET APCDIDFN=""
DRIVER FOR
SET APCDIDFN=$ORDER(^AUPNVSIT("AI",APCDIDFN))
IF APCDIDFN'=+APCDIDFN
QUIT
DO PROCESS
+1 DO GENMSG
+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("APCDCHKJ",$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("APCDCHKJ",$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("APCDCHKJ",$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("APCDCHKJ",$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("APCDCHKJ",$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("APCDCHKJ",$JOB,"PROC ERROR",APCDVPRC)
QUIT
+6 QUIT
GENMSG ;
+1 KILL ^XTMP("APCDCHKJ",$JOB,"MESSAGE")
+2 ;no one to send message to
IF $PIECE($GET(^APCDSITE(DUZ(2),0)),U,23)=""
QUIT
+3 IF '$DATA(^XTMP("APCDCHKJ",$JOB,"TWOHITS"))&('$DATA(^XTMP("APCDCHKJ",$JOB,"PROC ERROR")))
QUIT
+4 IF $DATA(^XTMP("APCDCHKJ",$JOB,"TWOHITS"))
Begin DoDot:1
+5 SET X=1
SET ^XTMP("APCDCHKJ",$JOB,"MESSAGE",X,0)="The following In-Hospital/Daily Hospitalization Visits could be linked"
+6 SET X=2
SET ^XTMP("APCDCHKJ",$JOB,"MESSAGE",X,0)="to two or more Hospitalizations. They must be linked manually."
+7 SET Y=0
FOR
SET Y=$ORDER(^XTMP("APCDCHKJ",$JOB,"TWOHITS",Y))
IF Y'=+Y
QUIT
Begin DoDot:2
+8 SET X=X+1
SET ^XTMP("APCDCHKJ",$JOB,"MESSAGE",X,0)="IN-HOSP: "_$$VAL^XBDIQ1(9000010,Y,.01)_" "_$$VAL^XBDIQ1(9000010,Y,.05)
+9 SET X=X+1
SET ^XTMP("APCDCHKJ",$JOB,"MESSAGE",X,0)=" TYPE: "_$$VAL^XBDIQ1(9000010,Y,.03)_" LOCATION: "_$$VAL^XBDIQ1(9000010,Y,.06)
+10 SET X=X+1
SET ^XTMP("APCDCHKJ",$JOB,"MESSAGE",X,0)="HOSPITALIZATIONS:"
+11 SET Z=0
FOR
SET Z=$ORDER(^XTMP("APCDCHKJ",$JOB,"TWOHITS",Y,Z))
IF Z'=+Z
QUIT
Begin DoDot:3
+12 SET X=X+1
SET ^XTMP("APCDCHKJ",$JOB,"MESSAGE",X,0)=" DATE: "_$$VAL^XBDIQ1(9000010,Z,.01)_" NAME: "_$$VAL^XBDIQ1(9000010,Z,.05)
+13 IF $$VALI^XBDIQ1(9000010,Z,.03)="C"
SET APCDINPD=$ORDER(^AUPNVCHS("AD",Z,0))
IF APCDINPD]""
SET APCDDCD=$PIECE(^AUPNVCHS(APCDINPD,0),U,7)
+14 IF $$VALI^XBDIQ1(9000010,Z,.03)'="C"
SET APCDINPD=$ORDER(^AUPNVINP("AD",Z,0))
IF APCDINPD]""
SET APCDDCD=$PIECE(^AUPNVINP(APCDINPD,0),U)
+15 SET X=X+1
SET ^XTMP("APCDCHKJ",$JOB,"MESSAGE",X,0)=" LOCATION: "_$$VAL^XBDIQ1(9000010,Z,.06)_" TYPE: "_$$VAL^XBDIQ1(9000010,Z,.03)_" D/C: "_$$FMTE^XLFDT(APCDDCD,"1P")
+16 QUIT
End DoDot:3
+17 QUIT
End DoDot:2
+18 QUIT
End DoDot:1
+19 ;SEND MESSAGE
+20 SET XMDUZ=.5
+21 SET XMTEXT="^XTMP(""APCDCHKJ"",$J,""MESSAGE"","
+22 SET XMSUB="IN-HOSPITAL LINK REPORT - ERRORS"
+23 SET X=$$VAL^XBDIQ1(9001001.2,DUZ(2),.23)
+24 SET XMY(X)=""
+25 DO ^XMD
KILL XMY
+26 QUIT
+27 ;
EOJ ; Clean up and XIT
+1 KILL ^XTMP("APCDCHKJ",$JOB)
+2 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
+3 KILL APCDHPRC,APCDICDP,APCDL,APCDVPRC
+4 QUIT
