close Warning: Can't use blame annotator: 
svn blame failed on WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBTRE20.m: 'GenericSWIGWrapper' object has no attribute '_wrap'

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

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

initial load of WorldVistAEHR
File size: 3.2 KB
RevLine 
1IBTRE20 ;ALB/AAS - CLAIMS TRACKING EXECUTABLE HELP ;13-OCT-93
2 ;;2.0;INTEGRATED BILLING;**40,91,249**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;
6LISTA ; -- list inpatient admissions for patient
7 N C,I,J,N,X,Y,IBX
8 K ^TMP("IBM",$J)
9 Q:'$D(DFN)
10 S C=0 F I=0:0 S I=$O(^DGPM("ATID1",DFN,I)) Q:'I S N=$O(^(I,0)) I $D(^DGPM(+N,0)) S D=^(0),C=C+1,^TMP("IBM",$J,C)=N_"^"_D
11 ;
12 I C=0 W !!,"No Admissions to Choose From." Q
13 ;
14 W !!,"CHOOSE FROM:" F IBI=1:1:10 Q:'$D(^TMP("IBM",$J,IBI)) D WRA
15 K ^TMP("IBM",$J)
16 Q
17 ;
18WRA S IBX=$P(^TMP("IBM",$J,IBI),"^",2,20),Y=+IBX X ^DD("DD")
19 W !," ",Y
20 W ?27,$S('$D(^DG(405.1,+$P(IBX,"^",4),0)):"",$P(^(0),"^",7)]"":$P(^(0),"^",7),1:$E($P(^(0),"^",1),1,20))
21 ;
22 W ?50,"TO: ",$E($P($G(^DIC(42,+$P(IBX,"^",6),0)),"^"),1,17)
23 I $D(^DG(405.4,+$P(IBX,"^",7),0)) W " [",$E($P(^(0),"^",1),1,10),"]"
24 I $P(IBX,"^",18)=9 W !?23,"FROM: ",$P($G(^DIC(4,+$P(IBX,"^",5),0)),"^")
25 Q
26 ;
27LISTO ; -- list outpatient appointments
28 N C,I,J,N,X,Y,IBX,IBI,IBDT
29 ; assumes ^TMP($J,"SDAMA301",DFN,IBTDT) defined and IBSD(result from SD)
30 Q:'$D(DFN)
31 ;
32 I IBSD<0 W !!,"Unable to look-up Outpatient Visits to Choose From." D Q
33 . N IBX F S IBX=$O(^TMP($J,"SDAMA301",IBX)) Q:'IBX W !?5,IBX,?10,$G(^(IBX))
34 ;
35 I IBSD=0 W !!,"No Outpatient Visits to Choose From." Q
36 ;
37 W !!,"CHOOSE FROM:" S IBI=0,IBDT=$G(IBTBDT) F S IBDT=$O(^TMP($J,"SDAMA301",DFN,IBDT)),IBI=IBI+1 Q:'IBDT!(IBI>12) D WRO
38 Q
39 ;
40WRO N IBSDD,Y
41 S Y=IBDT X ^DD("DD") W !," ",Y
42 S IBSDD=$G(^TMP($J,"SDAMA301",DFN,IBDT))
43 W ?27,"Clinic: ",$P($P(IBSDD,"^",2),";",2),?60," Type: ",$E($P($P(IBSDD,"^",10),";",2),1,12)
44 ;
45 S IBSDD=$P(IBSDD,"^",3) I $L(IBSDD),$P(IBSDD,";")'="R" W !,?10," [Status: ",$P(IBSDD,";",2),"]"
46 Q
47 ;
48LISTS ; -- list scheduled admissions
49 N C,I,J,N,X,Y,IBX,IBI
50 K ^TMP("IBM",$J)
51 Q:'$D(DFN)
52 S C=0 F I=0:0 S I=$O(^DGS(41.1,"B",DFN,I)) Q:'I I $D(^DGS(41.1,+I,0)) S D=$G(^DGS(41.1,+I,0)) I $P(D,"^",2)'<IBTBDT,$P(D,"^",2)'>IBTEDT S C=C+1,^TMP("IBM",$J,C)=I_"^"_D
53 ;
54 I C=0 W !!,"No Scheduled Admissions to Choose From." Q
55 ;
56 W !!,"CHOOSE FROM:" F IBI=1:1:12 Q:'$D(^TMP("IBM",$J,IBI)) D WRS
57 K ^TMP("IBM",$J)
58 Q
59 ;
60WRS S IBX=$P($G(^TMP("IBM",$J,IBI)),"^",2,20),Y=$P(IBX,"^",2) X ^DD("DD")
61 W !," ",Y
62 W ?27," Spec: ",$E($P($G(^DIC(45.7,+$P(IBX,"^",9),0)),"^"),1,25)
63 ;
64 W ?58," To: ",$E($P($G(^DIC(42,+$P(IBX,"^",8),0)),"^"),1,16)
65 Q
66 ;
67FINDS ; -- match a scheduled admission
68 Q:'$D(DFN)
69 Q:'$D(IBTDT)
70 N I,J
71 S I=0 F S I=$O(^DGS(41.1,"B",DFN,I)) Q:'I S J=$P($G(^DGS(41.1,I,0)),"^",2) Q:IBTDT=J I $P(IBTDT,".")=$P(J,".") S IBTDT=J Q
72 Q
73 ;
74ID ; -- write out identifier for entry, called by ^dd(356,0,"id","write")
75 N IBOE,IBOE0
76 S IBOE=$P(^(0),"^",4),IBOE0=$$SCE^IBSDU(+IBOE) I IBOE,$P(IBOE0,U,4) W ?58,"["_$E($P($G(^SC(+$P(IBOE0,U,4),0)),U),1,20),"]"
77 Q
78 ;
79PRINT ; patch 40, custom look up. Input: IBX -- 0th node in file #356.
80 Q:$D(IBX)[0
81 N NAM,EPIS,EVENT,DISPL,CLIN
82 S NAM=$E($P($G(^DPT(+$P(IBX,U,2),0)),U),1,22)
83 S EPIS=$P($P(IBX,U,6),".")
84 I EPIS S EPIS=$E(EPIS,4,5)_"-"_$E(EPIS,6,7)_"-"_$E(EPIS,2,3)
85 S EVENT=$E($P($G(^IBE(356.6,+$P(IBX,U,18),0)),U),1,5)
86 S DISPL=$$EXPAND^IBTRE(356,.07,$P(IBX,U,7))
87 S CLIN=+$$SCE^IBSDU(+$P(IBX,"^",4),4)
88 I CLIN S DISPL="["_$E($P($G(^SC(CLIN,0)),U),1,22)_"]"
89 W ?13,NAM,?37,EPIS,?47,EVENT,?54,DISPL
90 Q
Note: See TracBrowser for help on using the repository browser.