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

ACDRR2CB.m

Go to the documentation of this file.
  1. ACDRR2CB ;IHS/ADC/EDE/KML - BROKE UP ACDRR2C;
  1. ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
  1. ;
  1. INTERV ; EP - PROCESS ALL INTERVENTIONS WITHIN DATE RANGE
  1. S ACDIDATE=$O(^ACDINTV("B",ACDDTLO),-1)
  1. F S ACDIDATE=$O(^ACDINTV("B",ACDIDATE)) Q:ACDIDATE=""!(ACDIDATE>ACDDTHI) D
  1. . S ACDINTV=0
  1. . F S ACDINTV=$O(^ACDINTV("B",ACDIDATE,ACDINTV)) Q:'ACDINTV D INTERV2
  1. . Q
  1. Q
  1. ;
  1. INTERV2 ; PROCESS ONE INTERVENTION
  1. Q:'$D(^ACDINTV(ACDINTV,0)) ; bad xref
  1. S ^("COUNT")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE","INTV","COUNT"))+1
  1. S X=^ACDINTV(ACDINTV,0)
  1. S ACDHRS=$P(X,U,26)
  1. I 'ACDHRS S ^("HOURS NR")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE","INTV","HOURS NR"))+1 Q
  1. S ^("HOURS")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE","INTV","HOURS"))+ACDHRS
  1. S ^("HOURS CNT")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE","INTV","HOURS CNT"))+1
  1. S ACDINTVM=0
  1. F S ACDINTVM=$O(^ACDINTV(ACDINTV,2,ACDINTVM)) Q:'ACDINTVM S X=^(ACDINTVM,0) D INTVM
  1. Q
  1. ;
  1. INTVM ; PROCESS ONE INTERVENTIONS MEMEBER (PROVIDER)
  1. S ACDWPROV=$P(X,U) ; provider
  1. ;D PFTV^XBPFTV(6,ACDWPROV,.ACDWPROV) ; ** ^DIC(6, **
  1. S ACDWPROV=$P($G(^VA(200,ACDWPROV,0)),U)
  1. S:ACDWPROV="" ACDWPROV=$P(X,U)
  1. S ^("COUNT")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDWPROV,"VT","INTV","COUNT"))+1
  1. S ^("HOURS")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDWPROV,"VT","INTV","HOURS"))+ACDHRS
  1. S ^("HOURS CNT")=$G(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDWPROV,"VT","INTV","HOURS CNT"))+1
  1. Q