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/FEE_BASIS-FB/FBAADEM1.m

    r613 r623  
    1 FBAADEM1        ;AISC/DMK-DISPLAY PATIENT DEMOGRAPHICS ;14MAY92
    2         ;;3.5;FEE BASIS;**13,51,103**;JAN 30, 1995;Build 19
    3         ;;Per VHA Directive 2004-038, this routine should not be modified.
    4 EN      N FBDX,FBFDT,FBI,FBRR,FBT,FBTYPE,FBV,FBZ,PSA
    5         S:'$D(FBPROG) FBPROG="I 1"
    6         ;
    7         S Y=$G(^FBAAA(DFN,4)) W:$P(Y,"^")]"" !,"Fee ID Card #: ",$P(Y,"^"),?40,"Fee Card Issue Date: " S Y=$P(Y,"^",2) D PDF W Y,!
    8         ;
    9         I $O(^FBAAA(DFN,1,0)) D  Q:FBAAOUT
    10         . D HANG:$Y+5>IOSL Q:FBAAOUT
    11         . W !,"Patient Name: ",VADM(1),?55,"Pt.ID: ",$P(VADM(2),"^",2)
    12         . W !!,"AUTHORIZATIONS:",!
    13         . K FBAUT
    14         . S FBZ=0,FBFDT="9999999"
    15         . F  S FBFDT=$O(^FBAAA(DFN,1,"B",FBFDT),-1) Q:'FBFDT  D  Q:FBAAOUT
    16         . . S FBI=0 F  S FBI=$O(^FBAAA(DFN,1,"B",FBFDT,FBI)) Q:'FBI  I $D(^FBAAA(DFN,1,FBI,0)) X FBPROG I  S FBZ=FBZ+1,X=^(0) D  Q:FBAAOUT
    17         . . . S Y=+X,PSA=$P(X,"^",5),FBT=$P(X,"^",13),FBV=+$P(X,"^",4) D PDF
    18         . . . W ?3,"(",FBZ,")",?7,"FR: ",Y,?25,"VENDOR: ",$S($D(^FBAAV(FBV,0)):$P(^(0),"^")_" - "_$P(^(0),"^",2),1:"Not Specified")
    19         . . . S FBDX=$G(^FBAAA(DFN,1,FBI,3)) W !?7,"TO: " S Y=$P(X,"^",2) D PDF W Y,!?25,"Authorization Type: " D
    20         . . . . S FBTYPE=$P(X,"^",3),FBTYPE=$S(FBTYPE=2:"Outpatient - "_$S(FBT=1:"Short Term",FBT=2:"Home Health",FBT=3:"ID Card",1:""),$D(^FBAA(161.8,+FBTYPE,0)):$P(^(0),"^"),1:"Unknown")
    21         . . . W FBTYPE W:$P(X,"^",7) !,?11,"Purpose of Visit: ",$P($G(^FBAA(161.82,$P(X,"^",7),0)),"^") I $P(X,"^",9)["FB583(" W !?25,">> Unauthorized Claim <<"
    22         . . . ; PRXM/KJH - Patch 103. Add Referring Provider and NPI to the display.
    23         . . . W !?11,"DX: ",$P(X,"^",8) W ?40,"REF: "
    24         . . . I $P(X,"^",21)'="" W $$GET1^DIQ(200,$P(X,"^",21),.01)
    25         . . . W !?11,"REF NPI: ",$$REFNPI^FBCH78($P(X,"^",21)),!
    26         . . . W:$P(FBDX,"^")]"" !?15,$P(FBDX,"^") W:$P(FBDX,"^",2)]"" !?15,$P(FBDX,"^",2)
    27         . . . S FBAUT($P(X,"^"))=$P(X,"^",2)
    28         . . . W !?7,"County: ",FBCOUNTY,?40,"PSA: ",$S($D(^DIC(4,+PSA,0)):$P(^(0),"^"),1:"Unknown"),!
    29         . . . S FBDEL=$G(^FBAAA(DFN,1,FBI,"ADEL")) I FBDEL]"" S Y=$P(FBDEL,"^",2) D PDF W ?12,">> DELETE MRA SENT TO AUSTIN ON - ",Y," >>",!
    30         . . . I $D(^FBAAA(DFN,1,FBI,2,0)) K ^UTILITY($J,"W") S DIWL=15,DIWR=70,DIWF="W" D HANG:$Y+6>IOSL Q:FBAAOUT  W !?11,"REMARKS:" D
    31         . . . . S FBRR=0 F  S FBRR=$O(^FBAAA(DFN,1,FBI,2,FBRR)) Q:'FBRR  S (FBXX,X)=^(FBRR,0) D ^DIWP
    32         . . . D ^DIWW:$D(FBXX) K FBXX W !
    33         . . . K X,FBDX,FBT,FBTYPE,FBV,PSA D HANG:$Y+5>IOSL
    34         ;
    35         D HANG:$Y+5>IOSL Q:FBAAOUT
    36         ;
    37         I $O(^FBAAA(DFN,2,0))>0 D  Q:FBAAOUT
    38         . W !,"VENDOR CONTACTS:"
    39         . S (FBZ,FBI)=0
    40         . F  S FBI=$O(^FBAAA(DFN,2,FBI)) Q:'FBI!(FBAAOUT)  S FBZ=FBZ+1,X=$G(^(FBI,0)),Y=+X D PDF D
    41         . . W !?3,"(",FBZ,")",?7,"DATE: ",Y,?25,"VENDOR: ",$P(X,"^",2),?55,"PHONE: ",$S($P(X,"^",3)]"":$P(X,"^",3),1:"Not Found")
    42         . . I $D(^FBAAA(DFN,2,FBI,1,0)) K ^UTILITY($J,"W") S DIWL=20,DIWR=70,DIWF="W" D HANG:$Y+5>IOSL Q:FBAAOUT  W !?11,"NARRATIVE:",! D
    43         . . . S FBRR=0 F  S FBRR=$O(^FBAAA(DFN,2,FBI,1,FBRR)) Q:'FBRR  S FBXX=^(FBRR,0) D HANG:$Y+5>IOSL Q:FBAAOUT  S X=FBXX D ^DIWP
    44         . . D ^DIWW:$D(FBXX) K FBXX W !
    45         Q
    46         ;
    47 HANG    I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR S:'Y FBAAOUT=1
    48         W @IOF I 'FBAAOUT W !,"Patient Name: ",VADM(1),?55,"Pt.ID: ",$P(VADM(2),"^",2),!
    49         Q
    50         ;
    51 PDF     S:Y Y=$$FMTE^XLFDT(Y,5)  ; TRANSLATE TO DISPLAY DATE
    52         Q
     1FBAADEM1 ;AISC/DMK-DISPLAY PATIENT DEMOGRAPHICS ;14MAY92
     2 ;;3.5;FEE BASIS;**13,51**;JAN 30, 1995
     3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
     4EN N FBDX,FBFDT,FBI,FBRR,FBT,FBTYPE,FBV,FBZ,PSA
     5 S:'$D(FBPROG) FBPROG="I 1"
     6 ;
     7 S Y=$G(^FBAAA(DFN,4)) W:$P(Y,"^")]"" !,"Fee ID Card #: ",$P(Y,"^"),?40,"Fee Card Issue Date: " S Y=$P(Y,"^",2) D PDF W Y,!
     8 ;
     9 I $O(^FBAAA(DFN,1,0)) D  Q:FBAAOUT
     10 . D HANG:$Y+5>IOSL Q:FBAAOUT
     11 . W !,"Patient Name: ",VADM(1),?55,"Pt.ID: ",$P(VADM(2),"^",2)
     12 . W !!,"AUTHORIZATIONS:",!
     13 . K FBAUT
     14 . S FBZ=0,FBFDT="9999999"
     15 . F  S FBFDT=$O(^FBAAA(DFN,1,"B",FBFDT),-1) Q:'FBFDT  D  Q:FBAAOUT
     16 . . S FBI=0 F  S FBI=$O(^FBAAA(DFN,1,"B",FBFDT,FBI)) Q:'FBI  I $D(^FBAAA(DFN,1,FBI,0)) X FBPROG I  S FBZ=FBZ+1,X=^(0) D  Q:FBAAOUT
     17 . . . S Y=+X,PSA=$P(X,"^",5),FBT=$P(X,"^",13),FBV=+$P(X,"^",4) D PDF
     18 . . . W ?3,"(",FBZ,")",?7,"FR: ",Y,?25,"VENDOR: ",$S($D(^FBAAV(FBV,0)):$P(^(0),"^")_" - "_$P(^(0),"^",2),1:"Not Specified")
     19 . . . S FBDX=$G(^FBAAA(DFN,1,FBI,3)) W !?7,"TO: " S Y=$P(X,"^",2) D PDF W Y,!?25,"Authorization Type: " D
     20 . . . . S FBTYPE=$P(X,"^",3),FBTYPE=$S(FBTYPE=2:"Outpatient - "_$S(FBT=1:"Short Term",FBT=2:"Home Health",FBT=3:"ID Card",1:""),$D(^FBAA(161.8,+FBTYPE,0)):$P(^(0),"^"),1:"Unknown")
     21 . . . W FBTYPE W:$P(X,"^",7) !,?11,"Purpose of Visit: ",$P($G(^FBAA(161.82,$P(X,"^",7),0)),"^") I $P(X,"^",9)["FB583(" W !?25,">> Unauthorized Claim <<"
     22 . . . W !?11,"DX: ",$P(X,"^",8) W:$P(FBDX,"^")]"" !?15,$P(FBDX,"^") W:$P(FBDX,"^",2)]"" !?15,$P(FBDX,"^",2)
     23 . . . S FBAUT($P(X,"^"))=$P(X,"^",2)
     24 . . . W !?7,"County: ",FBCOUNTY,?40,"PSA: ",$S($D(^DIC(4,+PSA,0)):$P(^(0),"^"),1:"Unknown"),!
     25 . . . S FBDEL=$G(^FBAAA(DFN,1,FBI,"ADEL")) I FBDEL]"" S Y=$P(FBDEL,"^",2) D PDF W ?12,">> DELETE MRA SENT TO AUSTIN ON - ",Y," >>",!
     26 . . . I $D(^FBAAA(DFN,1,FBI,2,0)) K ^UTILITY($J,"W") S DIWL=15,DIWR=70,DIWF="W" D HANG:$Y+6>IOSL Q:FBAAOUT  W !?11,"REMARKS:" D
     27 . . . . S FBRR=0 F  S FBRR=$O(^FBAAA(DFN,1,FBI,2,FBRR)) Q:'FBRR  S (FBXX,X)=^(FBRR,0) D ^DIWP
     28 . . . D ^DIWW:$D(FBXX) K FBXX W !
     29 . . . K X,FBDX,FBT,FBTYPE,FBV,PSA D HANG:$Y+5>IOSL
     30 ;
     31 D HANG:$Y+5>IOSL Q:FBAAOUT
     32 ;
     33 I $O(^FBAAA(DFN,2,0))>0 D  Q:FBAAOUT
     34 . W !,"VENDOR CONTACTS:"
     35 . S (FBZ,FBI)=0
     36 . F  S FBI=$O(^FBAAA(DFN,2,FBI)) Q:'FBI!(FBAAOUT)  S FBZ=FBZ+1,X=$G(^(FBI,0)),Y=+X D PDF D
     37 . . W !?3,"(",FBZ,")",?7,"DATE: ",Y,?25,"VENDOR: ",$P(X,"^",2),?55,"PHONE: ",$S($P(X,"^",3)]"":$P(X,"^",3),1:"Not Found")
     38 . . I $D(^FBAAA(DFN,2,FBI,1,0)) K ^UTILITY($J,"W") S DIWL=20,DIWR=70,DIWF="W" D HANG:$Y+5>IOSL Q:FBAAOUT  W !?11,"NARRATIVE:",! D
     39 . . . S FBRR=0 F  S FBRR=$O(^FBAAA(DFN,2,FBI,1,FBRR)) Q:'FBRR  S FBXX=^(FBRR,0) D HANG:$Y+5>IOSL Q:FBAAOUT  S X=FBXX D ^DIWP
     40 . . D ^DIWW:$D(FBXX) K FBXX W !
     41 Q
     42 ;
     43HANG I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR S:'Y FBAAOUT=1
     44 W @IOF I 'FBAAOUT W !,"Patient Name: ",VADM(1),?55,"Pt.ID: ",$P(VADM(2),"^",2),!
     45 Q
     46 ;
     47PDF S:Y Y=$$FMTE^XLFDT(Y,5)  ; TRANSLATE TO DISPLAY DATE
     48 Q
Note: See TracChangeset for help on using the changeset viewer.