Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBOCNC1

IBOCNC1.m

Go to the documentation of this file.
  1. IBOCNC1 ;ALB/ARH - CPT USAGE IN CLINICS (SEARCH); 1/23/92
  1. ;;2.0;INTEGRATED BILLING;**91,133**;21-MAR-94
  1. ;
  1. ;entry pt. for tasked jobs
  1. FIND ;find, save, and print the data that satisfies the search parameters, save clinic/division names
  1. ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOCNC" D T1^%ZOSV ;stop rt clock
  1. ;S XRTL=$ZU(0),XRTN="IBOCNC-2" D T0^%ZOSV ;start rt clock
  1. I VAUTC,VAUTD S ^TMP("IBCU",$J,"D","ALL")="",IBPRC(1)="ALL DIVISIONS AND CLINICS"
  1. S X=0
  1. I VAUTC,'VAUTD S X=X+1,IBC="",IBPRC(X)="DIVISIONS: ",IBDIV="" F IBI=1:1 S IBDIV=$O(VAUTD(IBDIV)) Q:IBDIV="" D
  1. . S ^TMP("IBCU",$J,"D",IBDIV)=""
  1. . I ($L(IBPRC(X))+$L(VAUTD(IBDIV))+2)>IOM S X=X+1,IBPRC(X)=" ",IBC=""
  1. . S IBPRC(X)=IBPRC(X)_IBC_VAUTD(IBDIV),IBC=", "
  1. I 'VAUTC S X=X+1,IBC="",IBPRC(X)="CLINICS: ",IBCLN="" F IBI=1:1 S IBCLN=$O(VAUTC(IBCLN)) Q:IBCLN="" D
  1. . S ^TMP("IBCU",$J,"C",IBCLN)=""
  1. . I ($L(IBPRC(X))+$L(VAUTC(IBCLN))+2)>IOM S X=X+1,IBPRC(X)=" ",IBC=""
  1. . S IBPRC(X)=IBPRC(X)_IBC_VAUTC(IBCLN),IBC=", "
  1. K VAUTD,VAUTC,IBC,X
  1. ;entire divisions were chosen, find all clinics
  1. 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)=""
  1. I $D(^TMP("IBCU",$J,"D")) S IBCLN="" F IBI=1:1 S IBCLN=$O(^SC(IBCLN)) Q:IBCLN'?1N.N D
  1. . S IBLN=$G(^SC(IBCLN,0)) Q:$P(IBLN,"^",3)'="C"!('$D(^TMP("IBCU",$J,"D",+$P(IBLN,"^",15))))
  1. . S ^TMP("IBCU",$J,"C",IBCLN)=""
  1. K IBLN,IBCLN,IBDIV,IBI,^TMP("IBCU",$J,"D")
  1. ;I $D(XRT0),'$D(^TMP("IBCU",$J,"C")) S:'$D(XRTN) XRTN="IBOCNC" D T1^%ZOSV ;stop rt clock
  1. Q:'$D(^TMP("IBCU",$J,"C"))
  1. ;
  1. SAVE ;for each clinic chosen collect counts on CPTs used and save in sorted tmp file
  1. N IBVAL,IBCBK,IBFILTER
  1. S IBVAL("BDT")=IBBDT,IBVAL("EDT")=IBEDT+.3
  1. ; Must be an encounter for one of the clinics chosen,
  1. ; only count each visit (in v-file) once
  1. S IBFILTER=""
  1. 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"
  1. S IBQ=0
  1. K ^TMP("VIS",$J)
  1. D SCAN^IBSDU("DATE/TIME",.IBVAL,IBFILTER,IBCBK)
  1. ;
  1. K IBB,IBE,IBX,IBCLN,IBCLNN,IBCPT,IBLN,IBI,^TMP("IBCU",$J,"C"),^TMP("VIS",$J)
  1. D:IBSRT BILL
  1. PRINT I 'IBQ D ^IBOCNC2
  1. K IBPRC,IBSRT,IBQ,^TMP("IBCU",$J)
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOCNC" D T1^%ZOSV ;stop rt clock
  1. Q
  1. ;
  1. BILL ;when sorting by CPT, get count on CPT's entered in billing for the date range
  1. ;count number of CPTs in old format, using event date as procedure date
  1. Q:IBQ S IBEVDT=IBBDT-.001,IBE=IBEDT+.3
  1. F S IBEVDT=$O(^DGCR(399,"D",IBEVDT)) Q:IBEVDT=""!(IBEVDT>IBE)!IBQ D S IBQ=$$STOP
  1. . S IBN="" F S IBN=$O(^DGCR(399,"D",IBEVDT,IBN)) Q:IBN="" D
  1. .. 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"))
  1. .. 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
  1. ;count number of CPTs in "CP" multiple using the cross-reference and the correct procedure date
  1. Q:IBQ S IBPDT=-(IBEDT+.3)
  1. F S IBPDT=$O(^DGCR(399,"ASD",IBPDT)) Q:IBPDT=""!(-IBPDT<IBBDT)!IBQ D S IBQ=$$STOP
  1. . S IBCPT="" F S IBCPT=$O(^DGCR(399,"ASD",IBPDT,IBCPT)) Q:IBCPT="" D
  1. .. S IBN="" F S IBN=$O(^DGCR(399,"ASD",IBPDT,IBCPT,IBN)) Q:IBN="" D
  1. ... Q:$P($G(^DGCR(399,IBN,0)),U,13)=7
  1. ... S IBX="" F S IBX=$O(^DGCR(399,"ASD",IBPDT,IBCPT,IBN,IBX)) Q:IBX="" D
  1. .... S ^TMP("IBCU",$J,+IBCPT,"B")=$G(^TMP("IBCU",$J,+IBCPT,"B"))+1,^TMP("IBCU",$J,"B")=$G(^TMP("IBCU",$J,"B"))+1
  1. K IBEVDT,IBPDT,IBN,IBE,IBI,IBCPT,IBX
  1. Q
  1. ;
  1. CKENC(IBOE,IBOE0,SDSTOP) ;
  1. N PARRAY,P,IBZERR,IBQUANTY
  1. I $$STOP S SDSTOP=1 Q
  1. D GETCPT^SDOE(IBOE,"PARRAY","IBZERR")
  1. Q:'$O(PARRAY(0))
  1. S IBCLN=$P(IBOE0,U,4)
  1. S P=0 F S P=$O(PARRAY(P)) Q:'P S IBCPT=+PARRAY(P) D
  1. . S IBQUANTY=$P($G(PARRAY(P)),U,16)
  1. . I IBSRT S ^TMP("IBCU",$J,IBCPT)=$G(^TMP("IBCU",$J,IBCPT))+IBQUANTY,^TMP("IBCU",$J)=$G(^TMP("IBCU",$J))+IBQUANTY Q
  1. . S IBCLNN=$P($G(^SC(IBCLN,0)),U),^TMP("IBCU",$J,IBCLNN,"N")=IBCLN
  1. . S ^TMP("IBCU",$J,IBCLNN)=$G(^TMP("IBCU",$J,IBCLNN))+IBQUANTY
  1. . S ^TMP("IBCU",$J,IBCLNN,IBCPT)=$G(^TMP("IBCU",$J,IBCLNN,IBCPT))+IBQUANTY
  1. Q
  1. ;
  1. STOP() ;check for user requested stop when queued
  1. I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ I +$G(IBPGN) W !!,"TASK STOPPED BY USER",!!
  1. Q +$G(ZTSTOP)