source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNSM.m@ 1259

Last change on this file since 1259 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1IBCNSM ;ALB/AAS - INSURANCE MANAGEMENT, LIST MANAGER INIT ROUTINE ;21-OCT-92
2 ;;2.0;INTEGRATED BILLING;**28,46,56,52,82,103,199,276**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;also used for IA #4694
6 ;
7% ; -- main entry point
8EN ;
9 D DT^DICRW
10 K XQORS,VALMEVL
11 D EN^VALM("IBCNS INSURANCE MANAGEMENT")
12ENQ K DFN
13 Q
14 ;
15 ;
16INIT ; -- set up inital variables
17 S U="^",VALMCNT=0,VALMBG=1
18 K ^TMP("IBNSM",$J),^TMP("IBNSMDX",$J)
19 ;K I,X,SDBEG,SDEND,SDB,XQORNOD,SDFN,SDCLN,DA,DR,DIE,DNM,DQ
20 S DIR(0)="350.9,4.02",DIR("A")="Select Patient Name or Insurance Co."
21 D ^DIR K DIR I $D(DIRUT) S VALMQUIT="" G INITQ
22 S IBY=Y
23 I IBY["DPT(" S IBTYP="P",DFN=+IBY D BLD
24 I IBY["DIC(" S IBTYP="I",IBCNS=+IBY D EN^VALM("IBCNS INSURANCE COMPANY") S VALMQUIT=""
25 ;
26INITQ Q
27 ;
28 ;
29PAT ; -- select patient you are working with
30 N DPTNOFZY S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups
31 S DIC(0)="AEQMN",DIC="^DPT(" D ^DIC I +Y<1 S VALMQUIT="" Q
32 S DFN=+Y
33 Q
34 ;
35 ;
36BLD ; -- build list of bills
37 K ^TMP("IBNSM",$J),^TMP("IBNSMDX",$J)
38 N I,J,K,IBHOLD,IBGRP,IBINS,IBCNT,IBCDFND,IBCPOLD
39 S (IBN,IBCNT,VALMCNT)=0,IBFILE=2
40 ;
41 ; -- find all ins. co data
42 K IBINS S IBINS=0
43 D POL^IBCNSU41(DFN)
44 D ALL^IBCNS1(DFN,"IBINS")
45 I $G(IBINS(0)) S K=0 F S K=$O(IBINS(K)) Q:'K D
46 .; -- add to list
47 .W "."
48 .S IBCNT=IBCNT+1
49 .S IBCDFND=$G(IBINS(K,0))
50 .S IBCDFND1=$G(IBINS(K,1))
51 .S IBCPOLD=$G(^IBA(355.3,+$P($G(IBINS(K,0)),"^",18),0))
52 .S X=""
53 .S X=$$SETFLD^VALM1(IBCNT,X,"NUMBER")
54 .I $D(^DIC(36,+IBCDFND,0)) S X=$$SETFLD^VALM1($P(^(0),"^"),X,"NAME")
55 .S X=$$SETFLD^VALM1($E($P(IBCDFND,"^",2),1,14),X,"POLICY")
56 .S IBHOLD=$P(IBCDFND,"^",6),X=$$SETFLD^VALM1($S(IBHOLD="v":"SELF",IBHOLD="s":"SPOUSE",IBHOLD="o":"OTHER",1:"UNKNOWN"),X,"HOLDER")
57 .S X=$$SETFLD^VALM1($E($$GRP^IBCNS($P(IBCDFND,"^",18)),1,10),X,"GROUP")
58 .S X=$$SETFLD^VALM1($$DAT1^IBOUTL($P(IBCDFND,"^",8)),X,"EFFDT")
59 .S X=$$SETFLD^VALM1($$DAT1^IBOUTL($P(IBCDFND,"^",4)),X,"EXPIRE")
60 .S X=$$SETFLD^VALM1($E($P($G(^IBE(355.1,+$P(IBCPOLD,"^",9),0)),U),1,8),X,"TYPE")
61 .S X=$$SETFLD^VALM1($P($G(^IBE(355.1,+$P($G(^IBA(355.3,+$P(IBCDFND,"^",18),0)),"^",9),0)),"^"),X,"TYPEPOL")
62 .S X=$$SETFLD^VALM1($E($P($G(^VA(200,+$P(IBCDFND1,"^",4),0)),U),1,15),X,"VERIFIED BY")
63 .S X=$$SETFLD^VALM1($$DAT1^IBOUTL($P(IBCDFND1,"^",3)),X,"VERIFIED ON")
64 .S X=$$SETFLD^VALM1($$YN($P(IBCPOLD,"^",6)),X,"PRECERT")
65 .S X=$$SETFLD^VALM1($$YN($P(IBCPOLD,"^",5)),X,"UR")
66 .S X=$$SETFLD^VALM1($$YN($P(IBCDFND,"^",20)),X,"COB")
67 .K IBHOLD,IBGRP
68 .D SET(X)
69 I '$D(^TMP("IBNSM",$J)) D
70 .S VALMCNT=2,IBCNT=2,^TMP("IBNSM",$J,1,0)=" "
71 .S ^TMP("IBNSM",$J,2,0)=" No Insurance Policies on file for this patient."
72 S X=$G(^IBA(354,DFN,60)) I X D
73 .S IBCNT=IBCNT+1
74 .S ^TMP("IBNSM",$J,IBCNT,0)=" Verification of No Coverage "_$$FMTE^XLFDT(X)
75BLDQ ;
76 Q
77 ;
78SET(X) ; -- set arrays
79 S VALMCNT=VALMCNT+1,^TMP("IBNSM",$J,VALMCNT,0)=X
80 S ^TMP("IBNSM",$J,"IDX",VALMCNT,IBCNT)=""
81 S ^TMP("IBNSMDX",$J,IBCNT)=VALMCNT_"^"_IBFILE_"^"_DFN_"^"_K_"^"_IBCDFND
82 Q
83 ;
84HDR ; -- screen header for initial screen
85 D PID^VADPT
86 S VALMHDR(1)="Insurance Management for Patient: "_$E($P($G(^DPT(DFN,0)),"^"),1,20)_" "_$E($G(^(0)),1)_VA("BID")
87 S VALMHDR(2)=" "
88 I +$$BUFFER^IBCNBU1(DFN) S VALMHDR(2)="*** Patient has Insurance Buffer Records"
89 Q
90 ;
91FNL ; -- exit and clean up
92 K ^TMP("IBNSM",$J),^TMP("IBNSMDX",$J)
93 K IBFASTXT
94 D CLEAN^VALM10
95 Q
96 ;
97YN(X,Y) ; -- convert 1 or 0 to yes/no/unknown
98 Q $S($G(X)="":$S($G(Y):"",1:"UNK"),X=0:"NO",X=1:"YES",1:"")
99 ;
100CP ; -- change patient
101 N VALMQUIT
102 D FULL^VALM1
103 S IBDFN=DFN D PAT
104 I $D(VALMQUIT) S DFN=IBDFN
105 D HDR,BLD
106 S VALMBCK="R"
107CPQ K IBDFN
108 Q
109 ;
110PCI S VALMBCK="R" Q
111 ;
112FASTEXIT ;just sets a flag signaling system should be exited
113 S VALMBCK="Q"
114 D FULL^VALM1
115 K DIR S DIR(0)="Y",DIR("A")="Exit option entirely",DIR("B")="NO" D ^DIR
116 I $D(DIRUT)!(Y) S IBFASTXT=1
117 K DIR
118 Q
Note: See TracBrowser for help on using the repository browser.