Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BDGICC

BDGICC.m

Go to the documentation of this file. 
  1. BDGICC ; IHS/ANMC/LJF - INCOMPLETE CHART COMPUTED FIELDS ;
  1.  ;;5.3;PIMS;**1001,1005**;MAY 28, 2004
  1.  ;IHS/ITSC/WAR 07/19/2004 PATCH 1001 added CODER subroutine
  1.  ;IHS/OIT/LJF  04/06/2006 PATCH 1005 added DELQDT subroutine
  1.  ;
  1. INSUR(IEN) ;EP; called by computed code for Insurance Coverage
  1.  ; IEN = internal entry in file
  1.  ;
  1.  NEW PAT,VST,DATE
  1.  S PAT=$$GET1^DIQ(9009016.1,IEN,.01,"I") I 'PAT Q "??"
  1.  S VST=$$GET1^DIQ(9009016.1,IEN,.03,"I") I 'VST Q "??"
  1.  S DATE=$$GET1^DIQ(9000010,VST,.01,"I") I 'DATE Q "??"
  1.  Q $$INSUR^BDGF2(PAT,DATE)
  1.  ;
  1. ICSTAT(IEN,PVN) ;EP; called by computed code for Resolution Status
  1.  ; IEN = internal entry in file
  1.  ; PVN = internal entry for provider multiple
  1.  I ('$G(IEN))!('$G(PVN)) Q "??"
  1.  I $$GET1^DIQ(9009016.11,PVN_","_IEN,.03)]"" Q "Resolved"
  1.  I $$GET1^DIQ(9009016.11,PVN_","_IEN,.04)]"" Q "Deleted"
  1.  Q "Pending"
  1.  ;
  1. ICTIME(IEN,PVN) ;EP; called by computed code for Completion Time
  1.  ; IEN = internal entry in file
  1.  ; PVN = internal entry for provider multiple
  1.  I ('$G(IEN))!('$G(PVN)) Q "??"
  1.  NEW DONE,DSCH
  1.  S DONE=$$GET1^DIQ(9009016.11,PVN_","_IEN,.03,"I")   ;date resolved
  1.  I 'DONE Q ""
  1.  S DSCH=$$GET1^DIQ(9009016.1,IEN,.02,"I")            ;discharge date
  1.  I 'DSCH S DSCH=$$GET1^DIQ(9009016.1,IEN,.05,"I")    ;surgery date
  1.  I 'DSCH Q "??"
  1.  Q $$FMDIFF^XLFDT(DONE,DSCH)
  1.  ;
  1.  ;
  1. OIEN(IEN) ;EP; called by computed code for Orignial IEN
  1.  ; returns ien in original package file plus file #
  1.  ; If inpatient, returns "405;"_ien
  1.  ; If day surgery using VA Surgery file, returns "130;"_ien
  1.  ; If day surgery using ADT, returns 0 because does not point to Visit
  1.  ;
  1.  NEW TYPE
  1.  S TYPE=$$GET1^DIQ(9009016.1,IEN,.0392) I TYPE="" Q 0
  1.  S VISIT=$$GET1^DIQ(9009016.1,IEN,.03,"I") I 'VISIT Q 0
  1.  I TYPE["HOS" S X=$O(^DGPM("AVISIT",VISIT,0)) Q $S('X:0,1:"405;"_X)
  1.  S X=$O(^SRF("ADS",VISIT,0)) I X Q "130;"_X
  1.  Q 0
  1.  ;
  1. DSWRD(IEN) ;EP; called by computed code for Discharge Ward
  1.  ;
  1.  NEW ADM S ADM=$$OIEN(IEN) I 'ADM Q ""
  1.  I $E(ADM,1,4)="130;" Q ""  ;quit if day surgery
  1.  S X=$P($G(^DGPM($P(ADM,";",2),0)),U,17) I 'X Q ""
  1.  Q $$GET1^DIQ(405,X,200)
  1.  ;
  1.  ;IHS/ITSC/WAR 7/19/2004 Added per Linda PATCH #1001
  1. CODER(ADM) ;EP; called by ADT ITEM "admitting clerk/coder";PATCH #1001
  1.  I 'ADM Q "??"
  1.  NEW VSIT,IC,CLERK,CODER
  1.  S VSIT=$$GET1^DIQ(405,ADM,.27,"I") I 'VSIT Q "??"   ;visit ien
  1.  S IC=$O(^BDGIC("AV",VSIT,0))                        ;incomplete chart n
  1.  S CLERK=$$GET1^DIQ(200,+$$GET1^DIQ(405,+$G(ADM),100,"I"),1)        ;adk
  1.  I IC S CODER=$$GET1^DIQ(200,+$$GET1^DIQ(9009016.1,IC,.22,"I"),1)   ;cor
  1.  Q CLERK_$S($G(CODER)]"":" / "_CODER,1:"")
  1.  ;
  1.  ;IHS/OIT/LJF 04/06/2006 PATCH 1005 new subroutine
  1. DELQDT(IEN,PVN) ;EP called by computed code for DATE DELINQUENT
  1.  ; IEN = internal entry in file
  1.  ; PVN = internal entry for provider multiple
  1.  I ('$G(IEN))!('$G(PVN)) Q "??"
  1.  NEW DSCH,DAYS
  1.  S DSCH=$$GET1^DIQ(9009016.1,IEN,.02,"I")               ;discharge date
  1.  I 'DSCH S DSCH=$$GET1^DIQ(9009016.1,IEN,.05,"I")       ;OR surgery date
  1.  I 'DSCH Q "??"
  1.  S DAYS=$$GET1^DIQ(9009020.1,$$DIV^BDGPAR(DUZ(2)),.12)  ;Days to delinquency
  1.  Q $$FMADD^XLFDT(DSCH,DAYS)
  1.  ;