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

BCHRC9.m

Go to the documentation of this file.
  1. BCHRC9 ; IHS/CMI/LAB - CHR Report 2 ;
  1. ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
  1. ;IHS/CMI/LAB - PATCH 6 fixed logic on total services
  1. ;
  1. I '$G(DUZ(2)) W $C(7),$C(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER!!",!! Q
  1. S BCHJOB=$J,BCHBTH=$H
  1. D INFORM
  1. GETDATES ;
  1. BD ;get beginning date
  1. W ! S DIR(0)="D^:DT:EP",DIR("A")="Enter BEGINNING Date of Service for Report" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1. I $D(DIRUT) G XIT
  1. S BCHBD=Y
  1. ED ;get ending date
  1. W ! S DIR(0)="D^"_BCHBD_":DT:EP",DIR("A")="Enter ENDING Date of Service for Report" S Y=BCHBD D DD^%DT S DIR("B")=Y,Y="" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1. I $D(DIRUT) G BD
  1. S BCHED=Y
  1. S X1=BCHBD,X2=-1 D C^%DTC S BCHSD=X
  1. ;
  1. PROG ;IHS/CMI/LAB - added program screen
  1. S BCHPRG=""
  1. S DIR(0)="Y",DIR("A")="Include data from ALL CHR Programs",DIR("B")="N",DIR("?")="If you wish to include visits from ALL programs answer Yes. If you wish to tabulate for only one program enter NO." D ^DIR K DIR
  1. G:$D(DIRUT) BD
  1. I Y=1 S BCHPRG="" G REG
  1. PROG1 ;enter program
  1. K X,DIC,DA,DD,DR,Y S DIC("A")="Which CHR Program: ",DIC="^BCHTPROG(",DIC(0)="AEMQ" D ^DIC K DIC,DA G:Y<0 PROG
  1. S BCHPRG=+Y
  1. REG ;
  1. S BCHREG="",BCHREGN=""
  1. S DIR(0)="S^R:Registered Patients;N:Non-Registered Patients;B:Both Registered and Non-Registered Patients",DIR("A")="Include which Patients",DIR("B")="B" KILL DA D ^DIR KILL DIR
  1. I $D(DIRUT) G PROG
  1. S BCHREG=Y,BCHREGN=Y(0)
  1. ZIS ;CALL TO XBDBQUE
  1. S XBRP="^BCHRC9P",XBRC="PROC^BCHRC9",XBRX="XIT^BCHRC9",XBNS="BCH"
  1. D ^XBDBQUE
  1. D XIT
  1. Q
  1. ERR W $C(7),$C(7),!,"Must be a valid date and be Today or earlier. Time not allowed!" Q
  1. XIT ;
  1. K V,BCHSD,BCHBD,BCHBDD,BCHED,BCHEDD,BCHODAT,BCHR,BCHR0,X,P,S,N,BCHQUIT,BCHBTH,BCHDT,BCHNAME,BCHPRG,BCHBT,BCHJOB
  1. K X,Y
  1. Q
  1. ;
  1. INFORM ;
  1. W:$D(IOF) @IOF
  1. W !?20,"********** CHR REPORT NO. 9 **********"
  1. W !!?28,"DATA SUMMARY BY PROVIDER",!!,"You must enter the time frame for the report.",!
  1. Q
  1. ;
  1. ;
  1. PROC ;EP - PROCESS REFERRAL REPORT
  1. D XTMP^BCHUTIL("BCHRC9","CHR CHR REPORT")
  1. S (BCHBT,BCHBTH)=$H,BCHJOB=$J
  1. S ^XTMP("BCHRC9",BCHJOB,BCHBT,"TOTAL")=0
  1. D D,EOJ
  1. Q
  1. ;
  1. EOJ ;
  1. S BCHET=$H
  1. Q
  1. D ; Run by date of service
  1. S X1=BCHBD,X2=-1 D C^%DTC S BCHSD=X
  1. S BCHODAT=BCHSD_".9999" F S BCHODAT=$O(^BCHR("B",BCHODAT)) Q:BCHODAT=""!((BCHODAT\1)>BCHED) D D1
  1. Q
  1. ;
  1. D1 ;
  1. S (BCHR,BCHRCNT)=0 F S BCHR=$O(^BCHR("B",BCHODAT,BCHR)) Q:BCHR'=+BCHR I $D(^BCHR(BCHR,0)),$P(^(0),U,2)]"",$P(^(0),U,3)]"" S BCHR0=^(0) D PROCESS
  1. Q
  1. PROCESS ;
  1. S BCHPAT=$P(BCHR0,U,4)
  1. S BCHNRPAT=$P($G(^BCHR(BCHR,11)),U,12)
  1. ;I 'BCHPAT,'BCHNRPAT Q ;no patient
  1. I BCHREG="R",BCHPAT="" Q
  1. I BCHREG="N",BCHNRPAT="" Q
  1. I BCHPAT,BCHNRPAT S BCHNRPAT=""
  1. I BCHPAT Q:'$D(^DPT(BCHPAT,0))
  1. S BCHPROG=$P(BCHR0,U,2)
  1. I BCHPRG,BCHPRG'=BCHPROG Q
  1. S C=$P(BCHR0,U,3),BCHNAME=$P(^VA(200,C,0),U)
  1. I '$D(^XTMP("BCHRC9",BCHJOB,BCHBT,"PROV",BCHNAME)) S ^XTMP("BCHRC9",BCHJOB,BCHBT,"PROV",BCHNAME)=0
  1. S (X,C)=0 F S X=$O(^BCHRPROB("AD",BCHR,X)) Q:X'=+X S C=C+1 D
  1. .Q:$P(^BCHRPROB(X,0),U,4)="" ;no service entered
  1. .S $P(^XTMP("BCHRC9",BCHJOB,BCHBT,"PROV",BCHNAME),U)=$P(^XTMP("BCHRC9",BCHJOB,BCHBT,"PROV",BCHNAME),U)+1,$P(^XTMP("BCHRC9",BCHJOB,BCHBT,"TOTAL"),U)=$P(^XTMP("BCHRC9",BCHJOB,BCHBT,"TOTAL"),U)+1
  1. .S S=$P(^BCHRPROB(X,0),U,4),Y=$P(^BCHTSERV(S,0),U,3)
  1. .I Y="LT"!(Y="AM")!(Y="OT") D
  1. ..S $P(^XTMP("BCHRC9",BCHJOB,BCHBT,"PROV",BCHNAME),U,5)=$P(^XTMP("BCHRC9",BCHJOB,BCHBT,"PROV",BCHNAME),U,5)+$P(^BCHRPROB(X,0),U,5),$P(^XTMP("BCHRC9",BCHJOB,BCHBT,"TOTAL"),U,5)=$P(^XTMP("BCHRC9",BCHJOB,BCHBT,"TOTAL"),U,5)+$P(^BCHRPROB(X,0),U,5)
  1. ..;IHS/CMI/LAB - modified line below patch 6
  1. ..I C=1 S $P(^XTMP("BCHRC9",BCHJOB,BCHBT,"PROV",BCHNAME),U,5)=$P(^XTMP("BCHRC9",BCHJOB,BCHBT,"PROV",BCHNAME),U,5)+$P(BCHR0,U,11),$P(^XTMP("BCHRC9",BCHJOB,BCHBT,"TOTAL"),U,5)=$P(^XTMP("BCHRC9",BCHJOB,BCHBT,"TOTAL"),U,5)+$P(BCHR0,U,11)
  1. .E D
  1. ..S $P(^XTMP("BCHRC9",BCHJOB,BCHBT,"PROV",BCHNAME),U,4)=$P(^XTMP("BCHRC9",BCHJOB,BCHBT,"PROV",BCHNAME),U,4)+$P(^BCHRPROB(X,0),U,5),$P(^XTMP("BCHRC9",BCHJOB,BCHBT,"TOTAL"),U,4)=$P(^XTMP("BCHRC9",BCHJOB,BCHBT,"TOTAL"),U,4)+$P(^BCHRPROB(X,0),U,5)
  1. ..;IHS/CMI/LAB - patch 6 modified line below
  1. ..I C=1 S $P(^XTMP("BCHRC9",BCHJOB,BCHBT,"PROV",BCHNAME),U,4)=$P(^XTMP("BCHRC9",BCHJOB,BCHBT,"PROV",BCHNAME),U,4)+$P(BCHR0,U,11),$P(^XTMP("BCHRC9",BCHJOB,BCHBT,"TOTAL"),U,4)=$P(^XTMP("BCHRC9",BCHJOB,BCHBT,"TOTAL"),U,4)+$P(BCHR0,U,11)
  1. .Q
  1. S $P(^XTMP("BCHRC9",BCHJOB,BCHBT,"PROV",BCHNAME),U,2)=$P(^XTMP("BCHRC9",BCHJOB,BCHBT,"PROV",BCHNAME),U,2)+$P(BCHR0,U,12)
  1. S $P(^XTMP("BCHRC9",BCHJOB,BCHBT,"TOTAL"),U,2)=$P(^XTMP("BCHRC9",BCHJOB,BCHBT,"TOTAL"),U,2)+$P(BCHR0,U,12)
  1. S N=$P(BCHR0,U,27)+$P(BCHR0,U,11)
  1. S $P(^XTMP("BCHRC9",BCHJOB,BCHBT,"PROV",BCHNAME),U,3)=$P(^XTMP("BCHRC9",BCHJOB,BCHBT,"PROV",BCHNAME),U,3)+N,$P(^XTMP("BCHRC9",BCHJOB,BCHBT,"TOTAL"),U,3)=$P(^XTMP("BCHRC9",BCHJOB,BCHBT,"TOTAL"),U,3)+N
  1. Q