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

IBDFOSG1.m

Go to the documentation of this file. 
  1. IBDFOSG1 ;ALB/MAF/AAS - SCANNED ENCOUNTERS WITH BILLING DATA CONT. ; JUL 6 1995
  1.  ;;3.0;AUTOMATED INFO COLLECTION SYS;**29**;APR 24, 1997
  1.  ;
  1. START ;  -- Loop thru clinics
  1.  N IBDFCLIN,IBQUIT
  1.  S IBQUIT=0
  1.  S ^TMP("GTOT",$J)="0^0^0^0^0^0^0^0^0"
  1.  F IBDFCLIN=0:0 S IBDFCLIN=$O(^SC(IBDFCLIN)) Q:'IBDFCLIN  D CK(IBDFCLIN),BLD:'IBQUIT
  1.  Q
  1.  ;
  1. CHECK(CLIN) ;
  1.  ;  -- Check to see if clinic has a form and its one that
  1.  ;     is not for future use only.
  1.  N IBDFNODE,IBDFCL,HASFORM
  1.  S HASFORM=1
  1.  I $O(^SD(409.95,"B",+CLIN,0)) D
  1.  .S IBDFCL=$O(^SD(409.95,"B",+CLIN,0))
  1.  .S IBDFNODE=^SD(409.95,IBDFCL,0)
  1.  Q HASFORM
  1.  ;
  1. CK(XCL) ;  -- Check clinic, division, form
  1.  Q:'$D(^SC(XCL,0))
  1.  S IBQUIT=0
  1.  S IBDFNODE=$G(^SC(XCL,0))
  1.  Q:$P(IBDFNODE,"^",3)'="C"
  1.  S IBDIVNM=$P($G(^DG(40.8,+$P(IBDFNODE,"^",15),0)),"^",1) I IBDIVNM="" S IBDIVNM=$S(IBDFMUL=0:$$PRIM^VASITE,1:"NOT SPECIFIED")
  1.  I VAUTD=0 Q:'$D(VAUTD(+$P(IBDFNODE,"^",15)))
  1.  I '$$CHECK(XCL) S IBQUIT=1 Q
  1.  S ^TMP("CTOT",$J,IBDIVNM,$P(IBDFNODE,"^",1))="0^0^0^0^0^0^0^0^0"
  1.  I '$D(^TMP("DTOT",$J,IBDIVNM)) S ^TMP("DTOT",$J,IBDIVNM)="0^0^0^0^0^0^0^0^0"
  1.  Q
  1.  ;
  1. BLD ; -- scan appts
  1.  F IBDFT=IBDFBEG:0 S IBDFT=$O(^SC(IBDFCLIN,"S",IBDFT)) Q:'IBDFT!($P(IBDFT,".",1)>IBDFEND)  D
  1.  .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
  1.  Q
  1.  ;
  1. CK1 ;  -- Check scheduling nodes, forms tracking, if scanned, 
  1.  ;           patient insured, bill entered, bill printed, 
  1.  ;           avg time from encounter to printed bill.
  1.  ;
  1.  I $P($G(^DPT(DFN,"S",IBDFT,0)),"^",2)]"" Q
  1.  N IBDFXPC,IBDFYPC
  1.  S IBDFXPC=$P(IBDFNODE,"^",1) ;Clinic name
  1.  S IBDFYPC=$P($G(^DPT(+$G(DFN),0)),"^",1) ;patient name
  1.  ;
  1.  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
  1.  .S (IBFLG1,IBFLG2,IBFLG3,IBFLG5,IBFLG6,IBFLG7,IBFLG8,IBFLG9)=0
  1.  .I $$INSURED^IBCNS1(DFN,IBDFT) S IBFLG3=1
  1.  .I '$D(^DGCR(399,"AOPV",DFN,$P(IBDFT,".",1))) D SET Q
  1.  .F IBDFNUM=0:0 S IBDFNUM=$O(^DGCR(399,"AOPV",DFN,$P(IBDFT,".",1),IBDFNUM)) Q:IBDFNUM']""!(IBFLG2)  D
  1.  ..S IBMCNODE=$G(^DGCR(399,IBDFNUM,0))
  1.  ..S IBMCSND=$G(^DGCR(399,IBDFNUM,"S"))
  1.  ..Q:$P(IBMCSND,"^",17)  ;canceled date
  1.  ..I 'IBFLG1,$P(IBMCSND,"^",1) D  ;bill entered
  1.  ...S IBFLG1=1,^TMP("IBD-ENTERED",$J,IBDFNUM)="",^TMP("IBD-ENTERED",$J,IBDIVNM,IBDFNUM,DFN)=""
  1.  ..I $P(IBMCSND,"^",12),'$D(^TMP("IBD-PRINTED",$J,IBDFNUM)) S IBFLG2=1,^TMP("IBD-PRINTED",$J,IBDFNUM)="" ;bill printed
  1.  ..;
  1.  ..; -- find amount billed/received if unique bill
  1.  ..I IBFLG2,'$D(^TMP("IBD-BILL",$J,IBDFNUM)) D
  1.  ...S ^TMP("IBD-BILL",$J,IBDFNUM)=1
  1.  ...S IBFLG6=+$P(^DGCR(399,IBDFNUM,"U1"),"^")
  1.  ...S X=$$TPR^PRCAFN(IBDFNUM) S:X>0 IBFLG7=X
  1.  ...S IBFLG8=1 ;is new unique bill
  1.  ...S IBFLG9=+$P($G(^DGCR(399,IBDFNUM,"OP",0)),"^",4)
  1.  ...Q
  1.  ..Q
  1.  .;
  1.  .S X1=$S($P(IBMCSND,"^",12):$P(IBMCSND,"^",12),1:$G(VADAT("W"))),X2=IBDFT D ^%DTC S IBFLG5=X
  1.  .D SET
  1.  Q
  1. SET ;  -- Set counters in temp arrays
  1.  ;     Piece 1 := Number bills entered
  1.  ;     Piece 2 := Number bills generated
  1.  ;     Piece 3 := Number of forms scanned for patients with INS
  1.  ;     Piece 4 := Number of forms scanned
  1.  ;     Piece 5 := Number of days from encounter date to bill printed
  1.  ;     Piece 6 := amount billed (for unique bill)
  1.  ;     Piece 7 := amount received (for unique bills)
  1.  ;     Piece 8 := number of unique bills
  1.  ;     Piece 9 := Number of visit dates on bills in 8
  1.  ;
  1.  S ^TMP("MCCR",$J,IBDIVNM,IBDFXPC,IBDFYPC,DFN,IBDFT)=IBDFCLIN_"^"_^IBD(357.96,IBDFIFN,0)
  1.  ;
  1.  S IBDFTMP=^TMP("CTOT",$J,IBDIVNM,$P(IBDFNODE,"^",1))
  1.  S IBDFTMP1=^TMP("DTOT",$J,IBDIVNM)
  1.  S IBDFTMP2=^TMP("GTOT",$J)
  1.  ;
  1.  I IBFLG1 D INC(1,1) ;     Bills Entered
  1.  I IBFLG2 D INC(2,1) ;     Bills Generated
  1.  I IBFLG3 D INC(3,1) ;     With insurance
  1.  D INC(4,1) ;              number scanned
  1.  I IBFLG5 D INC(5,IBFLG5) ;Days from encounter to Printed Bill
  1.  I IBFLG6 D INC(6,IBFLG6) ;Amount billed
  1.  I IBFLG7 D INC(7,IBFLG7) ;Amount Received
  1.  I IBFLG8 D INC(8,1) ;     Number of Bills
  1.  I IBFLG9 D INC(9,IBFLG9) ;number of visits on bills
  1.  ;
  1.  S ^TMP("CTOT",$J,IBDIVNM,$P(IBDFNODE,"^",1))=IBDFTMP
  1.  S ^TMP("DTOT",$J,IBDIVNM)=IBDFTMP1
  1.  S ^TMP("GTOT",$J)=IBDFTMP2
  1.  Q
  1.  ;
  1. INC(PIECE,VALUE) ;
  1.  ; -- increment counters, 
  1.  S $P(IBDFTMP,"^",PIECE)=$P(IBDFTMP,"^",PIECE)+VALUE
  1.  S $P(IBDFTMP1,"^",PIECE)=$P(IBDFTMP1,"^",PIECE)+VALUE
  1.  S $P(IBDFTMP2,"^",PIECE)=$P(IBDFTMP2,"^",PIECE)+VALUE
  1.  Q