BDGICC.m

BDGICC ; IHS/ANMC/LJF - INCOMPLETE CHART COMPUTED FIELDS ;

 ;;5.3;PIMS;**1001,1005**;MAY 28, 2004

 ;IHS/ITSC/WAR 07/19/2004 PATCH 1001 added CODER subroutine

 ;IHS/OIT/LJF  04/06/2006 PATCH 1005 added DELQDT subroutine

 ;

INSUR(IEN) ;EP; called by computed code for Insurance Coverage

 ; IEN = internal entry in file

 ;

 NEW PAT,VST,DATE

 S PAT=$$GET1^DIQ(9009016.1,IEN,.01,"I") I 'PAT Q "??"

 S VST=$$GET1^DIQ(9009016.1,IEN,.03,"I") I 'VST Q "??"

 S DATE=$$GET1^DIQ(9000010,VST,.01,"I") I 'DATE Q "??"

 Q $$INSUR^BDGF2(PAT,DATE)

 ;

ICSTAT(IEN,PVN) ;EP; called by computed code for Resolution Status

 ; IEN = internal entry in file

 ; PVN = internal entry for provider multiple

 I ('$G(IEN))!('$G(PVN)) Q "??"

 I $$GET1^DIQ(9009016.11,PVN_","_IEN,.03)]"" Q "Resolved"

 I $$GET1^DIQ(9009016.11,PVN_","_IEN,.04)]"" Q "Deleted"

 Q "Pending"

 ;

ICTIME(IEN,PVN) ;EP; called by computed code for Completion Time

 ; IEN = internal entry in file

 ; PVN = internal entry for provider multiple

 I ('$G(IEN))!('$G(PVN)) Q "??"

 NEW DONE,DSCH

 S DONE=$$GET1^DIQ(9009016.11,PVN_","_IEN,.03,"I")   ;date resolved

 I 'DONE Q ""

 S DSCH=$$GET1^DIQ(9009016.1,IEN,.02,"I")            ;discharge date

 I 'DSCH S DSCH=$$GET1^DIQ(9009016.1,IEN,.05,"I")    ;surgery date

 I 'DSCH Q "??"

 Q $$FMDIFF^XLFDT(DONE,DSCH)

 ;

 ;

OIEN(IEN) ;EP; called by computed code for Orignial IEN

 ; returns ien in original package file plus file #

 ; If inpatient, returns "405;"_ien

 ; If day surgery using VA Surgery file, returns "130;"_ien

 ; If day surgery using ADT, returns 0 because does not point to Visit

 ;

 NEW TYPE

 S TYPE=$$GET1^DIQ(9009016.1,IEN,.0392) I TYPE="" Q 0

 S VISIT=$$GET1^DIQ(9009016.1,IEN,.03,"I") I 'VISIT Q 0

 I TYPE["HOS" S X=$O(^DGPM("AVISIT",VISIT,0)) Q $S('X:0,1:"405;"_X)

 S X=$O(^SRF("ADS",VISIT,0)) I X Q "130;"_X

 Q 0

 ;

DSWRD(IEN) ;EP; called by computed code for Discharge Ward

 ;

 NEW ADM S ADM=$$OIEN(IEN) I 'ADM Q ""

 I $E(ADM,1,4)="130;" Q ""  ;quit if day surgery

 S X=$P($G(^DGPM($P(ADM,";",2),0)),U,17) I 'X Q ""

 Q $$GET1^DIQ(405,X,200)

 ;

 ;IHS/ITSC/WAR 7/19/2004 Added per Linda PATCH #1001

CODER(ADM) ;EP; called by ADT ITEM "admitting clerk/coder";PATCH #1001

 I 'ADM Q "??"

 NEW VSIT,IC,CLERK,CODER

 S VSIT=$$GET1^DIQ(405,ADM,.27,"I") I 'VSIT Q "??"   ;visit ien

 S IC=$O(^BDGIC("AV",VSIT,0))                        ;incomplete chart n

 S CLERK=$$GET1^DIQ(200,+$$GET1^DIQ(405,+$G(ADM),100,"I"),1)        ;adk

 I IC S CODER=$$GET1^DIQ(200,+$$GET1^DIQ(9009016.1,IC,.22,"I"),1)   ;cor

 Q CLERK_$S($G(CODER)]"":" / "_CODER,1:"")

 ;

 ;IHS/OIT/LJF 04/06/2006 PATCH 1005 new subroutine

DELQDT(IEN,PVN) ;EP called by computed code for DATE DELINQUENT

 ; IEN = internal entry in file

 ; PVN = internal entry for provider multiple

 I ('$G(IEN))!('$G(PVN)) Q "??"

 NEW DSCH,DAYS

 S DSCH=$$GET1^DIQ(9009016.1,IEN,.02,"I")               ;discharge date

 I 'DSCH S DSCH=$$GET1^DIQ(9009016.1,IEN,.05,"I")       ;OR surgery date

 I 'DSCH Q "??"

 S DAYS=$$GET1^DIQ(9009020.1,$$DIV^BDGPAR(DUZ(2)),.12)  ;Days to delinquency

 Q $$FMADD^XLFDT(DSCH,DAYS)

 ;

BDGICC    ; IHS/ANMC/LJF - INCOMPLETE CHART COMPUTED FIELDS ;

 +1       ;;5.3;PIMS;**1001,1005**;MAY 28, 2004

 +2       ;IHS/ITSC/WAR 07/19/2004 PATCH 1001 added CODER subroutine

 +3       ;IHS/OIT/LJF  04/06/2006 PATCH 1005 added DELQDT subroutine

 +4       ;

INSUR(IEN) ;EP; called by computed code for Insurance Coverage

 +1       ; IEN = internal entry in file

 +2       ;

 +3        NEW PAT,VST,DATE

 +4        SET PAT=$$GET1^DIQ(9009016.1,IEN,.01,"I")

           IF 'PAT

               QUIT "??"

 +5        SET VST=$$GET1^DIQ(9009016.1,IEN,.03,"I")

           IF 'VST

               QUIT "??"

 +6        SET DATE=$$GET1^DIQ(9000010,VST,.01,"I")

           IF 'DATE

               QUIT "??"

 +7        QUIT $$INSUR^BDGF2(PAT,DATE)

 +8       ;

ICSTAT(IEN,PVN) ;EP; called by computed code for Resolution Status

 +1       ; IEN = internal entry in file

 +2       ; PVN = internal entry for provider multiple

 +3        IF ('$GET(IEN))!('$GET(PVN))

               QUIT "??"

 +4        IF $$GET1^DIQ(9009016.11,PVN_","_IEN,.03)]""

               QUIT "Resolved"

 +5        IF $$GET1^DIQ(9009016.11,PVN_","_IEN,.04)]""

               QUIT "Deleted"

 +6        QUIT "Pending"

 +7       ;

