Ignore:
Timestamp:
Dec 4, 2009, 8:26:01 PM (14 years ago)
Author:
George Lilly
Message:

WorldVistAEHR overlayed on FOIAVistA

Location:
FOIAVistA/tag/r
Files:
1 edited
1 copied

Legend:

Unmodified
Added
Removed
  • FOIAVistA/tag/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEP8.m

    r628 r636  
    11IBCEP8 ;ALB/TMP - Functions for NON-VA PROVIDER ;11-07-00
    2  ;;2.0;INTEGRATED BILLING;**51,137,232,288,320,343,374,377**;21-MAR-94;Build 23
    3  ;;Per VHA Directive 2004-038, this routine should not be modified.
     2 ;;2.0;INTEGRATED BILLING;**51,137,232,288,320,343,374**;21-MAR-94;Build 16
    43 ;
    54EN ; -- main entry point
     
    1716 N DIC,DA,X,Y,DLAYGO,IBIF,DIR,DTOUT,DUOUT
    1817 K ^TMP("IBCE_PRVNVA_MAINT",$J)
    19  ;
    20  ; if coming in from main routine ^IBCEP6 this special variable IBNVPMIF is set already
    21  I $G(IBNVPMIF)'="" S IBIF=IBNVPMIF G INIT1
    22  ;
    2318 S DIR("A")="(I)NDIVIDUAL OR (F)ACILITY?: ",DIR(0)="SA^I:INDIVIDUAL;F:FACILITY" D ^DIR K DIR
    2419 I $D(DUOUT)!$D(DTOUT) S VALMQUIT=1 G INITQ
    2520 S IBIF=Y
    26  ;
    27 INIT1 ;
    2821 ;
    2922 I IBIF="F" D
     
    3326 . I Y S VALM("PROTOCOL")=+Y_";ORD(101,"
    3427 ;
    35  S DIC="^IBA(355.93,",DIC("DR")=".02///"_$S(IBIF'="F":2,1:1)
     28 S DIC="^IBA(355.93,",DIC("DR")=".02////"_$S(IBIF'="F":2,1:1)
    3629 S DIC("S")="I $P(^(0),U,2)="_$S(IBIF'="F":2,1:1)
    3730 S DLAYGO=355.93,DIC(0)="AELMQ",DIC("A")="Select a NON"_$S(IBIF="I":"-",1:"/OTHER ")_"VA PROVIDER: "
     
    140133 Q
    141134 ;
    142 EDITID(IBNPRV,IBSLEV) ; Link from this list template to maintain provider-specific ids
    143  ; This entry point is called by 4 action protocols.
    144  ; IBNPRV = ien of entry in file 355.93 (can be either an individual or a facility) (required)
    145  ; IBSLEV = 1 for facility/provider own ID's
    146  ; IBSLEV = 2 for facility/provider ID's furnished by an insurance company
    147  ;
    148  Q:'$G(IBNPRV)
    149  Q:'$G(IBSLEV)
    150  N IBPRV,IBIF
    151  D FULL^VALM1    ; set full scrolling region
    152  D CLEAR^VALM1   ; clear screen
     135EDITID(IBNPRV) ; Link from this list template to maintain provider-specific ids
     136 ; IBNPRV = ien of entry in file 355.93
     137 N IBPRV
     138 D FULL^VALM1
     139 D CLEAR^VALM1
    153140 S IBPRV=IBNPRV
    154  ;
    155  K IBFASTXT
    156  S IBIF=$$GET1^DIQ(355.93,IBPRV,.02,"I")    ; 1=facility/group      2=individual
    157  D EN^VALM("IBCE PRVPRV MAINT")
    158  ;
     141 D EN1^IBCEP5
    159142 K VALMQUIT
    160  S VALMBCK=$S($G(IBFASTXT)'="":"Q",1:"R")
     143 S VALMBCK="R"
    161144 Q
    162145 ;
    163146NVAFAC ; Enter/edit Non-VA facility information
    164  ; This entry point is called by the menu system for option IBCE PRVNVA FAC EDIT
    165147 N X,Y,DA,DIC,IBNPRV,DLAYGO
    166  S DIC="^IBA(355.93,",DIC("S")="I $P(^(0),U,2)=1",DIC("DR")=".02///1"
     148 S DIC="^IBA(355.93,",DIC("S")="I $P(^(0),U,2)=1",DIC("DR")=".02////1"
    167149 S DLAYGO=355.93,DIC(0)="AELMQ",DIC("A")="Select a NON/Other VA FACILITY: "
    168150 D ^DIC K DIC,DLAYGO
Note: See TracChangeset for help on using the changeset viewer.