APCDCHKJ.m

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