ICTIME(IEN,PVN) ;EP; called by computed code for Completion Time

 +1       ; IEN = internal entry in file

 +2       ; PVN = internal entry for provider multiple

 +3        IF ('$GET(IEN))!('$GET(PVN))

               QUIT "??"

 +4        NEW DONE,DSCH

 +5       ;date resolved

           SET DONE=$$GET1^DIQ(9009016.11,PVN_","_IEN,.03,"I")

 +6        IF 'DONE

               QUIT ""

 +7       ;discharge date

           SET DSCH=$$GET1^DIQ(9009016.1,IEN,.02,"I")

 +8       ;surgery date

           IF 'DSCH

               SET DSCH=$$GET1^DIQ(9009016.1,IEN,.05,"I")

 +9        IF 'DSCH

               QUIT "??"

 +10       QUIT $$FMDIFF^XLFDT(DONE,DSCH)

 +11      ;

 +12      ;

OIEN(IEN) ;EP; called by computed code for Orignial IEN

 +1       ; returns ien in original package file plus file #

 +2       ; If inpatient, returns "405;"_ien

 +3       ; If day surgery using VA Surgery file, returns "130;"_ien

 +4       ; If day surgery using ADT, returns 0 because does not point to Visit

 +5       ;

 +6        NEW TYPE

 +7        SET TYPE=$$GET1^DIQ(9009016.1,IEN,.0392)

           IF TYPE=""

               QUIT 0

 +8        SET VISIT=$$GET1^DIQ(9009016.1,IEN,.03,"I")

           IF 'VISIT

               QUIT 0

 +9        IF TYPE["HOS"

               SET X=$ORDER(^DGPM("AVISIT",VISIT,0))

               QUIT $SELECT('X:0,1:"405;"_X)

 +10       SET X=$ORDER(^SRF("ADS",VISIT,0))

           IF X

               QUIT "130;"_X

 +11       QUIT 0

 +12      ;

DSWRD(IEN) ;EP; called by computed code for Discharge Ward

 +1       ;

 +2        NEW ADM

           SET ADM=$$OIEN(IEN)

           IF 'ADM

               QUIT ""

 +3       ;quit if day surgery

           IF $EXTRACT(ADM,1,4)="130;"

               QUIT ""

 +4        SET X=$PIECE($GET(^DGPM($PIECE(ADM,";",2),0)),U,17)

           IF 'X

               QUIT ""

 +5        QUIT $$GET1^DIQ(405,X,200)

 +6       ;

 +7       ;IHS/ITSC/WAR 7/19/2004 Added per Linda PATCH #1001

CODER(ADM) ;EP; called by ADT ITEM "admitting clerk/coder";PATCH #1001

 +1        IF 'ADM

               QUIT "??"

 +2        NEW VSIT,IC,CLERK,CODER

 +3       ;visit ien

           SET VSIT=$$GET1^DIQ(405,ADM,.27,"I")

           IF 'VSIT

               QUIT "??"

 +4       ;incomplete chart n

           SET IC=$ORDER(^BDGIC("AV",VSIT,0))

 +5       ;adk

           SET CLERK=$$GET1^DIQ(200,+$$GET1^DIQ(405,+$GET(ADM),100,"I"),1)

 +6       ;cor

           IF IC

               SET CODER=$$GET1^DIQ(200,+$$GET1^DIQ(9009016.1,IC,.22,"I"),1)

 +7        QUIT CLERK_$SELECT($GET(CODER)]"":" / "_CODER,1:"")

 +8       ;

 +9       ;IHS/OIT/LJF 04/06/2006 PATCH 1005 new subroutine

DELQDT(IEN,PVN) ;EP called by computed code for DATE DELINQUENT

 +1       ; IEN = internal entry in file

 +2       ; PVN = internal entry for provider multiple

 +3        IF ('$GET(IEN))!('$GET(PVN))

               QUIT "??"

 +4        NEW DSCH,DAYS

 +5       ;discharge date

           SET DSCH=$$GET1^DIQ(9009016.1,IEN,.02,"I")

 +6       ;OR surgery date

           IF 'DSCH

               SET DSCH=$$GET1^DIQ(9009016.1,IEN,.05,"I")

 +7        IF 'DSCH

               QUIT "??"

 +8       ;Days to delinquency

           SET DAYS=$$GET1^DIQ(9009020.1,$$DIV^BDGPAR(DUZ(2)),.12)

 +9        QUIT $$FMADD^XLFDT(DSCH,DAYS)

 +10      ;