AUPNLBCK.m

AUPNLBCK ; IHS/CMI/LAB - Backbilling Check ;

 ;;99.1;IHS DICTIONARIES (PATIENT);;MAR 09, 1999

 ;

 ;PATCH 1 - Modified MCD, MCR, RR, and PI Lines to do line CK which

 ;  checks to ensure the existance of DA(1) and DA before running

 ;

MCD ;EP

 D CK G XIT:'AUPNX("OK"),XIT:'$D(^AUPNMCD(DA(1),0))  S AUPNX("PDFN")=$P(^(0),U),AUPNX("DT")=DA G VSTCK

 ;

MCR ;EP

 D CK G XIT:'AUPNX("OK") S AUPNX("PDFN")=DA(1),AUPNX("DT")=DA G VSTCK

 ;

RR ;EP

 D CK G XIT:'AUPNX("OK") S AUPNX("PDFN")=DA(1),AUPNX("DT")=DA G VSTCK

 ;

PI ;EP

 Q:'+$G(X)  D CK G XIT:'AUPNX("OK") S AUPNX("PDFN")=DA(1),AUPNX("DT")=X

 ;

VSTCK S AUPNX("DT")=9999999-AUPNX("DT")

 S AUPNX=0 F  S AUPNX=$O(^AUPNVSIT("AA",AUPNX("PDFN"),AUPNX)) Q:AUPNX>AUPNX("DT")!'+AUPNX  S AUPNX("VDFN")=$O(^(AUPNX,"")) I AUPNX("VDFN")]"" D

 .Q:$G(^AUPNVSIT(AUPNX("VDFN"),0))=""

 .Q:$P(^AUPNVSIT(AUPNX("VDFN"),0),U,11)=1

 .S AUPNX("EDT")=$S($P(^AUPNVSIT(AUPNX("VDFN"),0),U,13)]"":$P(^(0),U,13),1:$P(^(0),U,2))

 .S ^AUPNVSIT("ABILL",AUPNX("EDT"),AUPNX("VDFN"))=""

 G XIT

 ;

CK S AUPNX("OK")=0

 Q:'$D(^AUTTSITE(1,0))  Q:$P(^(0),U,15)'="Y"

 I $D(DA(1)),$D(DA) S AUPNX("OK")=1

 Q

 ;

XIT K AUPNX

 Q

AUPNLBCK  ; IHS/CMI/LAB - Backbilling Check ;

 +1       ;;99.1;IHS DICTIONARIES (PATIENT);;MAR 09, 1999

 +2       ;

 +3       ;PATCH 1 - Modified MCD, MCR, RR, and PI Lines to do line CK which

 +4       ;  checks to ensure the existance of DA(1) and DA before running

 +5       ;

MCD       ;EP

 +1        DO CK

           IF 'AUPNX("OK")

               GOTO XIT

           IF '$DATA(^AUPNMCD(DA(1),0))

               GOTO XIT

           SET AUPNX("PDFN")=$PIECE(^(0),U)

           SET AUPNX("DT")=DA

           GOTO VSTCK

 +2       ;

MCR       ;EP

 +1        DO CK

           IF 'AUPNX("OK")

               GOTO XIT

           SET AUPNX("PDFN")=DA(1)

           SET AUPNX("DT")=DA

           GOTO VSTCK

 +2       ;

RR        ;EP

 +1        DO CK

           IF 'AUPNX("OK")

               GOTO XIT

           SET AUPNX("PDFN")=DA(1)

           SET AUPNX("DT")=DA

           GOTO VSTCK

 +2       ;

PI        ;EP

 +1        IF '+$GET(X)

               QUIT 

           DO CK

           IF 'AUPNX("OK")

               GOTO XIT

           SET AUPNX("PDFN")=DA(1)

           SET AUPNX("DT")=X

 +2       ;

VSTCK      SET AUPNX("DT")=9999999-AUPNX("DT")

 +1        SET AUPNX=0

           FOR 

               SET AUPNX=$ORDER(^AUPNVSIT("AA",AUPNX("PDFN"),AUPNX))

               IF AUPNX>AUPNX("DT")!'+AUPNX

                   QUIT 

               SET AUPNX("VDFN")=$ORDER(^(AUPNX,""))

               IF AUPNX("VDFN")]""

                   Begin DoDot:1

 +2                    IF $GET(^AUPNVSIT(AUPNX("VDFN"),0))=""

                           QUIT 

 +3                    IF $PIECE(^AUPNVSIT(AUPNX("VDFN"),0),U,11)=1

                           QUIT 

 +4                    SET AUPNX("EDT")=$SELECT($PIECE(^AUPNVSIT(AUPNX("VDFN"),0),U,13)]"":$PIECE(^(0),U,13),1:$PIECE(^(0),U,2))

 +5                    SET ^AUPNVSIT("ABILL",AUPNX("EDT"),AUPNX("VDFN"))=""

                   End DoDot:1

 +6        GOTO XIT

 +7       ;

CK         SET AUPNX("OK")=0

 +1        IF '$DATA(^AUTTSITE(1,0))

               QUIT 

           IF $PIECE(^(0),U,15)'="Y"

               QUIT 

 +2        IF $DATA(DA(1))

               IF $DATA(DA)

                   SET AUPNX("OK")=1

 +3        QUIT 

 +4       ;

XIT        KILL AUPNX

 +1        QUIT