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

BCHRC6.m

Go to the documentation of this file.
  1. BCHRC6 ; IHS/CMI/LAB - CHR Report 2 ;
  1. ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
  1. ;IHS/CMI/LAB - tmp to xtmp
  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 ;
  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="^BCHRC6P",XBRC="PROC^BCHRC6",XBRX="XIT^BCHRC6",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. F X=1:1:10 S V="V"_X K @V
  1. K V,BCHSD,BCHBD,BCHBDD,BCHED,BCHEDD,BCHODAT,BCHR,BCHR0,X,P,S,N,BCHQUIT,BCHBTH,BCHDT,BCHNAME,BCHPRG,BCHX
  1. K X,Y
  1. Q
  1. ;
  1. INFORM ;
  1. W:$D(IOF) @IOF
  1. W !?20,"********** CHR REPORT NO. 6 **********"
  1. W !!?33,"PROVIDER DATA",!!,"You must enter the time frame and the program for which the report",!,"will be run.",!!
  1. ;W "THIS REPORT REQUIRES A PRINTER THAT IS CAPABLE OF PRINTING 132 COLUMN OUTPUT.",!,"SEE YOUR SITE MANAGER IF YOU NEED ASSISTANCE FINDING SUCH A PRINTER.",!!
  1. Q
  1. ;
  1. ;
  1. PROC ;EP - PROCESS REFERRAL REPORT
  1. D XTMP^BCHUTIL("BCHRC6","CHR CHR REPORT")
  1. S (BCHBT,BCHBTH)=$H,BCHJOB=$J
  1. S ^XTMP("BCHRC6",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("BCHRC6",BCHJOB,BCHBT,"PROVIDER",BCHNAME)) S ^XTMP("BCHRC6",BCHJOB,BCHBT,"PROVIDER",BCHNAME)=0
  1. S X=0 F S X=$O(^BCHRPROB("AD",BCHR,X)) Q:X'=+X D
  1. .S S=$P(^BCHRPROB(X,0),U,4) Q:S=""
  1. .I $P(^BCHTSERV(S,0),U,3)="LT" D
  1. ..S $P(^XTMP("BCHRC6",BCHJOB,BCHBT,"PROVIDER",BCHNAME),U,3)=$P(^XTMP("BCHRC6",BCHJOB,BCHBT,"PROVIDER",BCHNAME),U,3)+$P(^BCHRPROB(X,0),U,5)
  1. ..S $P(^XTMP("BCHRC6",BCHJOB,BCHBT,"TOTAL"),U,3)=$P(^XTMP("BCHRC6",BCHJOB,BCHBT,"TOTAL"),U,3)+$P(^BCHRPROB(X,0),U,5)
  1. .E S $P(^XTMP("BCHRC6",BCHJOB,BCHBT,"PROVIDER",BCHNAME),U)=$P(^XTMP("BCHRC6",BCHJOB,BCHBT,"PROVIDER",BCHNAME),U)+$P(^BCHRPROB(X,0),U,5) D
  1. ..S $P(^XTMP("BCHRC6",BCHJOB,BCHBT,"TOTAL"),U)=$P(^XTMP("BCHRC6",BCHJOB,BCHBT,"TOTAL"),U)+$P(^BCHRPROB(X,0),U,5)
  1. .S $P(^XTMP("BCHRC6",BCHJOB,BCHBT,"PROVIDER",BCHNAME),U,4)=$P(^XTMP("BCHRC6",BCHJOB,BCHBT,"PROVIDER",BCHNAME),U,4)+$P(^BCHRPROB(X,0),U,5)
  1. .S $P(^XTMP("BCHRC6",BCHJOB,BCHBT,"TOTAL"),U,4)=$P(^XTMP("BCHRC6",BCHJOB,BCHBT,"TOTAL"),U,4)+$P(^BCHRPROB(X,0),U,5)
  1. .Q
  1. S $P(^XTMP("BCHRC6",BCHJOB,BCHBT,"PROVIDER",BCHNAME),U,2)=$P(^XTMP("BCHRC6",BCHJOB,BCHBT,"PROVIDER",BCHNAME),U,2)+$P(BCHR0,U,11)
  1. S $P(^XTMP("BCHRC6",BCHJOB,BCHBT,"PROVIDER",BCHNAME),U,4)=$P(^XTMP("BCHRC6",BCHJOB,BCHBT,"PROVIDER",BCHNAME),U,4)+$P(BCHR0,U,11)
  1. S $P(^XTMP("BCHRC6",BCHJOB,BCHBT,"TOTAL"),U,4)=$P(^XTMP("BCHRC6",BCHJOB,BCHBT,"TOTAL"),U,4)+$P(BCHR0,U,11)
  1. S $P(^XTMP("BCHRC6",BCHJOB,BCHBT,"TOTAL"),U,2)=$P(^XTMP("BCHRC6",BCHJOB,BCHBT,"TOTAL"),U,2)+$P(BCHR0,U,11)
  1. S N=$P(BCHR0,U,12),P=$S('N:5,N=1:6,1:7)
  1. S $P(^XTMP("BCHRC6",BCHJOB,BCHBT,"PROVIDER",BCHNAME),U,P)=$P(^XTMP("BCHRC6",BCHJOB,BCHBT,"PROVIDER",BCHNAME),U,P)+1,$P(^XTMP("BCHRC6",BCHJOB,BCHBT,"TOTAL"),U,P)=$P(^XTMP("BCHRC6",BCHJOB,BCHBT,"TOTAL"),U,P)+1
  1. I N>1 S $P(^XTMP("BCHRC6",BCHJOB,BCHBT,"PROVIDER",BCHNAME),U,10)=$P(^XTMP("BCHRC6",BCHJOB,BCHBT,"PROVIDER",BCHNAME),U,10)+N,$P(^XTMP("BCHRC6",BCHJOB,BCHBT,"TOTAL"),U,10)=$P(^XTMP("BCHRC6",BCHJOB,BCHBT,"TOTAL"),U,10)+N
  1. S $P(^XTMP("BCHRC6",BCHJOB,BCHBT,"PROVIDER",BCHNAME),U,9)=$P(^XTMP("BCHRC6",BCHJOB,BCHBT,"PROVIDER",BCHNAME),U,9)+N,$P(^XTMP("BCHRC6",BCHJOB,BCHBT,"TOTAL"),U,9)=$P(^XTMP("BCHRC6",BCHJOB,BCHBT,"TOTAL"),U,9)+N
  1. Q