$TXT Created by HUA,PATRICK at MNTVBB.FO-ALBANY.MED.VA.GOV (KIDS) on Wednesday, 01/05/05 at 11:54 ============================================================================= Run Date: JAN 07, 2005 Designation: DG*5.3*570 Package : DG - REGISTRATION Priority: Mandatory Version : 5.3 SEQ #549 Status: Released Compliance Date: FEB 07, 2005 ============================================================================= Associated patches: (v)DG*5.3*26 <<= must be installed BEFORE `DG*5.3*570' (v)DG*5.3*69 <<= must be installed BEFORE `DG*5.3*570' (v)DG*5.3*108 <<= must be installed BEFORE `DG*5.3*570' (v)DG*5.3*113 <<= must be installed BEFORE `DG*5.3*570' (v)DG*5.3*279 <<= must be installed BEFORE `DG*5.3*570' (v)DG*5.3*358 <<= must be installed BEFORE `DG*5.3*570' (v)DG*5.3*366 <<= must be installed BEFORE `DG*5.3*570' (v)DG*5.3*515 <<= must be installed BEFORE `DG*5.3*570' (v)DG*5.3*528 <<= must be installed BEFORE `DG*5.3*570' (v)DG*5.3*546 <<= must be installed BEFORE `DG*5.3*570' (v)DG*5.3*564 <<= must be installed BEFORE `DG*5.3*570' (v)IB*2*267 <<= must be installed BEFORE `DG*5.3*570' (v)DG*5.3*617 <<= must be installed BEFORE `DG*5.3*570' Subject: IB/AR ENCAP W/REGISTRATION Category: - Routine Description: ============ This patch is in support of the Billing Replacement - Encapsulation Project. The objective of this project is to standardize existing VistA Integrated Billing and Accounts Receivable functionality so that a new COTS billing/AR product may be effectively integrated into the VistA suite. This will be accomplished by replacing direct IB and AR touch points with standard authorized APIs available to all VistA packages. This patch will replace with new APIs, all current direct access of Insurance Information from FileMan globals and the use of IB APIs being retired (DBIA10145 and DBIA10146) in the VistA Registration package. These IAs provided supported APIs to retrieve and display insurance information. A new supported API, $$INSUR^IBBAPI DBIA4419), is being provided to retrieve insurance information. A new private API, DISP^DGIBDSP (DBIA4408), will provide a generic display of a patient's current insurance information. The IBBAPI calls were released with patch IB*2*256, IB INSURANCE API. This patch addresses the following E3R(s): ------------------------------------------ There are no E3Rs associated with this patch. This patch addresses the following NOIS message(s): --------------------------------------------------- There are no NOIS messages associated with this patch. Test Sites: ----------- Clarksburg, WV - VAMC EL PASO VA HEALTH CARE CENTER MANCHESTER, NH -VAMC Functional Modifications ------------------------ For the most part, the changes made by this patch are invisible to the user as the changes are in the underlying functionality on how insurance information is retrieved. VA 10-10 Automated Forms: The 10/10 Print without New registration [DG REGISTRATION 10/10 REPRINT] option re-prints the VA 1010T, 10/10, and 1010I forms. These forms have been modified to use the $$INSUR^IBBAPI API call to retrieve and print the patient's insurance information in preparation for the eventual migration to a COTS billing/AR product. Patient Review Document: The Patient Review Document [DG THIRD PARTY PATIENT REVIEW] displays patient insurance and billing information for review as part of the Admit a Patient [DG ADMIT PATIENT] option. This document has been modified to use the $$INSUR^IBBAPI API call. Note, this call does not currently return the Pre-certification or Billing telephone numbers. As a result, this information will not be presented on the revised document. Third Party Reimbursement: The Veteran Patient Insurance Information [DG THIRD PARTY REIMBURSEMENT] option provides insurance information on veteran inpatients and indicates whether or not the policy shown will reimburse the VA for the cost of medical care. This report has been modified to retrieve the appropriate insurance information from the $$INSUR^IBBAPI API. UR Admission Bulletin: After the patient admission is completed, the UR Claims Tracking Admission Bulletin is generated and sent to the DGPM UR ADMISSION mail group. This bulletin includes admission and insurance information. This bulletin has been modified to retrieve appropriate insurance information from the $$INSUR^IBBAPI API. Patient Load/Edit: If the Patient Load/Edit screen is called from the DGPRE PRE-REGISTER MENU, additional audit information is displayed as part of the Patient Demographic Data, Screen <1>. This includes insurance companies and the date the company was entered for the patient. The new Insurance API ($$INSUR^IBBAPI) does not currently provide any Date Entered information as was stored in node 1 of the INSURANCE TYPE sub file (#2.312) of the PATIENT file (#2). The display has been modified to display Effective and Expiration dates for the insurance. Additionally, the routine code which displays the insurance information on the Insurance Data, Screen <5>, has been cleaned up. Insurance information presented through the DISP^IBCNS call (DBIA10146) is being replaced with a display provided by a new DG API (DISP^DGIBDSP - DBIA4408). Eligibility Inquiry for Patient Billing: The Eligibility Inquiry for Patient Billing [DG PATIENT ELIGIBILITY INQUIRY] option displays the Means Test status, rated disabilities and insurance information for a patient. The insurance information has been modified to check for insurance companies through the new insurance API. Insurance information presented through the DISP^IBCNS call (DBIA10146) is being replaced with a display provided by a new DG API (DISP^DGIBDSP - DBIA4408). 10-10T Registration Screen: The insurance portion of the 10-10T Registration Screen [DGRPT 10-10T REGISTRATION] for existing insurance companies has been modified to retrieve appropriate insurance information from the new insurance API. Note: the "Covered by Health Insurance:" field is populated from the COVERED BY HEALTH INSURANCE? Field (#.3192) of the PATIENT File (#2), which is a set of codes populated outside the actual insurance information in the INSURANCE TYPE sub-file (#2.312) and is not determined by the results in the Insurance API. Gains & Losses Sheet for Admissions: The Gains and Losses (G&L) Sheet [DG G&L SHEET] option prints a plus "+" next to the patient if they had any reimbursable insurance when they were admitted. The Gains and Losses (G&L) Sheet [DG G&L SHEET] has been modified to use the new insurance API to determine whether a policy is reimbursable. Consistency Checker: The consistency checker is run when exiting Load/Edit Patient Data [DG LOAD PATIENT DATA] option. The checker has been modified to compare the value of the COVERED BY HEALTH INSURANCE? Field (#.3192) with whether the patient has any Insurance entries as returned by the new insurance API (DISP^DGIBDSP - DBIA4408). If there is a mismatch, i.e. the "COVERED BY HEALTH INSURANCE?" field is "NO" but the patient has entries returned by the new API, an inconsistency is set. Inconsistency results: When user answers the COVERED BY HEALTH INSURANCE prompt YES but either there are no policies entered or all of those entered have expired: COVERED BY INSURANCE NOT ANSWERED YES BUT ACTIVE POLICIES ON FILE When the COVERED BY INSURANCE prompt is either not answered or answered other than YES and yet ACTIVE policies are found to be on file: COVERED BY INSURANCE NOT ANSWERED YES BUT ACTIVE POLICIES ON FILE ================INSTALLATION INSTRUCTIONS ================= If installed during the normal workday, it is recommended that the following menu options (File #19) and all of their descendants be disabled to prevent possible conflicts while running the KIDS Install. Other VISTA users will not be affected. Since the Load/Edit Patient Data option is affected, it is highly recommended that this patch be installed during off hours to minimize user impact. 10/10 Print without New Registration Veteran Patient Insurance Information Patient Review Document Preregistration Menu Load/Edit Patient Data Eligibility Inquiry for Patient Billing 10-10T Registration Gains and Losses (G&L) Sheet Install Time - 5 MINUTES 1. LOAD TRANSPORT GLOBAL --------------------- Choose the PackMan message containing this patch and invoke the INSTALL/CHECK MESSAGE PackMan option. 2. DISABLE ROUTINE MAPPING (DSM for Open VMS sites only) ----------------------- Disable routine mapping on all systems for the routines listed in step 3 below. NOTE: If the routines included in this patch are not currently in your mapped routine set, please skip this step. 3. COMPONENTS SENT WITH PATCH ------------------------ The following is a list of the routines included in this patch. The second line of each of these routines now looks like: ;;5.3;Registration;**[patch list]**;Aug 13, 1993 CHECK^XTSUMBLD results Routine name Before Patch After Patch Patch List ============ ============ =========== ========== DG1010P5 7501466 8122566 570 DG1010PA 5800775 5804820 18,28,86,108,113 570 DG3PR0 7609656 7968577 26,69,570 DG3PR1 4503787 4416573 26,570 DG3PR2 13000141 11983076 26,606,617,570 DGBLRV 14394672 12396327 26,570 DGIBDSP N/A 3035598 570 DGPMGLG5 4470914 3004541 34,137,515,570 DGPMVBUR 7592674 7135909 26,31,483,549,570 DGRP1 15171359 15408542 109,161,506,244,546 570 DGRP5 4100611 2466043 190,366,570 DGRPC2 14470769 14442275 45,69,108,121,205 218,342,387,470,467 489,505,507,528,451 564,570 DGRPDB 8275827 6840010 26,50,358,570 DGRPTL3 6366294 5931283 108,570 DGRPTP2 4494857 4478425 108,570 DGUTL 10711304 10317369 279,570 Total number of routines - 16 4. START UP KIDS ------------- Start up the Kernel Installation and Distribution System Menu [XPD MAIN]: Edits and Distribution ... Utilities ... Installation ... Select Kernel Installation & Distribution System Option: INStallation --- Load a Distribution Print Transport Global Compare Transport Global to Current System Verify Checksums in Transport Global Install Package(s) Restart Install of Package(s) Unload a Distribution Backup a Transport Global Select Installation Option: 5. Select Installation Option: -------------------------- NOTE: The following are OPTIONAL - (When prompted for the INSTALL NAME, enter DG*5.3*570): a. Backup a Transport Global - This option will create a backup message of any routines exported with this patch. It will not backup any other changes such as DD's or templates. b. Compare Transport Global to Current System - This option will allow you to view all changes that will be made when this patch is installed. It compares all components of this patch (routines, DD's, templates, etc.). c. Verify Checksums in Transport Global - This option will allow you to ensure the integrity of the routines that are in the transport global. 6. Select Installation Option: Install Package(s) ---------------- **This is the step to start the installation of this KIDS patch: a. Choose the Install Package(s) option to start the patch install. b. When prompted 'Want KIDS to INHIBIT LOGONs during the install? YES//' answer NO c. When prompted 'Want to DISABLE Scheduled Options, Menu Options, and Protocols? YES//' answer YES d. When prompted 'Enter options you wish to mark as 'Out Of Order':' Enter the following options: [DG REGISTRATION 10/10 REPRINT] 10/10 Print without New Registration [DG THIRD PARTY REIMBURSEMENT] Veteran Patient Insurance Information [DG THIRD PARTY PATIENT REVIEW] Patient Review Document [DGPRE PRE-REGISTER MENU] Preregistration Menu [DG LOAD PATIENT DATA] Load/Edit Patient Data [DG PATIENT ELIGIBILITY INQUIRY] Eligibility Inquiry for Patient Billing [DGRPT 10-10T REGISTRATION] 10-10T Registration [GAINS AND LOSSES (G&L) SHEET DG G&L SHEET] Gains and Losses (G&L) Sheet e. When prompted 'Enter protocols you wish to mark as 'Out Of Order':' press . 7. REBUILD MAPPED ROUTINE(S) (DSM for Open VMS sites only) ------------------------- Optional - Include the routines distributed with this patch in the mapped routine set. NOTE: This step is only necessary if you performed step 2 or if you wish to include the routines in your mapped set. Routine Information: ==================== Routine Name: - DG1010P5 This routine is part of the Automated VA Form 10-10. This code checks and prints information in PART V of the 10-10 form, Eligibility Status Data, Sections 5A & 5B, Does veteran have health insurance coverage and if "Yes", Coverage Provided By. coverage provided by. Before: ======= 12 W !,"5A. DOES PATIENT HAVE HEALTH INSURANCE",?44,"| ","5B. IF YES, C OVERAGE PROVIDED BY:" 13 W !?4,"COVERAGE: ",$$YN2(DGP(.31),11),?44,"| ",?50 14 I X'="Y" W "NOT APPLICABLE" G GI 15 INSINFO ; 16 S (DGVT,DGSP,DGOT)="" 17 F DGINS=0:0 S DGINS=$O(^DPT(DFN,.312,DGINS)) Q:DGINS'>0 D 18 .S DGI=^DPT(DFN,.312,DGINS,0) 19 .I $S(($P(DGI,U,8)>(9999999-DFN1)):1,($P(DGI,U,4)']""):0,((9999999-D FN1)>$P(DGI,U,4)):1,1:0) Q 20 .I $P(DGI,U,6)="v" S DGVT="PATIENT'S INSURANCE" 21 .I $P(DGI,U,6)="s" S DGSP="SPOUSE'S INSURANCE" 22 .I $P(DGI,U,6)="o" S DGOT="OTHER" 23 I DGVT_DGSP_DGOT="" W "NO ACTIVE (UNEXPIRED) INSURANCE ON FILE FOR T HIS APPLICANT" 24 I DGVT_DGSP_DGOT'="" W DGVT_$S((DGVT'="")&((DGSP_DGOT)'=""):" & ",1: "")_DGSP_$S((DGOT'="")&((DGVT_DGSP)'=""):" & ",1:"")_DGOT 25 GI W ?131,$C(13),DGLUND After: ====== 12 W !,"5A. DOES PATIENT HAVE HEALTH INSURANCE",?44,"| ","5B. IF YES, C OVERAGE PROVIDED BY:" 13 N DGIB,DGIBA,DGYN,DGIB8,DGIB4,DGINS,DGX ; changes for DG*570 14 S DGYN=$$INSUR^IBBAPI(DFN,,"R",.DGINS,"1,10,11,12") 15 W !?4,"COVERAGE: ",$S(DGYN:"YES",1:"NO"),?44,"| ",?50 16 I 'DGYN W "NOT APPLICABLE" G GI 17 INSINFO ; 18 S (DGVT,DGSP,DGOT)="",DGX=0 19 F S DGX=$O(DGINS("IBBAPI","INSUR",DGX)) Q:'DGX D 20 . S DGIB8=$G(DGINS("IBBAPI","INSUR",DGX,10)),DGIB4=$G(DGINS("IBBAPI" ,"INSUR",DGX,11)) 21 . I $S((DGIB8>(9999999-DFN1)):1,(DGIB4']""):0,((9999999-DFN1)>DGIB4) :1,1:0) Q 22 . I $P(DGINS("IBBAPI","INSUR",DGX,12),U,1)="P" S DGVT="PATIENT'S INS URANCE" 23 . I $P(DGINS("IBBAPI","INSUR",DGX,12),U,1)="S" S DGSP="SPOUSE'S INSU RANCE" 24 . I $P(DGINS("IBBAPI","INSUR",DGX,12),U,1)="O" S DGOT="OTHER" 25 I DGVT_DGSP_DGOT="" W "NO ACTIVE (UNEXPIRED) INSURANCE ON FILE FOR T HIS APPLICANT" 26 I DGVT_DGSP_DGOT'="" W DGVT_$S((DGVT'="")&((DGSP_DGOT)'=""):" & ",1: "")_DGSP_$S((DGOT'="")&((DGVT_DGSP)'=""):" & ",1:"")_DGOT 27 GI W ?131,$C(13),DGLUND Routine Checksum: Routine Name: - DG1010PA This routine handles the prompts for the DG REGISTRATION 10/10 REPRINT (DG1010P). If the patient has does not have insurance information, the 10-10I prompt is not presented. The Insurance API replaces the $DATA call on the INSURANCE TYPE Sub file (#2.312) in the PATIENT File (#2). BEFORE ====== 49 FAILCOND(DGX) -- ;CHECKS IF PROMPT SHOULD BE ASKED 50 ; DGI: 2=NO;1=YES;-1=DIRUT 51 ;RETURNS 1=DON'T ASK AND SKIP TO NEXT;0=ASK 52 ; 53 N DGFAIL 54 S DGFAIL=0 55 I DGX=1010 G QTFAIL 56 I DGX="1010I" D G QTFAIL 57 .I '($O(^DPT(DFN,.312,0))) S DGFAIL=1 58 I DGX="THIRD" F D Q:$G(%) G QTFAIL AFTER ===== 49 FAILCOND(DGX) -- ;CHECKS IF PROMPT SHOULD BE ASKED 50 ; DGI: 2=NO;1=YES;-1=DIRUT 51 ;RETURNS 1=DON'T ASK AND SKIP TO NEXT;0=ASK 52 ; 53 N DGFAIL 54 S DGFAIL=0 55 I DGX=1010 G QTFAIL 56 I DGX="1010I" D G QTFAIL 57 . I '($$INSUR^IBBAPI(DFN)) S DGFAIL=1 58 I DGX="THIRD" F D Q:$G(%) G QTFAIL Routine Checksum: Routine Name: - DG3PR0 This routine prints the DG1010I form. The form template is stored in the MAS FORMS AND SCREENS File (#47). Place holders "{}" are replaced with the appropriate parsed data value as the form prints. The Insurance API replaces the call to the ALL^IBCNS1 API (DBIA10145). The ^UTILITY global was used to hold the Insurance Nodes returned from the ALL() API. The format of the data returned from the new insurance API requires that this same data structure be replicated in the ^UTILITY global to work with the form template. Note: This routine "assumes" two insurance company entries will be returned in its array indexing. Before ====== 3 START K ^UTILITY($J) S (N(1),N(0),DG(1),DG(0))="" D ALL^IBCNS1(DFN,"DGIBIN S",1) F I=0:0 S I=$O(DGIBINS(I)) Q:'I S L=DGIBINS(I,0),M=$P(L,U,6) ,M=$S(M']"":0,1:M),^UTILITY($J,M,I)=L 4 F I="v",0,"s","o" I $D(^UTILITY($J,I)) S DG(0)=^($O(^(I,0))),N(0)=I Q 5 F I="v",0,"s","o" I $D(^UTILITY($J,I)) S L=$S(N(0)=I:$O(^($O(^(I,0)) )),1:$O(^(I,0))) I L>0 S DG(1)=^UTILITY($J,I,L),N(1)=I Q 6 ;K ^UTILITY($J) 19 SET S A=DG(I),A=$S($D(^DIC(36,+A,0)):^(0),1:""),B=$G(^DIC(36,+DG(I),.11) ),Y=$P(B,U,6) D ZIPOUT^VAFADDR S X=$P(B,U,4,5)_U_Y D AD2 20 S X(I)=$P(A,U,1)_U_$P($G(^DIC(36,+DG(I),.13)),U,1)_U_$P(B,U,1)_U_X_U _$P(DG(I),U,2)_U_$P(DG(I),U,3)_U,Y=$P(DG(I),U,8) X ^DD("DD") S X(I) =X(I)_Y_U,Y=$P(DG(I),U,7) X ^DD("DD") S X(I)=X(I)_Y 21 S N=$S(N(I)="s":$P(DG(I),U,17)_U_"SPOUSE",(N(I)=0!(N(I)="v")):$P(D(0 ),U,1)_U_"SAME",1:$P(DG(I),U,17)_U) 22 S E=$S(N(I)=0!(N(I)="v"):D(.311),N(I)="s":D(.25),1:"^^^^") 23 S X=$P(DG(I),U,12,14) D AD2 S X1(I)=N_U_E,X2(I)=$P(DG(I),U,9,11)_U_X 24 Q After ===== 3 START K ^UTILITY($J) 4 N DGIBB,DGX,DGINS,DGBLD 5 S (N(1),N(0),DG(1),DG(0))="" 6 I $$INSUR^IBBAPI(DFN,,,.DGIBB,"*") 7 S DGX="DGIBB(""IBBAPI"",""INSUR"")" M DGINS=@DGX 8 ; 9 F I=0:0 S I=$O(DGINS(I)) Q:'I D 10 . S L=+DGINS(I,1) 11 . S M=$P($G(DGINS(I,12)),U) 12 . S M=$S(M="P":"v",M="S":"s",M="O":"o",1:0) 13 . S DGBLD=L ; ID Number 14 . S $P(DGBLD,U,2)=DGINS(I,14) ; Subscriber ID 15 . S $P(DGBLD,U,3)=DGINS(I,18) ; Group Policy No. 16 . S $P(DGBLD,U,4)=DGINS(I,11) ; Expiration Date 17 . S $P(DGBLD,U,6)=M ; Subscriber Relationship (Whose Insurance) 18 . S $P(DGBLD,U,8)=DGINS(I,10) ; Effective Date 19 . S $P(DGBLD,U,16)=$S(M="v":"01",M="s":"02",M="o":"09",1:"09") ; (Pt . Relationship to Insured - Derived) 20 . S $P(DGBLD,U,17)=DGINS(I,13) ; Subscriber Name 21 . S $P(DGBLD,U,18)=+DGINS(I,8) ; Group Plan (Policy Name) 22 . S $P(DGBLD,U,20)=+DGINS(I,7) ; Coord. of Benefits 23 . S $P(DGBLD,U,30)=I ; Save of Insurance API Index 24 . S ^UTILITY($J,M,L)=DGBLD 42 SET ; 43 N DGX 44 S DGX=$P($G(DG(I)),U,30) 45 S A=$S(DGX>0:$P(DGINS(DGX,1),U,2),1:"") ; Insurance Co. Name 46 S X="" 47 S:DGX>0 X=DGINS(DGX,3)_", "_$P(DGINS(DGX,4),U,2)_" "_DGINS(DGX,5) 48 ; 49 S X(I)=A_U_$S(DGX>0:DGINS(DGX,6),1:"")_U_$S(DGX>0:DGINS(DGX,2),1:"") _U_X_U_$P(DG(I),U,2)_U_$P(DG(I),U,3)_U 50 S Y=$S(DGX>0:DGINS(DGX,10),1:""),Y=$$FMTE^XLFDT(Y) ; Effective Date of Policy 51 S X(I)=X(I)_Y_U 52 S Y="",Y=$$FMTE^XLFDT(Y) ; Renewal Date (Not available in Insurance API) 53 S X(I)=X(I)_Y 54 ; 55 S N=$S(N(I)="s":$P(DG(I),U,17)_U_"SPOUSE",(N(I)=0!(N(I)="v")):$P(D(0 ),U,1)_U_"SAME",1:$P(DG(I),U,17)_U) 56 S E=$S(N(I)=0!(N(I)="v"):D(.311),N(I)="s":D(.25),1:"^^^^") 57 S X=$P(DG(I),U,12,14) D AD2 S X1(I)=N_U_E,X2(I)=$P(DG(I),U,9,11)_U_X 58 Q Routine Checksum: Routine Name: - DGRPTP2 This routine prints the 10-10T form. Sets up sections 14A and 14B from insurance information returned in ALL^IBCNS1 Before ====== 27 ;Insurance 28 W !,"14A. Do You Have Health Coverage",?40,"|14B. Name of Health Ins| urance Carrier" 29 S DGRP(.31)=$G(^DPT(DFN,.31)) ;insurance 30 S Y=$P(DGRP(.31),U,11),C=$P(^DD(2,.3192,0),U,2) D Y^DIQ 31 W !,?5,$S(Y'="":Y,1:"UNANSWERED") 32 D ALL^IBCNS1(DFN,"DGINS",1,DT) 33 S (C,I)=0 F S I=$O(DGINS(I)) Q:'I S DGINS=DGINS(I,0) D 34 . S C=C+1 35 . W:C>1 ! 36 . W ?40,"| ",$$POINT^DG1010P0(DGINS,1,36)| 37 I '$D(DGINS) D 38 . W ?40,"| ","NO ACTIVE (UNEXPIRED) INSURANCE ON FILE FOR THIS APPLICANT" 39 W ?131,$C(13) W:DGLNE("ULC")="-" ! W DGLNE("UL") 40 Q After ===== 28 ;Insurance 29 W !,"14A. Do You Have Health Coverage",?40,"|14B. Name of Health Insurance Carrier" 30 S Y=$$GET1^DIQ(2,DFN,.3192) 31 W !,?5,$S(Y'="":Y,1:"UNANSWERED") 32 S DGIBAPI=$$INSUR^IBBAPI(DFN,DT,"",.DGDATA,1) 33 S DGX="DGDATA(""IBBAPI"",""INSUR"")" M DGINS=@DGX 34 S (C,I)=0 F S I=$O(DGINS(I)) Q:'I S DGINS=DGINS(I,1) D 35 . S C=C+1 36 . W:C>1 ! 37 . W ?40,"| ",$P(DGINS,U,2) 38 I '$D(DGINS) D 39 . W ?40,"| ","NO ACTIVE (UNEXPIRED) INSURANCE ON FILE FOR THIS APPLICANT" 40 W ?131,$C(13) W:DGLNE("ULC")="-" ! W DGLNE("UL") 41 Q Routine Checksum: Routine Name: - DG3PR1 3rd PARTY REIMBURSEMENT SORT/PRINT. The Veteran Patient Insurance Information option provides insurance information on veteran inpatients. This includes such information as insurance company, insurance number, group number, and insurance expiration date. The form indicates whether or not the policy shown will reimburse the VA for the cost of medical care. If the REIMBURSE field of the INSURANCE COMPANY file is set to NO for any of the companies that cover the applicant, an asterisk (*) will be shown next to the insurance company name. This routine checks whether there is insurance information available for the patient. Before ====== 8 S DFN=$P(DGAD,"^",3) I $S('DFN:1,'$D(^DPT(DFN,0)):1,'$O(^DPT(DFN,.312,0)):1,'$D(^DPT(DFN,"VET")): 1,$P(^("VET"),"^",1)'="Y":1,1:0) Q After ===== 8 S DFN=$P(DGAD,"^",3) 9 I $S('DFN:1,'$D(^DPT(DFN,0)):1,'$$INSUR^IBBAPI(DFN,"","R"):1,'$D(^DP T(DFN,"VET")):1,$P(^("VET"),"^",1)'="Y":1,1:0) Q Routine Checksum: Routine Name: - DG3PR2 This routine prints the Third party Reimbursement data. Before ====== 4 D ALL^IBCNS1(DFN,"DGIBINS") F I=0:0 S I=$O(DGIBINS(I)) Q:'I S J=DGI BINS(I,0) S X=$G(^DIC(36,+J,0)) W !,$S($P(X,"^",2)="N":"*",1:""),$E ($P(X,"^",1),1,22),?24,$P(J,"^",2),?45,$P(J,"^",3) S DGINS=$S($P(X, "^",2)="N":1,1:0) D INS2 5 I DGINS W !?22,"* - Insurer may not reimburse!" 6 K DGINS,DGIBINS 34 INS2 ;insurance data continued 35 I $P(X,"^",2)="N" S DGINS=1 36 S X=$P(J,"^",4) W:X]"" ?63,$E(X,4,5),"/",$E(X,6,7),"/",$E(X,2,3) S X =$P(J,"^",6) W ?73,$S(X="v":"VETERAN",X="s":"SPOUSE",X="o":"OTHER", 1:"UNKNOWN") 37 Q After ===== 4 N DGX,DGDATA 5 I $$INSUR^IBBAPI(DFN,,"R",.DGDATA,"1,8,9,11,12,14,18") 6 S DGX="DGDATA(""IBBAPI"",""INSUR"")" M DGIBINS=@DGX 7 F I=0:0 S I=$O(DGIBINS(I)) Q:'I D 8 . W !,$S('+DGIBINS(I,9):"*",1:" "),$E($P(DGIBINS(I,1),"^",2),1,22),? 24,DGIBINS(I,14),?45 9 . I $D(DGIBINS(I,18)) W $G(DGIBINS(I,18)) ; Group Policy Number 10 . S DGINS=$S($P(DGIBINS(I,9),U,2)="NO":1,1:0) D INS2 11 ; 12 I DGINS W !?22,"* - Insurer may not reimburse!" 13 K DGINS,DGIBINS 41 INS2 ;insurance data continued 42 I $P(DGIBINS(I,9),U,2)="NO" S DGINS=1 43 S X=DGIBINS(I,11) W:X]"" ?63,$$FMTE^XLFDT(X,"2D") 44 S X=$P(DGIBINS(I,12),U) W ?73,$S(X="P":"VETERAN",X="S":"SPOUSE",X="O ":"OTHER",1:"UNKNOWN") 45 Q Routine Checksum: Routine Name: - DGBLRV This routine prints the Patient Review Document [DG THIRD PARTY PATIENT REVIEW] which displays patient insurance and billing information for review as part of the Admit a Patient option. Answer "YES" to the "PRINT THIRD PARTY REVIEW? No//" prompt Before ====== 15 INS ; -- new insurance logic 16 N DGIBINS,DGIBDT 17 S DGIBDT=$S($D(DGPMDA):+$G(^DGPM(DGPMDA,0)),$G(DGSDT):DGSDT,1:DT) 18 D ALL^IBCNS1(DFN,"DGIBINS",2,DGIBDT) 19 S P=1 20 I $G(DGIBINS(0)) F I=0:0 S I=$O(DGIBINS(I)) Q:'I D 21 .S DGINS=$G(DGIBINS(I,0)) I $P(DGINS,U,4)>DT!($P(DGINS,U,4)="") K DG INAD D:DGI ADDR S I(P)=+DGINS_U_$P(DGINS,U,2)_U_$P(DGINS,U,3)_U_$P( DGINS,U,5)_U_$S($D(DGINAD):DGINAD,1:"NO ADDRESS ON FILE"),P=P+1 22 ; 31 ADDR S DGIMULT=$S($D(^DIC(36,+DGINS,.11)):^(.11),1:"") Q:DGIMULT="" 32 S DGINAD=$S($P(DGIMULT,U,1)]"":$P(DGIMULT,U,1)_", ",1:"")_$S($P(DGIM ULT,U,2)]"":$P(DGIMULT,U,2)_", ",1:"")_$S($P(DGIMULT,U,3)]"":$P(DGI MULT,U,3)_", ",1:"")_$S($P(DGIMULT,U,4)]"":$P(DGIMULT,U,4)_", ",1:" ") 33 S DGINAD=DGINAD_$S('$D(^DIC(5,+$P(DGIMULT,U,5),0)):"",$P(^(0),U,1)]" ":$P(^(0),U,1)_", ",1:"")_$S($L($P(DGIMULT,U,6))>5:$E($P(DGIMULT,U, 6),1,5)_"-"_$E($P(DGIMULT,U,6),6,9),1:$P(DGIMULT,U,6)) Q 34 21 S Y=DT D DT^DIQ Q 35 31 W $P(DGINFO,U,1) Q 36 32 W VA("PID") Q 37 51 W $S('$D(I(P)):"",$D(^DIC(36,+I(P),0)):$P(^(0),U),1:"") Q 38 61 W $S($D(I(P)):$P(I(P),U,5),1:"") Q 39 71 W $S('$D(I(P)):"",$D(^DIC(36,$P(I(P),"^",K),.13)):$P(^(.13),"^",1),1 :"") Q 40 72 W $S($D(I(P)):$P(I(P),U,2),1:"") Q 41 73 W $S($D(I(P)):$P(I(P),U,3),1:"") Q 42 81 W $S('$D(I(P)):"",$D(^DIC(36,$P(I(P),"^",1),.13)):$P(^(.13),"^",3),1 :"") Q 43 82 W $S('$D(I(P)):"",$D(^DIC(36,$P(I(P),"^",1),.13)):$P(^(.13),"^",2),1 :"") Q 44 201 W $S($D(DGADX):DGADX,$D(DGSDX):DGSDX,1:"") Q 45 202 S X=$S(DGWD:DGWD,1:"-") W $S($D(^DIC(42,X,0)):$P(^(0),U,1),1:"") Q 46 211 W $S($D(DGSDT):DGSDT,1:"") Q 47 212 W $S($D(DGADT):DGADT,1:"") Q 48 ; 49 EN1 S DIC="^DGPM(",BY="@.01",L=0,FLDS="[DGPMBLRV]",DHD="@" 50 S DIS(0)="S DFN=$P(^DGPM(D0,0),U,3) I $P(^(0),""^"",2)=1,$D(^DPT(DFN ,""VET"")),($P(^(""VET""),""^"",1)=""Y""),$O(^DPT(DFN,.312,0))" 51 D EN1^DIP,QUIT K BY,DHD,DIC,DIS,FLDS,I Q 52 ; 53 CK ;check logic to see if 3rd party review is asked 54 ;***if this logic is altered, also change line EN1+1 in DIS(0)*** 55 I $S('$O(^DPT(DFN,.312,0)):1,'$D(^DPT(DFN,"VET")):1,^("VET")'="Y":1, 1:0) Q 56 ASK ;print TPR? After ===== 15 INS ; -- new insurance logic, modified for IBBAPI insurance call,DG*57 0 16 N DGIBINS,DGIBDT,DGDATA,DGIB,DGX 17 S DGIBDT=$S($D(DGPMDA):+$G(^DGPM(DGPMDA,0)),$G(DGSDT):DGSDT,1:DT) 18 S DGIBDT=$P(DGIBDT,".") 19 S DGIB=$$INSUR^IBBAPI(DFN,DGIBDT,"R",.DGDATA,"*") 20 S DGX="DGDATA(""IBBAPI"",""INSUR"")" M DGIBINS=@DGX 21 S P=1,I=0 22 I DGIB F S I=$O(DGIBINS(I)) Q:'I D 23 . I DGIBINS(I,11)>DT!(DGIBINS(I,11)="") D 24 . . K DGINAD D:DGI ADDR 25 . . S I(P)=+DGIBINS(I,1)_U_DGIBINS(I,14)_U 26 . . N DGGRP 27 . . S DGGRP=DGIBINS(I,18) ; Group Policy Number 28 . . S I(P)=I(P)_$G(DGGRP)_U 29 . . S I(P)=I(P)_$P(DGIBINS(I,8),U,2)_U_$S($D(DGINAD):DGINAD,1:"NO AD DRESS ON FILE") 30 . . S P=P+1 31 ; 40 ADDR ; 41 S DGINAD=$S(DGIBINS(I,2)]"":DGIBINS(I,2)_", ",1:"")_$S(DGIBINS(I,2)] "":DGIBINS(I,3)_", ",1:"")_$S(DGIBINS(I,4)]"":$P(DGIBINS(I,4),U,2)_ ", ",1:"")_$S(DGIBINS(I,5)]"":DGIBINS(I,5)_", ",1:"") 42 Q 43 21 S Y=DT D DT^DIQ Q 44 31 W $P(DGINFO,U,1) Q 45 32 W VA("PID") Q 46 51 W $S($D(DGIBINS(P)):$P(DGIBINS(P,1),U,2),1:"") Q 47 61 W $S($D(I(P)):$P(I(P),U,5),1:"") Q 48 71 W $S($D(DGIBINS(P)):DGIBINS(P,6),1:"") Q 49 72 W $S($D(I(P)):$P(I(P),U,2),1:"") Q 50 73 W $S($D(I(P)):$P(I(P),U,3),1:"") Q 51 81 W " " Q ; Pre-certification phone# not currently available in API 52 82 W " " Q ; Billing phone# not currently available in API 53 201 W $S($D(DGADX):DGADX,$D(DGSDX):DGSDX,1:"") Q 54 202 S X=$S(DGWD:DGWD,1:"-") W $S($D(^DIC(42,X,0)):$P(^(0),U,1),1:"") Q 55 211 W $S($D(DGSDT):DGSDT,1:"") Q 56 212 W $S($D(DGADT):DGADT,1:"") Q 57 ; 58 EN1 S DIC="^DGPM(",BY="@.01",L=0,FLDS="[DGPMBLRV]",DHD="@" 59 S DIS(0)="S DFN=$P(^DGPM(D0,0),U,3) I $P(^(0),""^"",2)=1,$D(^DPT(DFN ,""VET"")),($P(^(""VET""),""^"",1)=""Y""),$$INSUR^IBBAPI(DFN,""""," "A"")" 60 D EN1^DIP,QUIT K BY,DHD,DIC,DIS,FLDS,I Q 61 ; 62 CK ;check logic to see if 3rd party review is asked 63 ;***if this logic is altered, also change line EN1+1 in DIS(0)*** 64 I $S('$$INSUR^IBBAPI(DFN,"","A"):1,'$D(^DPT(DFN,"VET")):1,^("VET")'= "Y":1,1:0) Q 65 ASK ;print TPR? Routine Checksum: Routine Name: - DGPMVBUR This routine generates the UR Claims Tracking Admission Bulletin and sends it to the DGPM UR ADMISSION mail group. Use the Admit a Patient option to admit a patient. Make sure you are a member of the DGPM UR ADMISSION mail group. Before ====== 25 INS ;get insurance effective at time of admission, start at DGPMBLN=10 26 S DGPMBLN=9 27 K DGIBINS 28 D ALL^IBCNS1(DFN,"DGIBINS") F I=0:0 S I=$O(DGIBINS(I)) Q:'I S X=DGIBINS(I,0) D ACT 29 I $D(DGPMUR(10)) S DGPMLAST=DGPMBLN 30 Q 31 ; 32 ACT ;is insurance active? If so, set in DGPMBLN array 33 I $P(X,"^",4)<+DGPMA,$P(X,"^",4) Q ;insurance expired before admission 34 I $P(X,"^",8)>+DGPMA Q ;insurance effective after admission 35 Q:'$D(^DIC(36,+X,0)) S X1=^(0),X2=$S($D(^(.13)):^(.13),1:"") ;get Insurance company information 36 I $P(X1,"^",5)!($P(X1,"^",2)="N") Q ;insurance company is inactive or doesn't reimburse 37 S DGPMBL="Insurance Co. : "_$P(X1,"^",1) D SETLN 38 S DGTMP=$S(($P(X,"^",15)]""):$P(X,"^",15),1:$P(X,"^",3)) 39 I DGTMP]"" S DGPMBL="Group : "_DGTMP D SETLN 40 S DGPMBL="Policy Holder : "_$P(X,"^",17) D SETLN 41 S DGPMBL="Subscriber ID : "_$P(X,"^",2) D SETLN 42 S DGPMBL="Ins. Co Phone# : "_$S($P(X2,"^",2)]"":$P(X2,"^",2),$P(X2,"^",1)]"":$P(X2,"^",1),1:"UNKNOWN") D SETLN 43 S DGPMBL=" " D SETLN 44 Q After ===== 25 INS ;get insurance effective at time of admission, start at DGPMBLN=10 26 S DGPMBLN=9 27 K DGIBINS 28 N DGX,DGDATA,DGIB 29 ; 30 S DGIB=$$INSUR^IBBAPI(DFN,"","",.DGDATA,"*") ; Returns Active, Reimbursable Ins. only 31 S DGX="DGDATA(""IBBAPI"",""INSUR"")" M DGIBINS=@DGX 32 F I=0:0 S I=$O(DGIBINS(I)) Q:'I D ACT 33 ; 34 I $D(DGPMUR(10)) S DGPMLAST=DGPMBLN 35 Q 36 ; 37 ACT ;is insurance active? If so, set in DGPMBLN array 38 I DGIBINS(I,11)<+DGPMA,DGIBINS(I,11)]"" Q ;insurance expired before admission 39 I DGIBINS(I,10)>+DGPMA Q ;insurance effective after admission 40 Q:'+DGIBINS(I,1) 41 ; get insurance company information 42 S DGPMBL="Insurance Co. : "_$P(DGIBINS(I,1),"^",2) D SETLN 43 S DGTMP=$P(DGIBINS(I,8),U,2) 44 I DGTMP']"" S DGTMP=$S($G(DGIBNS(I,18))]"":DGIBINS(I,18),1:"") 45 I DGTMP']"" S DGTMP="" 46 I DGTMP]"" S DGPMBL="Group : "_DGTMP D SETLN 47 S DGPMBL="Policy Holder : "_DGIBINS(I,13) D SETLN 48 S DGPMBL="Subscriber ID : "_DGIBINS(I,14) D SETLN 49 S DGPMBL="Ins. Co Phone# : "_$S(DGIBINS(I,6)]"":DGIBINS(I,6),1:"UNKNOWN") D SETLN 50 S DGPMBL=" " D SETLN 51 Q Routine Checksum: Routine Name: - DGRP1 This routine displays additional insurance information for pre-registration in the patient demographic data screen in the Patient Load/Edit ([DGPRE PRE-REGISTER MENU] Preregistration Menu). The Insurance API does not provide any Date Entered information as is stored in node 1 of the Insurance Type sub file of the Patient file. The routine will be modified to display Effective and Expiration dates. Before ======= 34 . I $D(^DPT(DFN,.312,0)) S IN1=0 F S IN1=$O(^DPT(DFN,.312,IN1)) Q:'IN1 S IN2=$P($G(^DPT(DFN,.312,IN1,0)),U) S INN=$S($D(^DIC(36,IN2,0)):$P(^DIC(36,IN2,0),U),1:"UNKNOWN") D 35 .. S IND=$P($G(^DPT(DFN,.312,IN1,1)),U) W !," [INSURANCE:] "_INN_" DATE ENTERED: "_$S(IND]"":$$FMTE^XLFDT(IND,"5D"),1:"") 36 .. I $P($G(^DPT(DFN,.312,IN1,1)),U,5) S INE=$P($G(^DPT(DFN,.312,IN1,1)),U,5) W " DATE EDITED: "_$S(INE]"":$$FMTE^XLFDT(INE,"5D"),1:"") 37 ; After ====== 34 . ; The IB Insurance API does not provide date entered or edited information, so this information will not be displayed for preregistration 35 . I $$INSUR^IBBAPI(DFN,"","AR",.DGDATA,"1,10,11") F DGI=0:0 S DGI=$O(DGDATA("IBBAPI","INSUR",DGI)) Q:'DGI D 36 .. W !," [INSURANCE:] ",$P(DGDATA("IBBAPI","INSUR",DGI,1),U,2) 37 .. W " EFFECTIVE DATE: ",$$FMTE^XLFDT(DGDATA("IBBAPI","INSUR",DGI,10),"5D")," EXPIRATION DATE: ",$$FMTE^XLFDT(DGDATA("IBBAPI","INSUR",DGI,11),"5D") 38 ; Routine Checksum: Routine Name: - DGRP5 This routine displays the insurance information on Registration screen 5 of the patient load/edit. Before ====== 1 DGRP5 ;ALB/MRL - REGISTRATION SCREEN 5/INSURANCE INFORMATION ;06 JUN 88@2300 2 ;;5.3;Registration;**190,366**;Aug 13, 1993 3 S DGRPW=1,DGRPS=5 D H^DGRPU S Z=1 D WW^DGRPV W " Covered by Health Insurance: " S Z=$S($D(^DPT(DFN,.31)):$P(^(.31),"^",1 1),1:""),Z=$S(Z="Y":"YES",Z="N":"NO",Z="U":"UNKNOWN",1:"NOT ANSWERED"),Z1=15 D WW1^DGRPV 4 ; *REMOVEW !!?3 S Z=" Insurance",Z1=27 D WW1^DGRPV S Z="Policy #",Z1=22 D WW1^DGRPV S Z="Group #",Z1=19 D WW1^DGRPV W "H older",!?4,"---------",?30,"--------",?52,"-------",?71,"-------" 5 ; *REMOVES I1="" F I=0:0 S I=$O(^DPT(DFN,.312,I)) Q:'I S DGRPX=^(I,0) I $P(DGRPX,"^",4)']""!(+$P(DGRPX,"^",4)'0:$P(DGRPX,U,3),1:"") 12 G ^DGRPP 13 IN S J="*" F J(1)=9:1:14 I $P(DGRPX,"^",J(1))]"" S J=" " 14 S:J="*" DGRPAG="" W !?3,J,$S($D(^DIC(36,+$P(DGRPX,"^",1),0)):$E($P(^(0),"^",1),1,25),1:DGRPU),?30,$S($P(DGRPX,"^",2)]"": $P(DGRPX,"^",2),1:DGRPU),?52,$S($P(DGRPX,"^",3)]"":$P(DGRPX,"^",3),1:DGRPU) 15 W ?71,$S($P(DGRPX,"^",6)="v":"APPLICANT",$P(DGRPX,"^",6)="s":"SPOUSE",$P(DGRPX,"^",6)="o":"OTHER",1:"UNKNOWN") K J,X Q 16 Q After ===== 1 DGRP5 ;ALB/MRL - REGISTRATION SCREEN 5/INSURANCE INFORMATION ;06 JUN 88@2300 2 ;;5.3;Registration;**190,366,570**;Aug 13, 1993 3 S DGRPW=1,DGRPS=5 D H^DGRPU S Z=1 D WW^DGRPV W " Covered by Health Insurance: " S Z=$S($D(^DPT(DFN,.31)):$P(^(.31),"^",1 1),1:""),Z=$S(Z="Y":"YES",Z="N":"NO",Z="U":"UNKNOWN",1:"NOT ANSWERED"),Z1=15 D WW1^DGRPV 4 W ! D DISP^DGIBDSP 5 W ! S DGRPX=$G(^DPT(DFN,.38)),Z=2 D WW^DGRPV W " Eligible for MEDICAID: ",$S(+DGRPX:"YES",$P(DGRPX,"^",1)=0:"NO",1:DGRPU ) 6 S Y=$P(DGRPX,"^",2) I Y X ^DD("DD") W " [last updated ",Y,"]" 7 ;; *** Added for Medicaid information 8 W ! S Z=3 D WW^DGRPV W " Medicaid Number: ",$P(DGRPX,U,3) ;previous $S($P(DGRPX,U,3)>0:$P(DGRPX,U,3),1:"") 9 G ^DGRPP 10 IN ; This code is no longer called, replaced by DISP^IBCNSP2 11 Q Routine Checksum: Routine Name: - DGRPDB This routine displays the Eligibility, Means Test status, rated disabilities and insurance information for a patient. Called by the Eligibility Inquiry for Patient Billing [DG PATIENT ELIGIBILITY INQUIRY] option on the DG REGISTRATION MENU. In EN, the Insurance Type sub file is used to determine the number of Insurance entries for the patient for page control. In INS, INSURED^IBCNS1 looks for at least one insurance company that is active and will reimburse. Before ====== 8 EN ;entry with DFN defined. 9 Q:'$D(DFN) D HOME^%ZIS,2^VADPT,HDR 10 D MT,AOIR,ELIG,DIS 11 S C=$S($D(^DPT(DFN,.312,0)):$P(^(0),"^",4),1:0),C=C+6 12 D:($Y>(IOSL-C)) PAUSE,HDR:'DGQUIT Q:DGQUIT D INS,PAUSE 13 Q 45 Q:'$D(DFN) 46 W !!," Health Insurance: " S Z=$$INSURED^IBCNS1(DFN,$S($D(DGINSDT ):DGINSDT,1:DT)) W $S(Z:"YES",1:"NO") 47 D DISP^IBCNSP2 48 INSQ K I,I1,DGX,Z 51 IN W !?3,$S($D(^DIC(36,+$P(DGX,"^",1),0)):$E($P(^(0),"^",1),1,25),1:"UNKNOWN"),?30,$S($P(DGX,"^",2)]"":$P(DGX,"^",2),1:"UNKNOWN"),?52,$S($P(DGX,"^",3)]"":$P(DGX,"^",3),1:"UNKNOWN") 52 W ?71,$S($P(DGX,"^",6)="v":"APPLICANT",$P(DGX,"^",6)="s":"SPOUSE",$P(DGX,"^",6)="o":"OTHER",1:"UNKNOWN") 53 Q After ===== 8 EN ;entry with DFN defined. 9 Q:'$D(DFN) D HOME^%ZIS,2^VADPT,HDR 10 D MT,AOIR,ELIG,DIS 11 N DGINS 12 I $$INSUR^IBBAPI(DFN,"","AR",.DGINS,1) 13 S C="",C=$O(DGINS("IBBAPI","INSUR",C),-1),C=+C+6 14 D:($Y>(IOSL-C)) PAUSE,HDR:'DGQUIT Q:DGQUIT D INS,PAUSE 15 Q 47 Q:'$D(DFN) 48 W !!," Health Insurance: " 49 S Z=$$INSUR^IBBAPI(DFN,$S($D(DGINSDT):DGINSDT,1:DT)) 50 W $S(Z:"YES",1:"NO") 51 D DISP^DGIBDSP 55 IN ; Old code 56 Q Routine Checksum: Routine Name: - DGUTL The RI procedure loops through the patient's insurance entries. If it finds at least one insurance company that will reimburse, it sets DGINS =1. If no insurance company's will reimburse, DGINS returns 0. Before ====== 4 RI ;Reimbursable Insurance 5 ; ** NOTE: The line below will cause errors if used. Is it?? REW. 6 S DGINS1=0 F DGINS=0:0 S DGINS=$O(^DPT(DFN,.312,DGINS)) Q:'DGINS I $D(^DIC(36,DGINS,0)),$P(^(0),U,2)'="N" S DGINS1=1 7 S DGINS=DGINS1 K DGINS1 Q After ===== 4 RI ;Reimbursable Insurance 5 ; ** NOTE: This procedure appears to be obsolete, but code was modified 6 ; for IB/AR Encapsulation anyways. 7 S DGINS=$$INSUR^IBBAPI(DFN,"","A") 8 Q Routine Checksum: Routine Name: - DGRPTL3 This routine will invoke the 10-10T Registration Screen for existing patients through the 10-10T Registration option [DGRPT 10-10T REGISTRATION]. DGRPTL3 is called as part of the entry point to build the list array to collect the marital, spouse, income, and insurance information. Note: the "Covered by Health Insurance:" field is populated from the COVERED BY HEALTH INSURANCE? Field (#.3192) of the PATIENT File (#2), which is a set of codes populated outside the actual insurance information in the INSURANCE TYPE sub-file (#2.312). Before ====== 66 D ALL^IBCNS1(DFN,"DGINS") 67 S I=0 F S I=$O(DGINS(I)) Q:'I S DGINS=DGINS(I,0) D 68 . S DGLINE=DGLINE+1 69 . D SET^DGRPTL1(DGARY,DGLINE,$S($D(^DIC(36,+DGINS,0)):$E($P(^(0),U,1),1,16),1:"UNKNOWN"),1,.DGCNT) 70 . D SET^DGRPTL1(DGARY,DGLINE,$E($P(DGINS,U,2),1,16),20,.DGCNT) 71 . D SET^DGRPTL1(DGARY,DGLINE,$E($$GRP^IBCNS($P(DGINS,U,18)),1,10),38,.DGCNT) 72 . S X=$P(DGINS,U,6) D SET^DGRPTL1(DGARY,DGLINE,$S(X="v":"SELF",X="s":"SPOUSE",1:"OTHER"),50,.DGCNT) 73 . D SET^DGRPTL1(DGARY,DGLINE,$S($P(DGINS,U,8)'="":$$FDATE^VALM1($P(DGINS,U,8)),1:""),58,.DGCNT) 74 . D SET^DGRPTL1(DGARY,DGLINE,$S($P(DGINS,U,4)'="":$$FDATE^VALM1($P(DGINS,U,4)),1:""),67,.DGCNT) 75 I '$D(DGINS) D 76 . S DGLINE=DGLINE+1 77 . D SET^DGRPTL1(DGARY,DGLINE,"No Insurance Information",1,.DGCNT) 78 Q After ===== 66 N DGX 67 I $$INSUR^IBBAPI(DFN,"","AR",.DGX,"*") 68 M DGINS=DGX("IBBAPI","INSUR") 69 S I=0 F S I=$O(DGINS(I)) Q:'I D 70 . S DGLINE=DGLINE+1 71 . D SET^DGRPTL1(DGARY,DGLINE,$P(DGINS(I,1),U,2),1,.DGCNT) 72 . D SET^DGRPTL1(DGARY,DGLINE,$E(DGINS(I,14),1,16),20,.DGCNT) 73 . N DGGRP S DGGRP=$G(DGINS(I,18)) 74 . I DGGRP']"" S DGGRP=$P($G(DGINS(I,8)),U,2) 75 . D SET^DGRPTL1(DGARY,DGLINE,$E(DGGRP,1,10),38,.DGCNT) 76 . D SET^DGRPTL1(DGARY,DGLINE,$P(DGINS(I,12),U,2),50,.DGCNT) 77 . D SET^DGRPTL1(DGARY,DGLINE,$S(DGINS(I,10)'="":$$FDATE^VALM1(DGINS(I,10)),1:""),58,.DGCNT) 78 . D SET^DGRPTL1(DGARY,DGLINE,$S(DGINS(I,11)'="":$$FDATE^VALM1(DGINS(I,11)),1:""),67,.DGCNT) 79 I '$D(DGINS) D 80 . S DGLINE=DGLINE+1 81 . D SET^DGRPTL1(DGARY,DGLINE,"No Insurance Information",1,.DGCNT) 82 Q Routine Checksum: Routine Name: - DGPMGLG5 This routine prints a plus "+" on the Gains and Loses Sheet for Admissions if the patient has any reimbursable insurance when he was admitted. Use the Gains and Losses (G&L) Sheet option, [DG G&L SHEET] to print the sheet for the veteran. Before ====== 30 INS ; Reimburse Insurance (+) 31 S INS=0 I $O(^DPT(DFN,.312,0)) S INS1=0 F JJ=0:0 S INS1=$O(^DPT(DFN, .312,INS1)) Q:INS1'>0 S I=^DPT(DFN,.312,INS1,0) I +$P(I,"^",8)'>TO I $D(^DIC(36,+I,0)),$P(^DIC(36,+I,0),"^",2)'="N" S INS=INS+1 I $P( I,"^",4)]""&($P(I,"^",4)'>TO) S INS=INS-1 32 S:INS>0 ID=ID_"+",LEG("+")="" 33 K INS,INS1,JJ After ===== 30 INS ; Reimburse Insurance (+) 31 S INS=0 32 N DGINS,DGX 33 ; API returns ONLY Active and Re-imbursable Insurance entries 34 I $$INSUR^IBBAPI(DFN,"","",.DGINS,9) D 35 . S DGX=0 F S DGX=$O(DGINS("IBBAPI","INSUR",DGX)) Q:'DGX S INS=INS+1 36 S:INS>0 ID=ID_"+",LEG("+")="" 37 K INS,INS1,JJ Routine Checksum: Routine Name: - DGRPC2 This routine is part of the consistency checker run when exiting Load/Edit Patient Data [DG LOAD PATIENT DATA] option. The code in question compares the value of the COVERED BY HEALTH INSURANCE? Field (#.3192) with whether the patient has any Insurance entries. If there is a mismatch, i.e. the "COVERED BY HEALTH INSURANCE?" field is "NO" but the patient has insurance entries, an inconsistency is set. Before ====== 14 50 ; insurance checks 15 I DGCHK[",49,"!(DGCHK[",50,") D S DGLST=$S(DGCHK["50":50,1:49) 16 . N COV,INS,X 17 . S X=0,COV=$S($P(DGP(.31),"^",11)="Y":1,1:0) 18 . D ALL^IBCNS1(DFN,"INS",2,DT) 19 . I COV,'$G(INS(0)) S X=49 ; yes, but none 20 . I 'COV,$G(INS(0)) S X=50 ; not yes, but some 21 . I DGCHK[(","_X_",") D COMB After ===== 14 50 ; insurance checks 15 I DGCHK[",49,"!(DGCHK[",50,") D S DGLST=$S(DGCHK["50":50,1:49) 16 . N COV,INS,X 17 . S X=0,COV=$S($P(DGP(.31),"^",11)="Y":1,1:0) 18 . S INS=$$INSUR^IBBAPI(DFN,DT,"R") 19 . I COV,'INS S X=49 ; yes, but none 20 . I 'COV,INS S X=50 ; not yes, but some 21 . I DGCHK[(","_X_",") D COMB Routine Checksum: Routine Name: - DGIBDSP This is a new routine. Routine Checksum: ============================================================================= User Information: Entered By : MULLER,RICHARD Date Entered : NOV 14, 2003 Completed By: HUA,PATRICK Date Completed: JAN 07, 2005 Released By : GROOMS,ANTHONY E Date Released : JAN 07, 2005 ============================================================================= Packman Mail Message: ===================== $END TXT