source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBTRED.m@ 1693

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

initial load of FOIAVistA 6/30/08 version
File size: 4.8 KB
Line 
1IBTRED ;ALB/AAS - EXPAND/EDIT CLAIMS TRACKING ENTRY ;01-JUL-1993
2 ;;2.0;INTEGRATED BILLING;**71,91,160,247,309,276,339,363**;21-MAR-94;Build 35
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5% ;
6EN ; -- main entry point for IBT EXPAND/EDIT TRACKING
7 I '$D(DT) D DT^DICRW
8 K XQORS,VALMEVL,DFN,IBTRN,IBTRV,IBTRC,IBTRD
9 I '$G(IBTRN) G EN^IBTRE Q ; entry from programmer mode
10 D EN^VALM("IBT EXPAND/EDIT TRACKING")
11 K IBFASTXT
12 Q
13 ;
14HDR ; -- header code
15 D PID^VADPT
16 S VALMHDR(1)="Expanded Claims Tracking Info for: "_$E($P($G(^DPT(DFN,0)),"^"),1,20)_" "_$E($G(^(0)),1)_VA("BID")_" ROI: "_$$EXPAND^IBTRE(356,.31,$P(^IBT(356,IBTRN,0),"^",31))
17 S VALMHDR(2)=" For: "_$$ETYP(IBTRN)
18 Q
19 ;
20INIT ; -- init variables and list array
21 K VALMQUIT
22 S VALMCNT=0,VALMBG=1
23 D BLD,HDR
24 Q
25 ;
26BLD ; -- list builder
27 N IBTRND,IBTRND1,IBTRND2,IBETYP
28 K ^TMP("IBTRED",$J)
29 F I=1:1:30 D BLANK(.I)
30 I '$G(IBTRPRF) S IBTRPRF=123
31 I IBTRPRF<10 S X=$S(IBTRPRF=1:"IBTRED HR MENU",IBTRPRF=2:"IBTRED IR MENU",IBTRPRF=3:"IBTRED BI MENU",1:"IBTRED MENU") D PROT^IBTRPR(X)
32 D KILL^VALM10()
33 S IBTRND=$G(^IBT(356,IBTRN,0)),IBTRND1=$G(^(1))
34 S IBETYP=$G(^IBE(356.6,+$P(IBTRND,"^",18),0))
35 S VALMCNT=30
36 D VISIT D ^IBTRED0,^IBTRED01
37 Q
38 ;
39VISIT ; -- Visit info Region
40 N OFFSET,START,IBOE,IBOE0
41 S START=1,OFFSET=2
42 D SET^IBCNSP(START,OFFSET," Visit Information ",IORVON,IORVOFF)
43 D SET^IBCNSP(START+1,OFFSET," Visit Type: "_$P(IBETYP,"^"))
44 I '$D(IBETYP) N IBETYP S IBETYP=$G(^IBE(356.6,+$P(IBTRND,"^",18),0))
45 S X=$P(IBETYP,"^",3) D @X
46 Q
471 ; -- visit region for admission or scheduled admission
48 I $P($G(^DGPM(+$P(IBTRND,"^",5),0)),"^",17) S VAINDT=+$G(^DGPM(+$P(IBTRND,"^",5),0))
49 I '$D(VAIN) S VA200="" D INP^VADPT
50 I VAIN(7)="" S Y=$P(IBTRND,"^",6) D D^DIQ S $P(VAIN(7),"^",2)=Y
51 D SET^IBCNSP(START+2,OFFSET,"Admission Date: "_$P(VAIN(7),"^",2))
52 D SET^IBCNSP(START+3,OFFSET," Ward: "_$P(VAIN(4),"^",2))
53 D SET^IBCNSP(START+4,OFFSET," Specialty: "_$P(VAIN(3),"^",2))
54 Q
552 ; -- visit region for outpatient care
56 S IBOE=$P(IBTRND,"^",4),IBOE0=$$SCE^IBSDU(+IBOE)
57 D SET^IBCNSP(START+2,OFFSET," Visit Date: "_$$DAT1^IBOUTL($P(IBTRND,"^",6),"2P"))
58 I +IBOE<1 D Q
59 .D SET^IBCNSP(START+3,OFFSET," No Outpatient Encounter Found") Q
60 D SET^IBCNSP(START+3,OFFSET," Clinic: "_$P($G(^SC(+$P(IBOE0,"^",4),0)),"^"))
61 D SET^IBCNSP(START+4,OFFSET," Appt. Status: "_$$EXPAND^IBTRE(409.68,.12,$P(IBOE0,"^",12)))
62 D SET^IBCNSP(START+5,OFFSET," Appt. Type: "_$$EXPAND^IBTRE(409.68,.1,$P(IBOE0,"^",10)))
63 D SET^IBCNSP(START+6,OFFSET," Special Cond: "_$$ENCL(IBOE))
64 Q
65 ;
663 ; -- visit region for rx refill
67 N PSONTALK,PSOTMP,PSOQTY
68 S PSONTALK=1 ;PSORXN=+$P(IBTRND,"^",8),PSOFILL=+$P(IBTRND,"^",10)
69 S X=+$P(IBTRND,"^",8)_"^"_+$P(IBTRND,"^",10) D EN^PSOCPVW
70 ;if refill was deleted and EN^PSOCPVW doesn't return any data use IB API
71 I '$D(PSOTMP) D PSOCPVW^IBNCPDPC(+$P(IBTRND,"^",2),+$P(IBTRND,"^",8),.PSOTMP)
72 S PSOQTY=$$NCPDPQTY^PSSBPSUT(+$$RXAPI1^IBNCPUT1(+$P(IBTRND,"^",8),6,"I"),PSOTMP(52,+$P(IBTRND,"^",8),7,"E"))
73 D SET^IBCNSP(START+2,OFFSET,"Prescription #: "_$G(PSOTMP(52,+$P(IBTRND,"^",8),.01,"E")))
74 ;I $P(IBTRND,"^",10)=0 D SET^IBCNSP(START+3,OFFSET," Fill Date: "_$G(PSOTMP(52,+$P(IBTRND,"^",8),22,"E")))
75 ;I +$P(IBTRND,"^",10) D SET^IBCNSP(START+3,OFFSET," Refill Date: "_$G(PSOTMP(52.1,+$P(IBTRND,"^",10),.01,"E")))
76 I $P(IBTRND,"^",10)=0 D SET^IBCNSP(START+3,OFFSET," Fill Date: "_$$FMTE^XLFDT(+$P(IBTRND,"^",6)))
77 I +$P(IBTRND,"^",10) D SET^IBCNSP(START+3,OFFSET," Refill Date: "_$$FMTE^XLFDT(+$P(IBTRND,"^",6)))
78 D SET^IBCNSP(START+4,OFFSET," Drug: "_$G(PSOTMP(52,+$P(IBTRND,"^",8),6,"E")))
79 D SET^IBCNSP(START+5,OFFSET," Rx Quantity: "_$J($G(PSOTMP(52,+$P(IBTRND,"^",8),7,"E")),8))
80 D SET^IBCNSP(START+6,OFFSET," Bill Quantity: "_$J($P(PSOQTY,"^"),11)_" "_$P(PSOQTY,"^",2))
81 D SET^IBCNSP(START+7,OFFSET," Days Supply: "_$J($G(PSOTMP(52,+$P(IBTRND,"^",8),8,"E")),8))
82 D SET^IBCNSP(START+8,OFFSET," NDC#: "_$$GETNDC^PSONDCUT(+$P(IBTRND,"^",8),$P(IBTRND,"^",10)))
83 D SET^IBCNSP(START+9,OFFSET," Physician: "_$G(PSOTMP(52,+$P(IBTRND,"^",8),4,"E")))
84 Q
85 ;
864 ; -- Visit region for prosthetics
87 D 4^IBTRED01
88 Q
89 ;
90HELP ; -- help code
91 S X="?" D DISP^XQORM1 W !!
92 Q
93 ;
94EXIT ; -- exit code
95 K VALMQUIT,IBTRN
96 D CLEAN^VALM10,FULL^VALM1
97 Q
98 ;
99BLANK(LINE) ; -- Build blank line
100 D SET^VALM10(.LINE,$J("",80))
101 Q
102 ;
103ETYP(IBTRN) ; -- Expand type of epidose and date
104 N IBY S IBY=""
105 S IBTRND=$G(^IBT(356,+IBTRN,0)) I IBTRND="" G ETYPQ
106 S IBETYPD=$G(^IBE(356.6,+$P(IBTRND,"^",18),0))
107 I IBETYPD="" G ETYPQ
108 S IBY=$P(IBETYPD,"^")_" on "_$$DAT1^IBOUTL($P(IBTRND,"^",6),"2P")
109ETYPQ Q IBY
110 ;
111ENCL(IBOE) ; -- output format of classifications
112 N I,X,IBCL,IBCL1 S IBCL=""
113 I '$G(IBOE) G ENCLQ
114 S IBCL1=$$ENCL^IBAMTS2(+IBOE)
115 F I=1:1:8 S X=$P(IBCL1,"^",I) S:X IBCL=IBCL_$S(I=1:"AO",I=2:"IR",I=3:"SC",I=4:"SWA",I=5:"MST",I=6:"HNC",I=7:"CV",I=8:"SHAD",1:"")_" "
116ENCLQ Q IBCL
117 ;
Note: See TracBrowser for help on using the repository browser.