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

IBCNESI1.m

Go to the documentation of this file.
  1. IBCNESI1 ;ALB/TAZ - MEDICARE POTENTIAL COB Patient Selection ;15 Jan 13
  1. ;;2.0;INTEGRATED BILLING;**497**;21-MAR-94;Build 120
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. Q ;Only enter at labels.
  1. ;
  1. LIST ; Entry Point from IBCNESI
  1. ; IBSDT - Start Date
  1. ; IBEDT - End Date
  1. ; IBSORT - Sort Direction
  1. ; IBREP - Report or Screen
  1. ; IBCOMP -
  1. ; 1 = include completed entries only
  1. ; 2 = include completed entries only with comments
  1. ; 3 = exclude completed entries
  1. ; 4 = exclude completed entries with comments
  1. ;
  1. N IBDT,IBDT1,IBPYR,IBMPYR,IBDFN,IBRIEN,IBRVIEN,IBEIEN,IBDATA,IENS,IBSEQ,IBCIEN,IBEIDCD,IBRVST,IBELIG,IBNOCMT,IBCNT
  1. K ^TMP($J,"IBCNESI1"),^TMP($J,"IBCNESI2"),^TMP("IBCNESI1",$J),^UTILITY("VADM",$J)
  1. S IBPYR=$P($G(^IBE(350.9,1,51)),U,25) ; get Medicare payer ien from IB site parameters
  1. S IBDT=IBSDT-.1,IBCNT=0
  1. D BLDTMP
  1. I IBREP="R" D EN^IBCNERPI
  1. Q
  1. ;
  1. BLDTMP ; construct the temporary global array according to filter and sort criteria selected by user
  1. F S IBDT=$O(^IBCN(365,"AD",IBDT)) Q:'IBDT!(IBDT>(IBEDT+1)) D
  1. . S IBDFN=0
  1. . F S IBDFN=$O(^IBCN(365,"AD",IBDT,IBPYR,IBDFN)) Q:'IBDFN D
  1. .. S IBRIEN=0
  1. .. F S IBRIEN=$O(^IBCN(365,"AD",IBDT,IBPYR,IBDFN,IBRIEN)) Q:'IBRIEN D
  1. ... ; Transmission Status must be "Response Received"
  1. ... I $$GET1^DIQ(365,IBRIEN_",",.06,"I")'=$O(^IBE(365.14,"B","Response Received","")) Q
  1. ... ; Get Response Review Status and check if there are comments. Include/exclude entries according to the report type.
  1. ... S IBRVIEN=$O(^IBCN(365.2,"B",IBRIEN,"")),IBRVST=+$$GET1^DIQ(365.2,IBRVIEN_",",.02,"I")
  1. ... S IBNOCMT=IBCOMP#2 ; 1 - don't print comments, 0 - print comments
  1. ... I "^1^2^"[(U_IBCOMP_U),IBRVST'=2 Q ; type = 1 or 2, status is not "review complete"
  1. ... I "^3^4^"[(U_IBCOMP_U),IBRVST=2 Q ; type = 3 or 4, status is "review complete"
  1. ... ; Get eligibility Data and set up COB nodes
  1. ... S IBDT1=(IBDT\1)*IBSORT
  1. ... S IBEIEN=0
  1. ... F S IBEIEN=$O(^IBCN(365,IBRIEN,2,IBEIEN)) Q:'IBEIEN D
  1. .... ;Get Eligibility Code. We want R codes only.
  1. .... S IENS=IBEIEN_","_IBRIEN_","
  1. .... S IBELIG=$$GET1^DIQ(365.02,IENS,.02) I IBELIG'="R" Q
  1. .... S IBEIDCD=$$GET1^DIQ(365.02,IENS,3.01) ;I ",PR,PRP,SEP,TTP,"'[(","_IBEIDCD_",") Q
  1. .... S IBDATA=$$GET1^DIQ(365.02,IENS,3.03),^TMP($J,"IBCNESI1",IBDT1,IBDFN,IBRIEN,"INS",IBEIEN,"NAME")=IBDATA
  1. .... S ^TMP($J,"IBCNESI1",IBDT1,IBDFN,IBRIEN,"INS",IBEIEN,"ENT ID CD")=$S(",PRP,SEP,TTP,"[(","_IBEIDCD_","):IBEIDCD,1:"")
  1. .... S ^TMP($J,"IBCNESI1",IBDT1,IBDFN,IBRIEN,"INS",IBEIEN,"EMFLAG")=$$MATCH(IBDFN,IBDATA)
  1. .... S IBDATA=$$GET1^DIQ(365.02,IENS,3.04) I IBDATA'="" S ^TMP($J,"IBCNESI1",IBDT1,IBDFN,IBRIEN,"INS",IBEIEN,"ID")=IBDATA
  1. .... S IBDATA=$$GET1^DIQ(365.02,IENS,3.05,"I") I IBDATA'="" S ^TMP($J,"IBCNESI1",IBDT1,IBDFN,IBRIEN,"INS",IBEIEN,"ID QUAL")=$P(^IBE(365.023,IBDATA,0),U,2)
  1. .... S IBDATA=$$GET1^DIQ(365.02,IENS,4.01) I IBDATA'="" S ^TMP($J,"IBCNESI1",IBDT1,IBDFN,IBRIEN,"INS",IBEIEN,"ADDRESS 1")=IBDATA
  1. .... S IBDATA=$$GET1^DIQ(365.02,IENS,4.02) I IBDATA'="" S ^TMP($J,"IBCNESI1",IBDT1,IBDFN,IBRIEN,"INS",IBEIEN,"ADDRESS 2")=IBDATA
  1. .... S IBDATA=$$GET1^DIQ(365.02,IENS,4.03) I IBDATA'="" S ^TMP($J,"IBCNESI1",IBDT1,IBDFN,IBRIEN,"INS",IBEIEN,"CITY")=IBDATA
  1. .... S IBDATA=$$GET1^DIQ(365.02,IENS,4.04,"I") I IBDATA'="" S ^TMP($J,"IBCNESI1",IBDT1,IBDFN,IBRIEN,"INS",IBEIEN,"STATE")=$$GET1^DIQ(5,IBDATA_",",1)
  1. .... S IBDATA=$$GET1^DIQ(365.02,IENS,4.05) I IBDATA'="" S ^TMP($J,"IBCNESI1",IBDT1,IBDFN,IBRIEN,"INS",IBEIEN,"ZIP")=IBDATA
  1. .... S IBCIEN=0
  1. .... ; display Contact Information
  1. .... F S IBCIEN=$O(^IBCN(365,IBRIEN,2,IBEIEN,6,IBCIEN)) Q:'IBCIEN D
  1. ..... S IENS=IBCIEN_","_IBEIEN_","_IBRIEN_","
  1. ..... S IBDATA=$$GET1^DIQ(365.26,IENS,.04) I ",UR,TE,"'[(","_IBDATA_",") Q ;Phone and Web only
  1. ..... S IBSEQ=$$GET1^DIQ(365.26,IENS,.01)
  1. ..... S ^TMP($J,"IBCNESI1",IBDT1,IBDFN,IBRIEN,"INS",IBEIEN,IBDATA,IBSEQ)=$$GET1^DIQ(365.26,IENS,1)
  1. ... ;If COB data found set up Patient Info
  1. ... I $D(^TMP($J,"IBCNESI1",IBDT1,IBDFN,IBRIEN)) D
  1. .... N VAHOW,DFN,VADM
  1. .... S VAHOW=2,DFN=IBDFN D DEM^VADPT
  1. .... S ^TMP($J,"IBCNESI1",IBDT1,IBDFN,IBRIEN,"PATIENT NAME")=$P($G(^UTILITY("VADM",$J,1)),U)
  1. .... S ^TMP($J,"IBCNESI1",IBDT1,IBDFN,IBRIEN,"DOB")=$P($G(^UTILITY("VADM",$J,3)),U)
  1. .... S ^TMP($J,"IBCNESI1",IBDT1,IBDFN,IBRIEN,"SSN")=$E($P($G(^UTILITY("VADM",$J,2)),U),6,10)
  1. .... S ^TMP($J,"IBCNESI1",IBDT1,IBDFN,IBRIEN,"REV IEN")=+$G(IBRVIEN)
  1. ....;KML need to have capability of accessing the REV STATUS subscript when REVIEW STATUS is updated by user
  1. .... S ^TMP($J,"IBCNESI1",IBDT1,IBDFN,IBRIEN,"REV STATUS")=+$G(IBRVST)_U_IBDT1_U_IBDFN
  1. .... S ^TMP($J,"IBCNESI1",IBDT1,IBDFN,IBRIEN,"NO CMNT")=+$G(IBNOCMT)
  1. .... K ^UTILITY("VADM",$J)
  1. .... S IBCNT=IBCNT+1 I '$D(ZTQUEUED),'(IBCNT#15) W ". "
  1. ... M ^TMP($J,"IBCNESI2",IBRIEN)=^TMP($J,"IBCNESI1",IBDT1,IBDFN,IBRIEN)
  1. I IBREP="S" D EN^VALM("IBCNE MEDICARE COB LIST")
  1. Q
  1. ;
  1. MATCH(IBDFN,INSCONM) ;Match Insurance Companies with Insurance Type subfile.
  1. N EXPDT,MATCH,NAME,IENS,IBITYP
  1. S MATCH=0
  1. S IBITYP=0
  1. F S IBITYP=$O(^DPT(IBDFN,.312,IBITYP)) Q:'IBITYP D I MATCH Q
  1. . S IENS=IBITYP_","_IBDFN_","
  1. . S EXPDT=$$GET1^DIQ(2.312,IENS,.03) I EXPDT&(DT>(EXPDT-1)) Q ;Only allow current Insurance Type entries
  1. . S NAME=$$GET1^DIQ(2.312,IENS,.01)
  1. . I NAME=$E(INSCONM,1,30) S MATCH=1 ;Names must be an exact match
  1. MATCHQ ;
  1. Q $S(MATCH:"*",1:"")
  1. ;
  1. HDR ; -- header code
  1. S VALMHDR(1)=""
  1. S VALMHDR(2)="Sorted in "_$S((IBSORT<0):"Reverse ",1:"")_"Chronological Order."
  1. S VALM("TITLE")="Medicare Potential COB List",VALMSG="*Exact Match"
  1. Q
  1. ;
  1. INIT ; -- init variables and list array
  1. D BLDSCRN
  1. Q
  1. ;
  1. HELP ; -- help code
  1. D FULL^VALM1
  1. S VALMBCK="R"
  1. W @IOF
  1. W !,"Status of entries displayed:"
  1. W !," Y - Entry has been reviewed but is not yet complete"
  1. W !," N - Entry has not been reviewed"
  1. W !
  1. W !,"* Denotes that the Insurance Company in the Response Record"
  1. W !," matches an Insurance Company in the Insurance Type "
  1. W !," sub-file of the Patient File."
  1. D PAUSE^VALM1
  1. Q
  1. ;
  1. EXIT ; -- exit code
  1. K ^TMP($J,"IBCNESI1"),^TMP($J,"IBCNESI2"),^TMP("IBCNESI1",$J),^UTILITY("VADM",$J)
  1. Q
  1. ;
  1. EXPND ; -- expand code
  1. N DA,DD,DIC,DIK,DLAYGO,X,Y,IBDA,IBIEN
  1. D SEL(.IBDA,1) S:$O(IBDA(0)) IBRIEN=+IBDA($O(IBDA(0))) I '$G(IBRIEN) G EXPNDQ
  1. D EN^IBCNESI2(IBRIEN)
  1. EXPNDQ ;
  1. D BLDSCRN
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. BLDSCRN ;build screen of worklist entries
  1. N IBLN,IBRVSTAT,LINEVAR,DISPDATE
  1. K @VALMAR
  1. S IBDT="",(IBLN,VALMCNT)=0
  1. F S IBDT=$O(^TMP($J,"IBCNESI1",IBDT)) Q:'IBDT D
  1. . S DISPDATE=1
  1. . S IBDFN=""
  1. . F S IBDFN=$O(^TMP($J,"IBCNESI1",IBDT,IBDFN)) Q:'IBDFN D
  1. .. S IBRIEN=""
  1. .. F S IBRIEN=$O(^TMP($J,"IBCNESI1",IBDT,IBDFN,IBRIEN)) Q:'IBRIEN D
  1. ... S IBRVSTAT=$P($G(^TMP($J,"IBCNESI1",IBDT,IBDFN,IBRIEN,"REV STATUS")),U)
  1. ... I IBRVSTAT=2 Q ;Do not include completes on the screen
  1. ... ;Only display the date if there are incomplete entries on that date.
  1. ... I DISPDATE S LINEVAR="",LINEVAR=$$SETSTR^VALM1($$FMTE^XLFDT((IBDT*IBSORT),"2Z"),LINEVAR,3,11) D SET(LINEVAR,IBLN+1) S DISPDATE=0
  1. ... S LINEVAR="",IBLN=IBLN+1
  1. ... S LINEVAR=$$SETFLD^VALM1($J(IBLN,3),LINEVAR,"COUNTER")
  1. ... S LINEVAR=$$SETFLD^VALM1($J(" ",7)_$G(^TMP($J,"IBCNESI2",IBRIEN,"PATIENT NAME")),LINEVAR,"PATIENT")
  1. ... S LINEVAR=$$SETFLD^VALM1($G(^TMP($J,"IBCNESI2",IBRIEN,"SSN")),LINEVAR,"SSN")
  1. ... S LINEVAR=$$SETFLD^VALM1($$FMTE^XLFDT($G(^TMP($J,"IBCNESI2",IBRIEN,"DOB")),"2Z"),LINEVAR,"DOB")
  1. ... S LINEVAR=$$SETFLD^VALM1($J($S(IBRVSTAT:"Y",1:"N"),2),LINEVAR,"STATUS")
  1. ... ; Get 1st Insurance Co
  1. ... S IBEIEN=0
  1. ... S IBEIEN=$O(^TMP($J,"IBCNESI1",IBDT,IBDFN,IBRIEN,"INS",IBEIEN))
  1. ... S LINEVAR=$$SETFLD^VALM1($G(^TMP($J,"IBCNESI2",IBRIEN,"INS",IBEIEN,"EMFLAG")),LINEVAR,"EMFLAG")
  1. ... S IBDATA=$E($G(^TMP($J,"IBCNESI2",IBRIEN,"INS",IBEIEN,"NAME")),1,31)
  1. ... I ^TMP($J,"IBCNESI2",IBRIEN,"INS",IBEIEN,"ENT ID CD")]"" S IBDATA=IBDATA_" ("_$E(^TMP($J,"IBCNESI2",IBRIEN,"INS",IBEIEN,"ENT ID CD"),1)_")"
  1. ... S LINEVAR=$$SETFLD^VALM1(IBDATA,LINEVAR,"INSCO")
  1. ... D SET(LINEVAR,IBLN,IBRIEN)
  1. ... F S IBEIEN=$O(^TMP($J,"IBCNESI2",IBRIEN,"INS",IBEIEN)) Q:'IBEIEN D
  1. .... S LINEVAR=""
  1. .... S LINEVAR=$$SETFLD^VALM1($G(^TMP($J,"IBCNESI2",IBRIEN,"INS",IBEIEN,"EMFLAG")),LINEVAR,"EMFLAG")
  1. .... S IBDATA=$E($G(^TMP($J,"IBCNESI2",IBRIEN,"INS",IBEIEN,"NAME")),1,31)
  1. .... I ^TMP($J,"IBCNESI2",IBRIEN,"INS",IBEIEN,"ENT ID CD")]"" S IBDATA=IBDATA_" ("_$E(^TMP($J,"IBCNESI2",IBRIEN,"INS",IBEIEN,"ENT ID CD"),1)_")"
  1. .... S LINEVAR=$$SETFLD^VALM1(IBDATA,LINEVAR,"INSCO")
  1. .... D SET(LINEVAR,IBLN,IBRIEN)
  1. I VALMCNT=0 D SET("",IBLN+1),SET("* * * No Worklist Entries to Display * * *",IBLN+1),SET("Review Status is 'Complete' for all entries within given Date Range",IBLN+1)
  1. Q
  1. ;
  1. SET(X,CNT,IBIEN) ;set up list manager screen array
  1. S VALMCNT=VALMCNT+1
  1. S @VALMAR@(VALMCNT,0)=X
  1. S @VALMAR@("IDX",VALMCNT,CNT)=""
  1. I $G(IBIEN),$G(@VALMAR@(CNT))="" S @VALMAR@(CNT)=VALMCNT_U_IBIEN
  1. Q
  1. ;
  1. SEL(IBDA,ONE) ; Select entry(s) from list
  1. ; IBDA = array returned if selections made
  1. ; IBDA(n)=ien of entry selected (file 365)
  1. ; ONE = if set to 1, only one selection can be made at a time
  1. N VALMY,VALMBG,VALMLST
  1. I $D(@VALMAR) D
  1. . S VALMBG=$O(@VALMAR@("IDX","")),VALMLST=$O(@VALMAR@("IDX",""),-1)
  1. . K IBDA
  1. . D FULL^VALM1
  1. . ;D EN^VALM2("",$S('$G(ONE):"",1:"S")) ; WCJ
  1. . D EN^VALM2($G(XQORNOD(0)),$S('$G(ONE):"",1:"S")) ;WCJ
  1. . S IBDA=0 F S IBDA=$O(VALMY(IBDA)) Q:'IBDA S IBDA(IBDA)=$P($G(@VALMAR@(+IBDA)),U,2,6)
  1. Q