source: WorldVistAEHR/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDFOSG1.m@ 724

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

initial load of WorldVistAEHR

File size: 4.3 KB
Line 
1IBDFOSG1 ;ALB/MAF/AAS - SCANNED ENCOUNTERS WITH BILLING DATA CONT. ; JUL 6 1995
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;**29**;APR 24, 1997
3 ;
4START ; -- Loop thru clinics
5 N IBDFCLIN,IBQUIT
6 S IBQUIT=0
7 S ^TMP("GTOT",$J)="0^0^0^0^0^0^0^0^0"
8 F IBDFCLIN=0:0 S IBDFCLIN=$O(^SC(IBDFCLIN)) Q:'IBDFCLIN D CK(IBDFCLIN),BLD:'IBQUIT
9 Q
10 ;
11CHECK(CLIN) ;
12 ; -- Check to see if clinic has a form and its one that
13 ; is not for future use only.
14 N IBDFNODE,IBDFCL,HASFORM
15 S HASFORM=1
16 I $O(^SD(409.95,"B",+CLIN,0)) D
17 .S IBDFCL=$O(^SD(409.95,"B",+CLIN,0))
18 .S IBDFNODE=^SD(409.95,IBDFCL,0)
19 Q HASFORM
20 ;
21CK(XCL) ; -- Check clinic, division, form
22 Q:'$D(^SC(XCL,0))
23 S IBQUIT=0
24 S IBDFNODE=$G(^SC(XCL,0))
25 Q:$P(IBDFNODE,"^",3)'="C"
26 S IBDIVNM=$P($G(^DG(40.8,+$P(IBDFNODE,"^",15),0)),"^",1) I IBDIVNM="" S IBDIVNM=$S(IBDFMUL=0:$$PRIM^VASITE,1:"NOT SPECIFIED")
27 I VAUTD=0 Q:'$D(VAUTD(+$P(IBDFNODE,"^",15)))
28 I '$$CHECK(XCL) S IBQUIT=1 Q
29 S ^TMP("CTOT",$J,IBDIVNM,$P(IBDFNODE,"^",1))="0^0^0^0^0^0^0^0^0"
30 I '$D(^TMP("DTOT",$J,IBDIVNM)) S ^TMP("DTOT",$J,IBDIVNM)="0^0^0^0^0^0^0^0^0"
31 Q
32 ;
33BLD ; -- scan appts
34 F IBDFT=IBDFBEG:0 S IBDFT=$O(^SC(IBDFCLIN,"S",IBDFT)) Q:'IBDFT!($P(IBDFT,".",1)>IBDFEND) D
35 .F IBDFDA=0:0 S IBDFDA=$O(^SC(IBDFCLIN,"S",IBDFT,1,IBDFDA)) Q:'IBDFDA I $D(^SC(IBDFCLIN,"S",IBDFT,1,IBDFDA,0)) S IBDFSA=^(0) S DFN=+IBDFSA D CK1
36 Q
37 ;
38CK1 ; -- Check scheduling nodes, forms tracking, if scanned,
39 ; patient insured, bill entered, bill printed,
40 ; avg time from encounter to printed bill.
41 ;
42 I $P($G(^DPT(DFN,"S",IBDFT,0)),"^",2)]"" Q
43 N IBDFXPC,IBDFYPC
44 S IBDFXPC=$P(IBDFNODE,"^",1) ;Clinic name
45 S IBDFYPC=$P($G(^DPT(+$G(DFN),0)),"^",1) ;patient name
46 ;
47 I $D(^IBD(357.96,"APTAP",DFN,IBDFT)) S IBDFIFN=$O(^IBD(357.96,"APTAP",DFN,IBDFT,0)) I $P($G(^IBD(357.96,+IBDFIFN,0)),"^",11)>1,$P(^(0),"^",11)<5 D
48 .S (IBFLG1,IBFLG2,IBFLG3,IBFLG5,IBFLG6,IBFLG7,IBFLG8,IBFLG9)=0
49 .I $$INSURED^IBCNS1(DFN,IBDFT) S IBFLG3=1
50 .I '$D(^DGCR(399,"AOPV",DFN,$P(IBDFT,".",1))) D SET Q
51 .F IBDFNUM=0:0 S IBDFNUM=$O(^DGCR(399,"AOPV",DFN,$P(IBDFT,".",1),IBDFNUM)) Q:IBDFNUM']""!(IBFLG2) D
52 ..S IBMCNODE=$G(^DGCR(399,IBDFNUM,0))
53 ..S IBMCSND=$G(^DGCR(399,IBDFNUM,"S"))
54 ..Q:$P(IBMCSND,"^",17) ;canceled date
55 ..I 'IBFLG1,$P(IBMCSND,"^",1) D ;bill entered
56 ...S IBFLG1=1,^TMP("IBD-ENTERED",$J,IBDFNUM)="",^TMP("IBD-ENTERED",$J,IBDIVNM,IBDFNUM,DFN)=""
57 ..I $P(IBMCSND,"^",12),'$D(^TMP("IBD-PRINTED",$J,IBDFNUM)) S IBFLG2=1,^TMP("IBD-PRINTED",$J,IBDFNUM)="" ;bill printed
58 ..;
59 ..; -- find amount billed/received if unique bill
60 ..I IBFLG2,'$D(^TMP("IBD-BILL",$J,IBDFNUM)) D
61 ...S ^TMP("IBD-BILL",$J,IBDFNUM)=1
62 ...S IBFLG6=+$P(^DGCR(399,IBDFNUM,"U1"),"^")
63 ...S X=$$TPR^PRCAFN(IBDFNUM) S:X>0 IBFLG7=X
64 ...S IBFLG8=1 ;is new unique bill
65 ...S IBFLG9=+$P($G(^DGCR(399,IBDFNUM,"OP",0)),"^",4)
66 ...Q
67 ..Q
68 .;
69 .S X1=$S($P(IBMCSND,"^",12):$P(IBMCSND,"^",12),1:$G(VADAT("W"))),X2=IBDFT D ^%DTC S IBFLG5=X
70 .D SET
71 Q
72SET ; -- Set counters in temp arrays
73 ; Piece 1 := Number bills entered
74 ; Piece 2 := Number bills generated
75 ; Piece 3 := Number of forms scanned for patients with INS
76 ; Piece 4 := Number of forms scanned
77 ; Piece 5 := Number of days from encounter date to bill printed
78 ; Piece 6 := amount billed (for unique bill)
79 ; Piece 7 := amount received (for unique bills)
80 ; Piece 8 := number of unique bills
81 ; Piece 9 := Number of visit dates on bills in 8
82 ;
83 S ^TMP("MCCR",$J,IBDIVNM,IBDFXPC,IBDFYPC,DFN,IBDFT)=IBDFCLIN_"^"_^IBD(357.96,IBDFIFN,0)
84 ;
85 S IBDFTMP=^TMP("CTOT",$J,IBDIVNM,$P(IBDFNODE,"^",1))
86 S IBDFTMP1=^TMP("DTOT",$J,IBDIVNM)
87 S IBDFTMP2=^TMP("GTOT",$J)
88 ;
89 I IBFLG1 D INC(1,1) ; Bills Entered
90 I IBFLG2 D INC(2,1) ; Bills Generated
91 I IBFLG3 D INC(3,1) ; With insurance
92 D INC(4,1) ; number scanned
93 I IBFLG5 D INC(5,IBFLG5) ;Days from encounter to Printed Bill
94 I IBFLG6 D INC(6,IBFLG6) ;Amount billed
95 I IBFLG7 D INC(7,IBFLG7) ;Amount Received
96 I IBFLG8 D INC(8,1) ; Number of Bills
97 I IBFLG9 D INC(9,IBFLG9) ;number of visits on bills
98 ;
99 S ^TMP("CTOT",$J,IBDIVNM,$P(IBDFNODE,"^",1))=IBDFTMP
100 S ^TMP("DTOT",$J,IBDIVNM)=IBDFTMP1
101 S ^TMP("GTOT",$J)=IBDFTMP2
102 Q
103 ;
104INC(PIECE,VALUE) ;
105 ; -- increment counters,
106 S $P(IBDFTMP,"^",PIECE)=$P(IBDFTMP,"^",PIECE)+VALUE
107 S $P(IBDFTMP1,"^",PIECE)=$P(IBDFTMP1,"^",PIECE)+VALUE
108 S $P(IBDFTMP2,"^",PIECE)=$P(IBDFTMP2,"^",PIECE)+VALUE
109 Q
Note: See TracBrowser for help on using the repository browser.