Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed
  • WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEP0A.m

    r613 r623  
    1 IBCEP0A ;ALB/TMP - EDI UTILITIES for insurance assigned provider ID ;01-NOV-00
    2         ;;2.0;INTEGRATED BILLING;**137,232,320,377**;21-MAR-94;Build 23
    3         ;;Per VHA Directive 2004-038, this routine should not be modified.
    4         ;
    5 NEW(IBINS,IBPRV,IBPTYP,IBDEF)   ; Add new insurance co assigned id
    6         ; IBDEF = flag sent as 1 if only insurance co defaults are being added
    7         N DIC,DIR,X,Y,Z,DA,DR,DIE,DO,DD,DLAYGO,IBQ,IBIEN,IBCUND,DTOUT,DUOUT
    8         D FULL^VALM1
    9         S IBQ=0
    10         I $G(IBDEF)="D" W !!,"YOU ARE ADDING A PROVIDER ID THAT WILL BE THE INSURANCE CO DEFAULT",!
    11         I '$G(IBPRV),$G(IBDEF)'="D" D  G:IBQ NEWQ
    12         . N DA,IBO
    13         . S IBO=($G(IBDSP)'="I")
    14         . S DIR(0)="355.9,.01A"_$S(IBO:"O",1:""),DIR("A")="Select PROVIDER"_$S(IBO:" (optional)",1:"")_": "
    15         . S DIR("?")="Select the PROVIDER to be assigned a provider ID"
    16         . I IBO S DIR("?",1)=DIR("?"),DIR("?")="Or    Press ENTER to add an insurance co level default id (all providers)"
    17         . W ! D ^DIR K DIR W !
    18         . I $D(DTOUT)!$D(DUOUT) S IBQ=1 Q
    19         . S IBPRV=$S(Y>0:$P(Y,U),1:"")
    20         . Q:IBPRV
    21         . S DIR(0)="YA",DIR("B")="YES",DIR("A",1)="YOU ARE ADDING A PROVIDER ID THAT WILL BE THE INSURANCE CO DEFAULT",DIR("A")="IS THIS OK?: "
    22         . W ! D ^DIR K DIR W !
    23         . I $D(DTOUT)!$D(DUOUT)!(Y'=1) S IBQ=1
    24         . Q
    25         ;
    26         I '$G(IBPTYP) D  G:IBQ NEWQ
    27         . S DIR(0)="PAr^355.97:AEMQ",DIR("A")="Select Provider ID Qualifier: "
    28         . S DIR("?")="Enter a Qualifier to identify the type of ID number you are entering."
    29         . S DIR("S")="I $$RAINS^IBCEPU(Y)"   ; Rendering/Attending IDs provided by ins
    30         . S DA=0
    31         . W ! D ^DIR K DIR W !
    32         . I $D(DTOUT)!$D(DUOUT)!'Y S IBQ=1 Q
    33         . S IBPTYP=+Y
    34         ;
    35         S IBQ=$$ADDID(IBINS,IBPRV,IBPTYP)
    36         ;
    37 NEWQ    D:'$G(IBQ) BLD^IBCEP0($G(IBINS),$G(IBDSP),$G(IBSORT))
    38         S VALMBCK="R"
    39         Q
    40         ;
    41 DEL1    ; Delete Insurance Co assigned provider ID's
    42         ; IBPRV = vp ien of provider if editing entry in file 355.9
    43         ;         otherwise, null
    44         N IB1,IBDA,IBFILE
    45         D FULL^VALM1
    46         D SEL^IBCEP0(.IBDA)
    47         G:'$O(IBDA(0)) DEL1Q
    48         S IBDA=+$O(IBDA("")),IBDA=$G(IBDA(IBDA))
    49         G:'IBDA DEL1Q
    50         S IB1=$P(IBDA,U,2),IBDA=+IBDA
    51         S IBFILE=$S(IB1:355.9,1:355.91)
    52         I IBDA>0 D DEL^IBCEP5B(IBFILE,IBDA,1),BLD^IBCEP0($G(IBINS),$G(IBDSP),$G(IBSORT))
    53         ;
    54 DEL1Q   S VALMBCK="R"
    55         Q
    56         ;
    57 CHG1    ; Edit Provider ID's
    58         N IBDA,IB1,IBFILE
    59         D FULL^VALM1
    60         D SEL^IBCEP0(.IBDA)
    61         G:'$O(IBDA(0)) CHG1Q
    62         S IBDA=+$O(IBDA("")),IBDA=$G(IBDA(IBDA))
    63         G:'IBDA CHG1Q
    64         S IB1=$P(IBDA,U,2),IBDA=+IBDA
    65         S IBFILE=$S(IB1:355.9,1:355.91)
    66         I IBDA>0 D
    67         . I IBFILE=355.9 W !!,"PROVIDER: ",$$EXPAND^IBTRE(355.9,.01,IB1)
    68         . I IBFILE'=355.9 W !!,"  <<INS CO DEFAULT>>"
    69         . D CHG^IBCEP5B(IBFILE,IBDA),BLD^IBCEP0($G(IBINS),$G(IBDSP),$G(IBSORT))
    70         ;
    71 CHG1Q   S VALMBCK="R"
    72         Q
    73         ;
    74 PRVJMP(IBDSP)   ; Navigate to a specific sort level in current LM list
    75         ;   (from insurance co option)
    76         ; IBDSP = 'I', 'A' or 'D' to indicate format selected for display
    77         ;        ([P]ROVIDER, PROVIDER [T]YPE OR [I]NSURANCE DEFAULT)
    78         ; Sets VALMBG = LINE # if a provider in list selected
    79         ;
    80         I $G(IBDSP)="I" D PRVNJMP(.VALMBG)
    81         I $G(IBDSP)="D"!($G(IBDSP)="A") D PRVTJMP(.VALMBG)
    82         S VALMBCK="R"
    83         Q
    84         ;
    85 PRVNJMP(VALMBG) ; Navigate to a specific provider name (from insurance co
    86         ;  option)
    87         ;
    88         N DIR,X,Y,DA
    89         D FULL^VALM1
    90         S DIR(0)="355.9,.01AO^^I '$D(^TMP(""IBPRV_INS_ID"",$J,""ZXPRV"",U_$$EXPAND^IBTRE(355.9,.01,Y)_U_$P(Y,U))) K X"
    91         S DIR("?",1)="*** YOU MAY ONLY SELECT PROVIDERS INCLUDED IN THE CURRENT LIST ***",DIR("?",2)=" ",DIR("?",3)="SELECTING A PROVIDER WILL FORCE THE DISPLAY TO SKIP TO THE DATA FOR THAT",DIR("?")="   PROVIDER"
    92         S DIR("A")="SELECT PROVIDER: "
    93         S DIR("S")="N Z S Z=$P(^(0),U) I $D(^TMP(""IBPRV_INS_ID"",$J,""ZXPRV"",U_$$EXPAND^IBTRE(355.9,.01,Z)_U_Z))"
    94         W ! D ^DIR K DIR W !
    95         I Y>0,'$D(DTOUT),'$D(DUOUT) D
    96         . N Z
    97         . S Z=$G(^TMP("IBPRV_INS_ID",$J,"ZXPRV",U_$$EXPAND^IBTRE(355.9,.01,$P(Y,U))_U_$P(Y,U)))
    98         . I Z S VALMBG=Z Q
    99         . S DIR(0)="EA",DIR("A",1)="THIS PROVIDER DOES NOT EXIST IN THE CURRENT DISPLAY",DIR("A")="PRESS THE ENTER KEY TO CONTINUE"
    100         . W ! D ^DIR K DIR W !
    101         Q
    102         ;
    103 PRVTJMP(VALMBG) ; Navigate to a specific type of ID qualifier (from ins co option)
    104         ;
    105         N DIR,X,Y
    106         D FULL^VALM1
    107         S DIR(0)="PAO^355.97:AEMQ",DIR("A")="Select type of ID Qualifier: "
    108         S DIR("?")="Select a type of ID Qualifier to display the IDs of that type."
    109         S DIR("S")="I $D(^TMP(""IBPRV_INS_ID"",$J,""ZXPTYP"",+Y))"
    110         W ! D ^DIR K DIR W !
    111         I Y>0,'$D(DTOUT),'$D(DUOUT) D
    112         . N Z
    113         . S Z=$G(^TMP("IBPRV_INS_ID",$J,"ZXPTYP",+Y))
    114         . I Z S VALMBG=Z Q
    115         . S DIR(0)="EA",DIR("A",1)="This type of ID Qualifier does not exist in the current display",DIR("A")="Press the Enter key to continue"
    116         . W ! D ^DIR K DIR W !
    117         Q
    118         ;
    119 CHGINS  ; Change insurance co being displayed, using the same or new params
    120         ; Assumes IBINS exists = IEN of insurance co (file 36)
    121         N IBINEW,IBSAVE,DIC,DA,Y,X,DIR
    122         D FULL^VALM1
    123         S DIC="^DIC(36,",DIC(0)="AEMQ" D ^DIC
    124         S IBINEW=+Y
    125         ;
    126         I IBINEW>0,IBINS'=IBINEW D
    127         . D COPYPROV^IBCEP5A(IBINS)
    128         . S DIR(0)="YA",DIR("?")="IF YOU WANT TO CHANGE THE FORMAT OF THE DISPLAY, RESPOND NO HERE"
    129         . S DIR("A")="DO YOU WANT TO DISPLAY THE NEW INS. CO IDS USING THE CURRENT DISPLAY FORMAT?: ",DIR("B")="YES" W ! D ^DIR W ! K DIR
    130         . Q:Y'=1
    131         . S IBSAVE("IBINS")=IBINS
    132         . K ^TMP("IBPRV_INS_ID",$J),VALMHDR S VALMBG=1,IBINS=IBINEW
    133         . I Y=1 D BLD^IBCEP0($G(IBINS),$G(IBDSP),$G(IBSORT)) Q
    134         . D INIT^IBCEP0
    135         . I '$G(VALMQUIT) Q
    136         . S IBINS=IBSAVE("IBINS") D BLD^IBCEP0($G(IBINS),$G(IBDSP),$G(IBSORT))
    137         S VALMBCK="R"
    138         Q
    139         ;
    140 CHGFMT  ; Change format parameters for display
    141         N IBSAVE
    142         S IBSAVE("IBINS")=$G(IBINS)
    143         D INIT^IBCEP0
    144         I '$G(VALMQUIT) G CHGFMTQ
    145         S IBINS=IBSAVE("IBINS") D BLD^IBCEP0($G(IBINS),$G(IBDSP),$G(IBSORT))
    146 CHGFMTQ S VALMBCK="R"
    147         Q
    148         ;
    149 IPARAM  ; Display Insurance co parameters and care unit requirements
    150         ; Assumes IBINS exists = IEN of insurance co
    151         N IBDSP,IBSORT,IBHOLD
    152         D FULL^VALM1
    153         S IBHOLD("IBINS")=$G(IBINS)
    154         D EN^VALM("IBCE PRVINS PARAM DISPLAY")
    155         S:$G(IBHOLD("IBINS"))'="" IBINS=IBHOLD("IBINS")
    156         K VALMQUIT
    157         S VALMBCK="R"
    158         Q
    159         ;
    160 ADDID(IBINS,IBPRV,IBPTYP)       ; Adds a new ID for the provider and/or ins co
    161         ; IBINS = ien of file 36
    162         ; IBPRV = vp ien of file 355.9
    163         ; IBPTYP = ien of file 355.97
    164         ; FUNCTION returns 1 if record not added, 0 if filed OK
    165         N IBIEN,IBQ,DIC,DA,DO,DD,DLAYGO,X,Y
    166         S IBQ=0
    167         I $G(IBPRV) D  G:IBQ ADDIDQ
    168         . ; Provider specific for insurance co - add to file 355.9
    169         . S DIC(0)="L",DLAYGO=355.9,DIC="^IBA(355.9,",X=IBPRV
    170         . S:$G(IBINS) DIC("DR")=".02////"_IBINS
    171         . D FILE^DICN K DIC,DLAYGO,DD,DO
    172         . I Y'>0!$D(DUOUT)!$D(DTOUT) S IBIEN=0,IBQ=1 Q
    173         . S IBIEN=+Y
    174         . D NEWID^IBCEP5B(355.9,IBINS,IBPRV,IBPTYP,IBIEN,"")
    175         E  D
    176         . ; Insurance co default - add to file 355.91
    177         . S DIC(0)="L",DLAYGO=355.91,DIC="^IBA(355.91,",X=IBINS
    178         . D FILE^DICN K DIC,DLAYGO,DD,DO
    179         . I Y'>0!$D(DUOUT)!$D(DTOUT) S IBIEN=0,IBQ=1 Q
    180         . S IBIEN=+Y
    181         . D NEWID^IBCEP5B(355.91,IBINS,"",IBPTYP,IBIEN,1)
    182 ADDIDQ  Q IBQ
     1IBCEP0A ;ALB/TMP - EDI UTILITIES for insurance assigned provider ID ;01-NOV-00
     2 ;;2.0;INTEGRATED BILLING;**137,232,320**;21-MAR-94
     3 ;
     4NEW(IBINS,IBPRV,IBPTYP,IBDEF) ; Add new insurance co assigned id
     5 ; IBDEF = flag sent as 1 if only insurance co defaults are being added
     6 N DIC,DIR,X,Y,Z,DA,DR,DIE,DO,DD,DLAYGO,IBQ,IBIEN,IBCUND,DTOUT,DUOUT
     7 D FULL^VALM1
     8 S IBQ=0
     9 I $G(IBDEF)="D" W !!,"YOU ARE ADDING A PROVIDER ID THAT WILL BE THE INSURANCE CO DEFAULT",!
     10 I '$G(IBPRV),$G(IBDEF)'="D" D  G:IBQ NEWQ
     11 . N DA,IBO
     12 . S IBO=($G(IBDSP)'="I")
     13 . S DIR(0)="355.9,.01A"_$S(IBO:"O",1:""),DIR("A")="Select PROVIDER"_$S(IBO:" (optional)",1:"")_": "
     14 . S DIR("?")="Select the PROVIDER to be assigned a provider ID"
     15 . I IBO S DIR("?",1)=DIR("?"),DIR("?")="Or    Press ENTER to add an insurance co level default id (all providers)"
     16 . W ! D ^DIR K DIR W !
     17 . I $D(DTOUT)!$D(DUOUT) S IBQ=1 Q
     18 . S IBPRV=$S(Y>0:$P(Y,U),1:"")
     19 . Q:IBPRV
     20 . S DIR(0)="YA",DIR("B")="YES",DIR("A",1)="YOU ARE ADDING A PROVIDER ID THAT WILL BE THE INSURANCE CO DEFAULT",DIR("A")="IS THIS OK?: "
     21 . W ! D ^DIR K DIR W !
     22 . I $D(DTOUT)!$D(DUOUT)!(Y'=1) S IBQ=1
     23 . Q
     24 ;
     25 I '$G(IBPTYP) D  G:IBQ NEWQ
     26 . S DIR(0)="PAr^355.97:AEMQ",DIR("A")="Select Provider ID Qualifier: "
     27 . S DIR("?")="Enter a Qualifier to indentify the type of ID number you are entering."
     28 . S DIR("S")="I $$RAINS^IBCEPU(Y)"   ; Rendering/Attending IDs provided by ins
     29 . S DA=0
     30 . W ! D ^DIR K DIR W !
     31 . I $D(DTOUT)!$D(DUOUT)!'Y S IBQ=1 Q
     32 . S IBPTYP=+Y
     33 ;
     34 S IBQ=$$ADDID(IBINS,IBPRV,IBPTYP)
     35 ;
     36NEWQ D:'$G(IBQ) BLD^IBCEP0($G(IBINS),$G(IBDSP),$G(IBSORT))
     37 S VALMBCK="R"
     38 Q
     39 ;
     40DEL1 ; Delete Insurance Co assigned provider ID's
     41 ; IBPRV = vp ien of provider if editing entry in file 355.9
     42 ;         otherwise, null
     43 N IB1,IBDA,IBFILE
     44 D FULL^VALM1
     45 D SEL^IBCEP0(.IBDA)
     46 G:'$O(IBDA(0)) DEL1Q
     47 S IBDA=+$O(IBDA("")),IBDA=$G(IBDA(IBDA))
     48 G:'IBDA DEL1Q
     49 S IB1=$P(IBDA,U,2),IBDA=+IBDA
     50 S IBFILE=$S(IB1:355.9,1:355.91)
     51 I IBDA>0 D DEL^IBCEP5B(IBFILE,IBDA,1),BLD^IBCEP0($G(IBINS),$G(IBDSP),$G(IBSORT))
     52 ;
     53DEL1Q S VALMBCK="R"
     54 Q
     55 ;
     56CHG1 ; Edit Provider ID's
     57 N IBDA,IB1,IBFILE
     58 D FULL^VALM1
     59 D SEL^IBCEP0(.IBDA)
     60 G:'$O(IBDA(0)) CHG1Q
     61 S IBDA=+$O(IBDA("")),IBDA=$G(IBDA(IBDA))
     62 G:'IBDA CHG1Q
     63 S IB1=$P(IBDA,U,2),IBDA=+IBDA
     64 S IBFILE=$S(IB1:355.9,1:355.91)
     65 I IBDA>0 D
     66 . I IBFILE=355.9 W !!,"PROVIDER: ",$$EXPAND^IBTRE(355.9,.01,IB1)
     67 . I IBFILE'=355.9 W !!,"  <<INS CO DEFAULT>>"
     68 . D CHG^IBCEP5B(IBFILE,IBDA),BLD^IBCEP0($G(IBINS),$G(IBDSP),$G(IBSORT))
     69 ;
     70CHG1Q S VALMBCK="R"
     71 Q
     72 ;
     73PRVJMP(IBDSP) ; Navigate to a specific sort level in current LM list
     74 ;   (from insurance co option)
     75 ; IBDSP = 'I', 'A' or 'D' to indicate format selected for display
     76 ;        ([P]ROVIDER, PROVIDER [T]YPE OR [I]NSURANCE DEFAULT)
     77 ; Sets VALMBG = LINE # if a provider in list selected
     78 ;
     79 I $G(IBDSP)="I" D PRVNJMP(.VALMBG)
     80 I $G(IBDSP)="D"!($G(IBDSP)="A") D PRVTJMP(.VALMBG)
     81 S VALMBCK="R"
     82 Q
     83 ;
     84PRVNJMP(VALMBG) ; Navigate to a specific provider name (from insurance co
     85 ;  option)
     86 ;
     87 N DIR,X,Y,DA
     88 D FULL^VALM1
     89 S DIR(0)="355.9,.01AO^^I '$D(^TMP(""IBPRV_INS_ID"",$J,""ZXPRV"",U_$$EXPAND^IBTRE(355.9,.01,Y)_U_$P(Y,U))) K X"
     90 S DIR("?",1)="*** YOU MAY ONLY SELECT PROVIDERS INCLUDED IN THE CURRENT LIST ***",DIR("?",2)=" ",DIR("?",3)="SELECTING A PROVIDER WILL FORCE THE DISPLAY TO SKIP TO THE DATA FOR THAT",DIR("?")="   PROVIDER"
     91 S DIR("A")="SELECT PROVIDER: "
     92 S DIR("S")="N Z S Z=$P(^(0),U) I $D(^TMP(""IBPRV_INS_ID"",$J,""ZXPRV"",U_$$EXPAND^IBTRE(355.9,.01,Z)_U_Z))"
     93 W ! D ^DIR K DIR W !
     94 I Y>0,'$D(DTOUT),'$D(DUOUT) D
     95 . N Z
     96 . S Z=$G(^TMP("IBPRV_INS_ID",$J,"ZXPRV",U_$$EXPAND^IBTRE(355.9,.01,$P(Y,U))_U_$P(Y,U)))
     97 . I Z S VALMBG=Z Q
     98 . S DIR(0)="EA",DIR("A",1)="THIS PROVIDER DOES NOT EXIST IN THE CURRENT DISPLAY",DIR("A")="PRESS THE ENTER KEY TO CONTINUE"
     99 . W ! D ^DIR K DIR W !
     100 Q
     101 ;
     102PRVTJMP(VALMBG) ; Navigate to a specific provider id type (from ins co option)
     103 ;
     104 N DIR,X,Y
     105 D FULL^VALM1
     106 S DIR(0)="PAO^355.97:AEMQ",DIR("A")="SELECT PROVIDER ID TYPE: ",DIR("?",1)="SELECTING A PROVIDER ID TYPE WILL FORCE THE DISPLAY TO SKIP TO THE DATA FOR ",DIR("?")="  THAT PROVIDER ID TYPE"
     107 S DIR("S")="I $D(^TMP(""IBPRV_INS_ID"",$J,""ZXPTYP"",+Y))"
     108 W ! D ^DIR K DIR W !
     109 I Y>0,'$D(DTOUT),'$D(DUOUT) D
     110 . N Z
     111 . S Z=$G(^TMP("IBPRV_INS_ID",$J,"ZXPTYP",+Y))
     112 . I Z S VALMBG=Z Q
     113 . S DIR(0)="EA",DIR("A",1)="THIS PROVIDER ID TYPE DOES NOT EXIST IN THE CURRENT DISPLAY",DIR("A")="PRESS THE ENTER KEY TO CONTINUE"
     114 . W ! D ^DIR K DIR W !
     115 Q
     116 ;
     117CHGINS ; Change insurance co being displayed, using the same or new params
     118 ; Assumes IBINS exists = IEN of insurance co (file 36)
     119 N IBINEW,IBSAVE,DIC,DA,Y,X,DIR
     120 D FULL^VALM1
     121 S DIC="^DIC(36,",DIC(0)="AEMQ" D ^DIC
     122 S IBINEW=+Y
     123 ;
     124 I IBINEW>0,IBINS'=IBINEW D
     125 . D COPYPROV^IBCEP5A(IBINS)
     126 . S DIR(0)="YA",DIR("?")="IF YOU WANT TO CHANGE THE FORMAT OF THE DISPLAY, RESPOND NO HERE"
     127 . S DIR("A")="DO YOU WANT TO DISPLAY THE NEW INS. CO IDS USING THE CURRENT DISPLAY FORMAT?: ",DIR("B")="YES" W ! D ^DIR W ! K DIR
     128 . Q:Y'=1
     129 . S IBSAVE("IBINS")=IBINS
     130 . K ^TMP("IBPRV_INS_ID",$J),VALMHDR S VALMBG=1,IBINS=IBINEW
     131 . I Y=1 D BLD^IBCEP0($G(IBINS),$G(IBDSP),$G(IBSORT)) Q
     132 . D INIT^IBCEP0
     133 . I '$G(VALMQUIT) Q
     134 . S IBINS=IBSAVE("IBINS") D BLD^IBCEP0($G(IBINS),$G(IBDSP),$G(IBSORT))
     135 S VALMBCK="R"
     136 Q
     137 ;
     138CHGFMT ; Change format parameters for display
     139 N IBSAVE
     140 S IBSAVE("IBINS")=$G(IBINS)
     141 D INIT^IBCEP0
     142 I '$G(VALMQUIT) G CHGFMTQ
     143 S IBINS=IBSAVE("IBINS") D BLD^IBCEP0($G(IBINS),$G(IBDSP),$G(IBSORT))
     144CHGFMTQ S VALMBCK="R"
     145 Q
     146 ;
     147IPARAM ; Display Insurance co parameters and care unit requirements
     148 ; Assumes IBINS exists = IEN of insurance co
     149 N IBDSP,IBSORT,IBHOLD
     150 D FULL^VALM1
     151 S IBHOLD("IBINS")=$G(IBINS)
     152 D EN^VALM("IBCE PRVINS PARAM DISPLAY")
     153 S:$G(IBHOLD("IBINS"))'="" IBINS=IBHOLD("IBINS")
     154 K VALMQUIT
     155 S VALMBCK="R"
     156 Q
     157 ;
     158ADDID(IBINS,IBPRV,IBPTYP) ; Adds a new ID for the provider and/or ins co
     159 ; IBINS = ien of file 36
     160 ; IBPRV = vp ien of file 355.9
     161 ; IBPTYP = ien of file 355.97
     162 ; FUNCTION returns 1 if record not added, 0 if filed OK
     163 N IBIEN,IBQ,DIC,DA,DO,DD,DLAYGO,X,Y
     164 S IBQ=0
     165 I $G(IBPRV) D  G:IBQ ADDIDQ
     166 . ; Provider specific for insurance co - add to file 355.9
     167 . S DIC(0)="L",DLAYGO=355.9,DIC="^IBA(355.9,",X=IBPRV
     168 . S:$G(IBINS) DIC("DR")=".02////"_IBINS
     169 . D FILE^DICN K DIC,DLAYGO,DD,DO
     170 . I Y'>0!$D(DUOUT)!$D(DTOUT) S IBIEN=0,IBQ=1 Q
     171 . S IBIEN=+Y
     172 . D NEWID^IBCEP5B(355.9,IBINS,IBPRV,IBPTYP,IBIEN,"")
     173 E  D
     174 . ; Insurance co default - add to file 355.91
     175 . S DIC(0)="L",DLAYGO=355.91,DIC="^IBA(355.91,",X=IBINS
     176 . D FILE^DICN K DIC,DLAYGO,DD,DO
     177 . I Y'>0!$D(DUOUT)!$D(DTOUT) S IBIEN=0,IBQ=1 Q
     178 . S IBIEN=+Y
     179 . D NEWID^IBCEP5B(355.91,IBINS,"",IBPTYP,IBIEN,1)
     180ADDIDQ Q IBQ
Note: See TracChangeset for help on using the changeset viewer.