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

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

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1IBOVOP1 ;ALB/RLW-Report of Visits for NSC Outpatients ;12-JUN-92
2 ;;2.0;INTEGRATED BILLING;**52,91,99,132,156,176,234,249,339**;21-MAR-94;Build 2
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5MAIN(IBQUERY) ; perform report for day(s)
6 ; IBQUERY = the query object to use to search for outpt encounters
7 ; if not a valid #, a new QUERY will be created
8 D HDR^IBOVOP2
9 I $$STOP^IBOUTL("Outpatient/Registration Events Report") S IBQUIT=1 G END
10 ; scan visits for NSC patients
11 N IBVAL,IBCBK,IBCK,IBFILTER,IBPB,IBOE,IBOE0,IBZ
12 S IBVAL("BDT")=IBDATE,IBVAL("EDT")=IBDATE\1+.99
13 S IBFILTER=""
14 ; Look for hospital location is a clinic-type, valid Means-Test or LTC patient, and potentially billable events
15 S IBCBK="I $D(^SC(""AC"",""C"",+$P(Y0,U,4))) D IBCBK^IBOVOP1(Y,Y0,.IBCK)" ; Action of scanning
16 F IBZ=9,13.1 S IBCK(IBZ)=""
17 D SCAN^IBSDU("DATE/TIME",.IBVAL,"",IBCBK,0,.IBQUERY) K ^TMP("DIERR",$J)
18 ; Search for Inpatient Observations
19 D IBOVOP^IBECEAU5(IBDATE)
20 D PRINT^IBOVOP2
21END K DFN,^TMP("IBOVOP",$J),IBAPPT,IBJ,IB
22 Q
23 ;
24 ; To be executed only if the hospital location a clinic-type.
25 ; Check the record, and add to the ^TMP if needed
26 ; IBENC - encounter IEN
27 ; IBENCZ - encounter zero-node
28 ; IBCK - array of criteria flags for the $$BILLCK^IBAMTEDU() API call
29IBCBK(IBENC,IBENCZ,IBCK) ;
30 N IBPAT,IBDAT,Y,Y0,X
31 ; Quit if not a billable event
32 I '$$BILLCK^IBAMTEDU(IBENC,IBENCZ,.IBCK) Q
33 S IBDAT=+IBENCZ ; Date of event
34 S IBPAT=+$P(IBENCZ,U,2) Q:'IBPAT ; Patient IEN
35 ; Check for valid MT or LTC patient
36 I '$$BIL^DGMTUB(IBPAT,IBDAT),+$$LTCST^IBAECU(IBPAT,IBDAT,1)'=2 Q
37 D OPTENC(IBENC,IBENCZ) ; Extract Outpatient Encounter and add to the ^TMP global
38 Q
39 ;
40 ;
41OPTENC(IBOE,IBOE0) ; Extract outpatient encounter
42 N IBCL,DFN,IBFLD4,IBJ,IBSEQ
43 S DFN=+$P(IBOE0,U,2),IBJ=+IBOE0,IBCL=+$P(IBOE0,U,4),IBSEQ=0
44 Q:'$$BIL^DGMTUB(DFN,IBJ)
45 I $P(IBOE0,U,8)=1 D ; - appt
46 .; field 4=clinic
47 .; field 5=appt type
48 .; field 6=status
49 . S IBFLD4=$P($G(^SC(IBCL,0)),U)
50 . I IBFLD4'="" S:+$G(^SC(IBCL,"AT"))=6 IBFLD4=$E(IBFLD4,1,13)_" [R]"
51 . S ^TMP("IBOVOP",$J,$$FLD1(DFN),"CLINIC APPT",$$FLD3(IBJ),0)=$E(IBFLD4,1,17)_U_$$FLD5($P(IBOE0,U,10))_U_$E($$EXTERNAL^DILFD(409.68,.12,"",$P(IBOE0,"^",12)),1,17)_U_DFN_U_IBOE Q
52 ;
53 I $P(IBOE0,U,8)=2 D ; - add/edit stop code
54 .; field 5=appt type
55 . S ^TMP("IBOVOP",$J,$$FLD1(DFN),"STOP CODE",$$FLD3(IBJ),IBSEQ)=$E($P($G(^DIC(40.7,$P(IBOE0,U,3),0)),U),1,16)_U_$$FLD5($P(IBOE0,U,10))_"^^"_DFN_U_IBOE,IBSEQ=IBSEQ+1
56 ;
57 I $P(IBOE0,U,8)=3 D ; - registration
58 . Q:'$$DISCT^IBEFUNC(IBOE,IBOE0)
59 . S IBDATA=$$DISND^IBSDU(IBOE,IBOE0)
60 . S IBFLD4=$E($$EXTERNAL^DILFD(2.101,2,"",$P(IBDATA,U,3)),1,16)
61 . S Y=$E($$EXTERNAL^DILFD(2.101,6,"",$P(IBDATA,U,7)),1,30)
62 . S ^TMP("IBOVOP",$J,$$FLD1(DFN),"REGISTRATION",$$FLD3(IBJ),0)=IBFLD4_U_Y_"^^"_DFN_U_IBOE
63 ;
64 K IBB,IBE,IBX,IBY,IBCLN,IBXP,IBDFN,IBAPDT,IBAPTYP,X,Y
65 Q
66CKENC(IBOE,IBOE0,IBSEQ) ;
67 S DFN=$P(IBOE0,U,2),IBJ=+IBOE0
68 Q
69 ;
70FLD1(DFN) ; get patient name, l-4 ssn id, classification, insured?
71 I '$G(DFN) Q ""
72 N IBX,IBY,IBZ S IBX=$$PT^IBEFUNC(DFN),IBZ=""
73 D CL^IBACV(DFN,IBDATE,"",.IBY)
74 I $D(IBY(1)) S IBZ="AO"
75 I $D(IBY(2)) S IBZ=IBZ_$S(IBZ]"":"/",1:"")_"IR"
76 I $D(IBY(3)) S IBZ=IBZ_$S(IBZ]"":"/",1:"")_"SC"
77 I $D(IBY(4)) S IBZ=IBZ_$S(IBZ]"":"/",1:"")_"SWA"
78 I $D(IBY(5)) S IBZ=IBZ_$S(IBZ]"":"/",1:"")_"MST"
79 I $D(IBY(6)) S IBZ=IBZ_$S(IBZ]"":"/",1:"")_"HNC"
80 I $D(IBY(7)) S IBZ=IBZ_$S(IBZ]"":"/",1:"")_"CV"
81 I $D(IBY(8)) S IBZ=IBZ_$S(IBZ]"":"/",1:"")_"SHAD"
82 Q $E($P(IBX,U),1,20)_" "_$E(IBX)_$P(IBX,U,3)_$S(IBZ]"":" ["_IBZ_"]",1:"")_$S($$INSURED^IBCNS1(DFN,IBDATE):" **Insured**",1:"")
83 ;
84FLD3(Y) ; time - convert date/time to time only, no seconds
85 I '$G(Y) Q ""
86 X ^DD("DD") Q $P($P(Y,"@",2),":",1,2)
87 ;
88FLD5(I) ; get appointment type name
89 Q $E($P($G(^SD(409.1,+$G(I),0)),U,1),1,17)
Note: See TracBrowser for help on using the repository browser.