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

IBCNSM.m

Go to the documentation of this file.
  1. IBCNSM ;ALB/AAS - INSURANCE MANAGEMENT, LIST MANAGER INIT ROUTINE ; 30-NOV-2021
  1. ;;2.0;INTEGRATED BILLING;**28,46,56,52,82,103,199,276,435,528,659,713,763,778**;21-MAR-94;Build 28
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;
  1. % ; -- main entry point
  1. EN ;
  1. D DT^DICRW
  1. K XQORS,VALMEVL
  1. D EN^VALM("IBCNS INSURANCE MANAGEMENT")
  1. ENQ K DFN
  1. Q
  1. ;
  1. ;
  1. INIT ; -- set up inital variables
  1. S U="^",VALMCNT=0,VALMBG=1
  1. K ^TMP("IBNSM",$J),^TMP("IBNSMDX",$J)
  1. ;K I,X,SDBEG,SDEND,SDB,XQORNOD,SDFN,SDCLN,DA,DR,DIE,DNM,DQ
  1. S DIR(0)="350.9,4.02",DIR("A")="Select Patient Name or Insurance Co."
  1. D ^DIR K DIR I $D(DIRUT) S VALMQUIT="" G INITQ
  1. S IBY=Y
  1. I IBY["DPT(" S IBTYP="P",DFN=+IBY D BLD
  1. I IBY["DIC(" S IBTYP="I",IBCNS=+IBY D EN^VALM("IBCNS INSURANCE COMPANY") S VALMQUIT=""
  1. ;
  1. INITQ Q
  1. ;
  1. ;
  1. PAT ; -- select patient you are working with
  1. N DPTNOFZY S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups
  1. S DIC(0)="AEQMN",DIC="^DPT(" D ^DIC I +Y<1 S VALMQUIT="" Q
  1. S DFN=+Y
  1. Q
  1. ;
  1. ;
  1. BLD ; -- build list of bills
  1. K ^TMP("IBNSM",$J),^TMP("IBNSMDX",$J)
  1. N I,J,K,IBDOD,IBHOLD,IBGRP,IBINS,IBCNT,IBCDFND,IBCDFND1,IBCPOLD,IBPL
  1. S (IBN,IBCNT,VALMCNT)=0,IBFILE=2
  1. ;
  1. ; -- find all ins. co data
  1. K IBINS S IBINS=0
  1. D POL^IBCNSU41(DFN)
  1. I '$G(IBNCPIVD) D ALL^IBCNS1(DFN,"IBINS") ; all insurances
  1. I $G(IBNCPIVD) D ALL^IBCNS1(DFN,"IBINS",1,IBNCPIVD) ; IB*2*435 - Rx policies active as of this date
  1. ;
  1. I $G(IBINS(0)) S K=0 F S K=$O(IBINS(K)) Q:'K D
  1. .; -- add to list
  1. .W "."
  1. .S IBCDFND=$G(IBINS(K,0))
  1. .S IBCDFND1=$G(IBINS(K,1))
  1. .S IBPL=+$P(IBCDFND,U,18)
  1. .S IBCPOLD=$G(^IBA(355.3,IBPL,0))
  1. .;
  1. .; IB*2*435 - esg - 9/27/10 - active Rx policies only if this variable is set
  1. .I $G(IBNCPIVD),'$$PLCOV^IBCNSU3(IBPL,IBNCPIVD,3) Q
  1. .;
  1. .S IBCNT=IBCNT+1
  1. .S X=""
  1. .S X=$$SETFLD^VALM1(IBCNT,X,"NUMBER")
  1. .I $D(^DIC(36,+IBCDFND,0)) S X=$$SETFLD^VALM1($P(^(0),"^"),X,"NAME")
  1. .S X=$$SETFLD^VALM1($E($P(IBCDFND,"^",2),1,14),X,"POLICY")
  1. .S IBHOLD=$P(IBCDFND,"^",6),X=$$SETFLD^VALM1($S(IBHOLD="v":"SELF",IBHOLD="s":"SPOUSE",IBHOLD="o":"OTHER",1:"UNKNOWN"),X,"HOLDER")
  1. .S X=$$SETFLD^VALM1($E($$GRP^IBCNS($P(IBCDFND,"^",18)),1,10),X,"GROUP")
  1. .S X=$$SETFLD^VALM1($$DAT1^IBOUTL($P(IBCDFND,"^",8)),X,"EFFDT")
  1. .S X=$$SETFLD^VALM1($$DAT1^IBOUTL($P(IBCDFND,"^",4)),X,"EXPIRE")
  1. .S X=$$SETFLD^VALM1($E($P($G(^IBE(355.1,+$P(IBCPOLD,"^",9),0)),U),1,8),X,"TYPE")
  1. .;
  1. .; IB*778/DTG change to display abbreviation if Type of Plan name is longer than 15 characters.
  1. .;S X=$$SETFLD^VALM1($P($G(^IBE(355.1,+$P($G(^IBA(355.3,+$P(IBCDFND,"^",18),0)),"^",9),0)),"^"),X,"TYPEPOL")
  1. .N IBTYPA,IBTYPN,IBTYPO,IB3551IEN
  1. .S IB3551IEN=$$GET1^DIQ(355.3,+$P(IBCDFND,"^",18)_",",".09","I")
  1. .S IBTYPN=$$GET1^DIQ(355.1,IB3551IEN_",",".01") ;name
  1. .S IBTYPA=$$GET1^DIQ(355.1,IB3551IEN_",",".02") ;abbrev
  1. .S IBTYPO=IBTYPN I $L(IBTYPN)>15&(IBTYPA'="") S IBTYPO=IBTYPA
  1. .S X=$$SETFLD^VALM1(IBTYPO,X,"TYPEPOL") ; type of plan
  1. .;
  1. .S X=$$SETFLD^VALM1($E($P($G(^VA(200,+$P(IBCDFND1,"^",4),0)),U),1,15),X,"VERIFIED BY")
  1. .S X=$$SETFLD^VALM1($$DAT1^IBOUTL($P(IBCDFND1,"^",3)),X,"VERIFIED ON")
  1. .S X=$$SETFLD^VALM1($$YN($P(IBCPOLD,"^",6)),X,"PRECERT")
  1. .S X=$$SETFLD^VALM1($$YN($P(IBCPOLD,"^",5)),X,"UR")
  1. .;S X=$$SETFLD^VALM1($$YN($P(IBCDFND,"^",20)),X,"COB") ;/vd-IB*2*659 - Replaced this line with the line below.
  1. .S X=$$SETFLD^VALM1($$COB($P(IBCDFND,"^",20)),X,"COB")
  1. .K IBHOLD,IBGRP
  1. .D SET(X)
  1. .Q
  1. ;
  1. I '$D(^TMP("IBNSM",$J)) D
  1. .S VALMCNT=2,IBCNT=2,^TMP("IBNSM",$J,1,0)=" "
  1. .S ^TMP("IBNSM",$J,2,0)=" No Insurance Policies on file for this patient."
  1. .I $G(IBNCPIVD) S ^TMP("IBNSM",$J,2,0)=" No Active Rx Policies found as of Effective Date "_$$FMTE^XLFDT(IBNCPIVD,"2Z")_"."
  1. .Q
  1. ;
  1. S X=$G(^IBA(354,DFN,60)) I X D
  1. .S IBCNT=IBCNT+1
  1. .S ^TMP("IBNSM",$J,IBCNT,0)=" Verification of No Coverage "_$$FMTE^XLFDT(X)
  1. .Q
  1. ;
  1. ; IB*713/CKB - adding Date of Death message
  1. S IBDOD=$$GET1^DIQ(2,DFN_",",.351,"I") I IBDOD D
  1. . S IBCNT=IBCNT+1
  1. . S ^TMP("IBNSM",$J,IBCNT,0)=" Date of Death: "_$$FMTE^XLFDT(IBDOD\1,"5Z")
  1. ;
  1. BLDQ ;
  1. Q
  1. ;
  1. SET(X) ; -- set arrays
  1. S VALMCNT=VALMCNT+1,^TMP("IBNSM",$J,VALMCNT,0)=X
  1. S ^TMP("IBNSM",$J,"IDX",VALMCNT,IBCNT)=""
  1. S ^TMP("IBNSMDX",$J,IBCNT)=VALMCNT_"^"_IBFILE_"^"_DFN_"^"_K_"^"_IBCDFND
  1. Q
  1. ;
  1. HDR ; -- screen header for initial screen
  1. D PID^VADPT
  1. ; -- AWC/ ib*2.0*528 add the patient dob to display screen
  1. S VALMHDR(1)="Insurance Management for Patient: "_$E($P($G(^DPT(DFN,0)),"^"),1,20)_" "_$E($G(^(0)),1)_VA("BID")_" "_$$FMTE^XLFDT($P($G(^DPT(DFN,0)),"^",3),5)
  1. S VALMHDR(2)=" "
  1. I +$$BUFFER^IBCNBU1(DFN) S VALMHDR(2)="*** Patient has Insurance Buffer Records"
  1. Q
  1. ;
  1. FNL ; -- exit and clean up
  1. K ^TMP("IBNSM",$J),^TMP("IBNSMDX",$J)
  1. K IBFASTXT
  1. D CLEAN^VALM10
  1. Q
  1. ;
  1. YN(X,Y) ; -- convert 1 or 0 to yes/no/unknown
  1. Q $S($G(X)="":$S($G(Y):"",1:"UNK"),X=0:"NO",X=1:"YES",1:"")
  1. ;
  1. ;/vd-IB*2*659 - Created the new module below to convert COB to appropriate display.
  1. COB(X) ; -- convert COB value to "UNK", "P", "S" or "T"
  1. Q $S(+X:$E("PST",+X),1:"UNK")
  1. ;
  1. CP ; -- change patient
  1. N VALMQUIT
  1. D FULL^VALM1
  1. S IBDFN=DFN D PAT
  1. I $D(VALMQUIT) S DFN=IBDFN
  1. D HDR,BLD
  1. ;IB*763/CKB - reset VALMBG to prevent broken breadcrumbs
  1. S VALMBCK="R",VALMBG=1
  1. CPQ K IBDFN
  1. Q
  1. ;
  1. PCI S VALMBCK="R" Q
  1. ;
  1. FASTEXIT ;just sets a flag signaling system should be exited
  1. S VALMBCK="Q"
  1. D FULL^VALM1
  1. K DIR S DIR(0)="Y",DIR("A")="Exit option entirely",DIR("B")="NO" D ^DIR
  1. I $D(DIRUT)!(Y) S IBFASTXT=1
  1. K DIR
  1. Q