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

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

initial load of WorldVistAEHR
File size: 6.1 KB
Line 
1IBCSCH2 ;ALB/DLS - Continuation of routine IBCSCH ;12 JUN 2007
2 ;;2.0;INTEGRATED BILLING;**374**;21-MAR-94;Build 16
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6DISPPRV(IBIFN) ; Display provider information: interactive - user selects provider
7 N DIC,DA,X,Y,IBI,IBJ,IBW,IBPRV,IBPX,IBDT,IBARR,IBNPISTR,IBNPI,IBPRVTAX,IBTAXFLG
8 N IBPRVDAT,IBTAXID,IBTAXEFF,IBTAXTRM,IBTAXX12
9 W !!,"This is a display of provider specific information."
10 D SPECIFIC^IBCEU5(IBIFN)
11 S IBDT=+$G(^DGCR(399,+$G(IBIFN),"U")) I 'IBDT S IBDT=DT
12 ;
13 F IBI=1:1 W ! S DIC("A")="Select PROVIDER NAME: ",DIC="^VA(200,",DIC(0)="AEQM" D ^DIC Q:Y'>0 D
14 . S IBPRV=Y
15 . W !!,$TR($J(" ",IOM)," ","-")
16 . S IBPX=$$ESBLOCK^XUSESIG1(+IBPRV)
17 . W !," Signature Name: ",$P(IBPX,U,1)
18 . W !,"Signature Title: ",$P(IBPX,U,3)
19 . W !," Degree: ",$P(IBPX,U,2)
20 . ;
21 . ; PRXM/DLS - Patch 374. Adding NPI to Signature information.
22 . S IBNPISTR=$$NPI^XUSNPI("Individual_ID",+IBPRV) ; Get NPI information.
23 . S IBNPI=$P(IBNPISTR,U) ; Get NPI.
24 . W !," NPI: ",$S(IBNPI>0:IBNPI,1:"") ; Write NPI.
25 . ;
26 . S IBPX=$$PRVLIC^IBCU1(+IBPRV,IBDT,.IBARR) ; Get License Info.
27 . W !!," License(s): " D
28 . . I IBPX'>0 W "None Active on ",$$FMTE^XLFDT(IBDT,2) Q
29 . . S IBJ=0,IBW=0 F S IBJ=$O(IBARR(IBJ)) Q:'IBJ D
30 . . . S IBPX=IBARR(IBJ),IBPX=$P($G(^DIC(5,+IBPX,0)),U,2)_": "_$P(IBPX,U,2)
31 . . . I (IBW+$L(IBPX))>61 W !,?17 S IBW=0
32 . . . W IBPX," " S IBW=IBW+$L(IBPX)+2
33 . ;
34 . ; PRXM/DLS - Display Person Class/Taxonomy Information.
35 . S IBTAXFLG=0 ; Init to 0, set to 1 if Person Class info found.
36 . S IBPRVTAX=0 ; Loop through prov's Person Class entries.
37 . F S IBPRVTAX=$O(^VA(200,+IBPRV,"USC1",IBPRVTAX)) Q:'IBPRVTAX D
38 . . ; Get Basic Information
39 . . S IBTAXID=$$GET1^DIQ(200.05,IBPRVTAX_","_+IBPRV_",",.01,"I") Q:IBTAXID="" ; Person Class IEN.
40 . . S IBTAXEFF=$$GET1^DIQ(200.05,IBPRVTAX_","_+IBPRV_",",2,"I") ; Person Class Eff Date.
41 . . S IBTAXTRM=$$GET1^DIQ(200.05,IBPRVTAX_","_+IBPRV_",",3,"I") ;I IBTAXTRM="" ; Person Class Term Date.
42 . . I IBTAXTRM="" S IBTAXTRM=9999999
43 . . ; See if claim beginning service date falls within Eff date range. If so, proceed.
44 . . I (IBTAXEFF'>IBDT),(IBTAXTRM>IBDT) D
45 . . . S IBTAXFLG=1 ; A Person Class found, set flag to 1.
46 . . . ; Get Detailed Information and Display.
47 . . . S IBPX=$$IEN2DATA^XUA4A72(IBTAXID) ; Person Class Details.
48 . . . S IBTAXX12=$$GET1^DIQ(8932.1,IBTAXID_",",6) ; Get X12 Code.
49 . . . W !
50 . . . W !," Person Class: ",$P(IBPX,U,6) ; Display Person Class Name.
51 . . . W !," PROVIDER TYPE: ",$P(IBPX,U) ; Display Provider Type.
52 . . . W !," CLASSIFICATION: ",$P(IBPX,U,2) ; Display Classification.
53 . . . W !," SPECIALIZATION: ",$P(IBPX,U,3) ; Display Specialization.
54 . . . W !," TAXONOMY: ",IBTAXX12,$S(IBTAXX12'="":" ("_IBTAXID_")",1:"") ; Display X12 Code and Internal Code (IEN).
55 . . . W !," EFFECTIVE: ",$$FMTE^XLFDT(IBTAXEFF,2) ; Display EFF Date.
56 . . . I IBTAXTRM'=9999999 W " - ",$$FMTE^XLFDT(IBTAXTRM,2) ; Display TRM Date, if it exists.
57 . ; If no Person Class entries exists for this Provider, notate it.
58 . I 'IBTAXFLG W !!," Person Class: None Active on ",$$FMTE^XLFDT(IBDT,2)
59 . S IBPX=$$PRVTYP^IBCRU6(+IBPRV,+IBDT)
60 . W !!,"RC Provider Group: ",$S(+IBPX:$P(IBPX,U,3)_", "_$P(IBPX,U,5)_"%",1:"None")
61 . W !,$TR($J(" ",IOM)," ","-")
62 Q
63 ;
64DISPNVA(IBIFN) ; Display Non-VA individual provider information.
65 N IBDT,IBI,IBNVFLG,IBNVID,IBNVTX,IBNVTX2,IBNVTXID,IBNVSL,X,Y,DIC,DA,IBTAXX12,IBPX
66 S IBDT=+$G(^DGCR(399,+$G(IBIFN),"U")) I 'IBDT S IBDT=DT
67 ; Select Non-VA Provider
68 F IBI=1:1 W ! S DIC("A")="Select NON-VA PROVIDER NAME: ",DIC="^IBA(355.93,",DIC(0)="AEQM",DIC("S")="I $P(^(0),U,2)=2" D ^DIC Q:Y'>0 D
69 . S IBNVID=+Y W !!,$TR($J(" ",IOM)," ","-")
70 . W !," Signature Name: ",$$GET1^DIQ(355.93,IBNVID_",",.01)
71 . W !," NPI: ",$$GET1^DIQ(355.93,IBNVID_",",41.01)
72 . W !
73 . S IBNVSL=$$GET1^DIQ(355.93,IBNVID_",",.12) ; Get and Display License info.
74 . W !," License(s): ",$S(IBNVSL'="":IBNVSL,1:"None Active on "_$$FMTE^XLFDT(IBDT,2))
75 . W !
76 . S IBNVTX=""
77 . S IBNVFLG=0
78 . F S IBNVTX=$O(^IBA(355.93,IBNVID,"TAXONOMY","D",IBNVTX),-1) Q:IBNVTX="" D ; Loop through prov's Person Class X-Ref.
79 . . S IBNVTX2=""
80 . . F S IBNVTX2=$O(^IBA(355.93,IBNVID,"TAXONOMY","D",IBNVTX,IBNVTX2)) Q:'IBNVTX2 D
81 . . . I $$GET1^DIQ(355.9342,IBNVTX2_","_IBNVID_",",.03,"I")="A" D ; Proceed if the Person Class is Active.
82 . . . . S IBNVFLG=1
83 . . . . S IBNVTXID=$$GET1^DIQ(355.9342,IBNVTX2_","_IBNVID_",",.01,"I")
84 . . . . ; Get Detailed Information and Display.
85 . . . . S IBPX=$$IEN2DATA^XUA4A72(IBNVTXID) ; Person Class Details.
86 . . . . S IBTAXX12=$$GET1^DIQ(8932.1,IBNVTXID_",",6) ; Get X12 Code.
87 . . . . W !," Person Class: ",$P(IBPX,U,6) ; Display Person Class Name.
88 . . . . W $S($G(IBNVTX)=1:" (Primary)",1:" (Secondary)")
89 . . . . W !," PROVIDER TYPE: ",$P(IBPX,U) ; Display Provider Type.
90 . . . . W !," CLASSIFICATION: ",$P(IBPX,U,2) ; Display Classification.
91 . . . . W !," SPECIALIZATION: ",$P(IBPX,U,3) ; Display Specialization.
92 . . . . W !," TAXONOMY: ",IBTAXX12,$S(IBTAXX12'="":" ("_IBNVTXID_")",1:""),! ; Display X12 Code and Internal Code (IEN).
93 . I 'IBNVFLG W !," Person Class: None Active on ",$$FMTE^XLFDT(IBDT,2),!
94 . W $TR($J(" ",IOM)," ","-"),!
95 Q
Note: See TracBrowser for help on using the repository browser.