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

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

initial load of FOIAVistA 6/30/08 version
File size: 4.3 KB
Line 
1IBOCNC1 ;ALB/ARH - CPT USAGE IN CLINICS (SEARCH); 1/23/92
2 ;;2.0;INTEGRATED BILLING;**91,133**;21-MAR-94
3 ;
4 ;entry pt. for tasked jobs
5FIND ;find, save, and print the data that satisfies the search parameters, save clinic/division names
6 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOCNC" D T1^%ZOSV ;stop rt clock
7 ;S XRTL=$ZU(0),XRTN="IBOCNC-2" D T0^%ZOSV ;start rt clock
8 I VAUTC,VAUTD S ^TMP("IBCU",$J,"D","ALL")="",IBPRC(1)="ALL DIVISIONS AND CLINICS"
9 S X=0
10 I VAUTC,'VAUTD S X=X+1,IBC="",IBPRC(X)="DIVISIONS: ",IBDIV="" F IBI=1:1 S IBDIV=$O(VAUTD(IBDIV)) Q:IBDIV="" D
11 . S ^TMP("IBCU",$J,"D",IBDIV)=""
12 . I ($L(IBPRC(X))+$L(VAUTD(IBDIV))+2)>IOM S X=X+1,IBPRC(X)=" ",IBC=""
13 . S IBPRC(X)=IBPRC(X)_IBC_VAUTD(IBDIV),IBC=", "
14 I 'VAUTC S X=X+1,IBC="",IBPRC(X)="CLINICS: ",IBCLN="" F IBI=1:1 S IBCLN=$O(VAUTC(IBCLN)) Q:IBCLN="" D
15 . S ^TMP("IBCU",$J,"C",IBCLN)=""
16 . I ($L(IBPRC(X))+$L(VAUTC(IBCLN))+2)>IOM S X=X+1,IBPRC(X)=" ",IBC=""
17 . S IBPRC(X)=IBPRC(X)_IBC_VAUTC(IBCLN),IBC=", "
18 K VAUTD,VAUTC,IBC,X
19 ;entire divisions were chosen, find all clinics
20 I $D(^TMP("IBCU",$J,"D","ALL")) S IBDIV="" F S IBDIV=$O(^DG(40.8,IBDIV)) Q:IBDIV'?1N.N S ^TMP("IBCU",$J,"D",IBDIV)=""
21 I $D(^TMP("IBCU",$J,"D")) S IBCLN="" F IBI=1:1 S IBCLN=$O(^SC(IBCLN)) Q:IBCLN'?1N.N D
22 . S IBLN=$G(^SC(IBCLN,0)) Q:$P(IBLN,"^",3)'="C"!('$D(^TMP("IBCU",$J,"D",+$P(IBLN,"^",15))))
23 . S ^TMP("IBCU",$J,"C",IBCLN)=""
24 K IBLN,IBCLN,IBDIV,IBI,^TMP("IBCU",$J,"D")
25 ;I $D(XRT0),'$D(^TMP("IBCU",$J,"C")) S:'$D(XRTN) XRTN="IBOCNC" D T1^%ZOSV ;stop rt clock
26 Q:'$D(^TMP("IBCU",$J,"C"))
27 ;
28SAVE ;for each clinic chosen collect counts on CPTs used and save in sorted tmp file
29 N IBVAL,IBCBK,IBFILTER
30 S IBVAL("BDT")=IBBDT,IBVAL("EDT")=IBEDT+.3
31 ; Must be an encounter for one of the clinics chosen,
32 ; only count each visit (in v-file) once
33 S IBFILTER=""
34 S IBCBK="I '$P(Y0,U,6),$D(^TMP(""IBCU"",$J,""C"",+$P(Y0,U,4))),'$D(^TMP(""VIS"",$J,+$P(Y0,U,5))) S ^TMP(""VIS"",$J,+$P(Y0,U,5))="""" D CKENC^IBOCNC1(Y,Y0,.SDSTOP) S:$G(SDSTOP) IBQ=1"
35 S IBQ=0
36 K ^TMP("VIS",$J)
37 D SCAN^IBSDU("DATE/TIME",.IBVAL,IBFILTER,IBCBK)
38 ;
39 K IBB,IBE,IBX,IBCLN,IBCLNN,IBCPT,IBLN,IBI,^TMP("IBCU",$J,"C"),^TMP("VIS",$J)
40 D:IBSRT BILL
41PRINT I 'IBQ D ^IBOCNC2
42 K IBPRC,IBSRT,IBQ,^TMP("IBCU",$J)
43 I $D(ZTQUEUED) S ZTREQ="@"
44 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOCNC" D T1^%ZOSV ;stop rt clock
45 Q
46 ;
47BILL ;when sorting by CPT, get count on CPT's entered in billing for the date range
48 ;count number of CPTs in old format, using event date as procedure date
49 Q:IBQ S IBEVDT=IBBDT-.001,IBE=IBEDT+.3
50 F S IBEVDT=$O(^DGCR(399,"D",IBEVDT)) Q:IBEVDT=""!(IBEVDT>IBE)!IBQ D S IBQ=$$STOP
51 . S IBN="" F S IBN=$O(^DGCR(399,"D",IBEVDT,IBN)) Q:IBN="" D
52 .. Q:$P($G(^DGCR(399,IBN,0)),"^",9)'=4!('$D(^DGCR(399,IBN,"C")))!($P($G(^DGCR(399,IBN,0)),"^",13)=7) S IBX=$G(^DGCR(399,IBN,"C"))
53 .. F IBI=1,2,3,7,8,9 S IBCPT=$P(IBX,"^",IBI) I $$CPT^ICPTCOD(+IBCPT)>0 S ^TMP("IBCU",$J,+IBCPT,"B")=$G(^TMP("IBCU",$J,+IBCPT,"B"))+1,^TMP("IBCU",$J,"B")=$G(^TMP("IBCU",$J,"B"))+1
54 ;count number of CPTs in "CP" multiple using the cross-reference and the correct procedure date
55 Q:IBQ S IBPDT=-(IBEDT+.3)
56 F S IBPDT=$O(^DGCR(399,"ASD",IBPDT)) Q:IBPDT=""!(-IBPDT<IBBDT)!IBQ D S IBQ=$$STOP
57 . S IBCPT="" F S IBCPT=$O(^DGCR(399,"ASD",IBPDT,IBCPT)) Q:IBCPT="" D
58 .. S IBN="" F S IBN=$O(^DGCR(399,"ASD",IBPDT,IBCPT,IBN)) Q:IBN="" D
59 ... Q:$P($G(^DGCR(399,IBN,0)),U,13)=7
60 ... S IBX="" F S IBX=$O(^DGCR(399,"ASD",IBPDT,IBCPT,IBN,IBX)) Q:IBX="" D
61 .... S ^TMP("IBCU",$J,+IBCPT,"B")=$G(^TMP("IBCU",$J,+IBCPT,"B"))+1,^TMP("IBCU",$J,"B")=$G(^TMP("IBCU",$J,"B"))+1
62 K IBEVDT,IBPDT,IBN,IBE,IBI,IBCPT,IBX
63 Q
64 ;
65CKENC(IBOE,IBOE0,SDSTOP) ;
66 N PARRAY,P,IBZERR,IBQUANTY
67 I $$STOP S SDSTOP=1 Q
68 D GETCPT^SDOE(IBOE,"PARRAY","IBZERR")
69 Q:'$O(PARRAY(0))
70 S IBCLN=$P(IBOE0,U,4)
71 S P=0 F S P=$O(PARRAY(P)) Q:'P S IBCPT=+PARRAY(P) D
72 . S IBQUANTY=$P($G(PARRAY(P)),U,16)
73 . I IBSRT S ^TMP("IBCU",$J,IBCPT)=$G(^TMP("IBCU",$J,IBCPT))+IBQUANTY,^TMP("IBCU",$J)=$G(^TMP("IBCU",$J))+IBQUANTY Q
74 . S IBCLNN=$P($G(^SC(IBCLN,0)),U),^TMP("IBCU",$J,IBCLNN,"N")=IBCLN
75 . S ^TMP("IBCU",$J,IBCLNN)=$G(^TMP("IBCU",$J,IBCLNN))+IBQUANTY
76 . S ^TMP("IBCU",$J,IBCLNN,IBCPT)=$G(^TMP("IBCU",$J,IBCLNN,IBCPT))+IBQUANTY
77 Q
78 ;
79STOP() ;check for user requested stop when queued
80 I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ I +$G(IBPGN) W !!,"TASK STOPPED BY USER",!!
81 Q +$G(ZTSTOP)
Note: See TracBrowser for help on using the repository browser.