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

BCHRL.m

Go to the documentation of this file.
  1. BCHRL ; IHS/CMI/LAB - CHR GENERAL RETRIEVAL DRIVER ;
  1. ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
  1. START ;
  1. I '$D(IOF) D HOME^%ZIS
  1. I '$G(DUZ(2)) W $C(7),$C(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER!!",!! Q
  1. I '$G(DUZ) W $C(7),$C(7),!!,"USER NOT SET IN DUZ - NOTIFY SITE MANAGER!!",!! Q
  1. K BCHQUIT
  1. TYPE ;--- get type of report (patient, date range or search template)
  1. D INFORM^BCHRL01
  1. K DIR,X,Y S DIR(0)="S^S:Search Template"_$S(BCHPTVS="V":";D:Date Range",1:";P:Patient File"),DIR("A")="Select and Print "_$S(BCHPTVS="P":"Patient ",1:"Encounter ")_"List from" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1. G:$D(DIRUT) XIT
  1. S BCHTYPE=Y
  1. D @BCHTYPE
  1. D XIT
  1. Q
  1. P ;patient lister
  1. D ADD I $D(BCHQUIT) D DEL K BCHQUIT G TYPE
  1. I '$D(BCHCAND) D P1 Q
  1. I $D(BCHCAND),$P(^BCHTRPT(BCHRPT,0),U,11) D I $D(DIRUT)!'($D(BCHBDD))!('$D(BCHEDD)) Q
  1. .S BCHRDTR=""
  1. .W !!,"You have selected at least one item that requires a date range selection."
  1. .D GETDATES
  1. D TITLE I $D(BCHQUIT) K BCHQUIT G TYPE
  1. D ZIS
  1. Q
  1. P1 ;if patient, no prev defined report used
  1. P11 K ^BCHTRPT(BCHRPT,11),BCHRDTR D SCREEN I $D(BCHQUIT) K BCHQUIT D DEL G TYPE
  1. I $D(BCHRDTR) D
  1. .W !!,"You have selected at least one item that requires a date range selection."
  1. .D GETDATES
  1. P12 K ^BCHTRPT(BCHRPT,12) S BCHTCW=0 D COUNT I $D(BCHQUIT) K BCHQUIT G P11
  1. P13 D TITLE I $D(BCHQUIT) K BCHQUIT G P12
  1. D SAVE
  1. D ZIS
  1. Q
  1. S ;--- search template
  1. D S0
  1. Q:$D(BCHQUIT)
  1. S1 ;EP
  1. D ADD I $D(BCHQUIT) G S
  1. S12 K ^BCHTRPT(BCHRPT,12) S BCHTCW=0 D COUNT I $D(BCHQUIT) K BCHQUIT G S
  1. S13 D TITLE I $D(BCHQUIT) K BCHQUIT G S12
  1. D ZIS
  1. Q
  1. S0 ;
  1. S:BCHPTVS="V" DIC("S")="I $P(^(0),U,4)=9000010" S:BCHPTVS="P" DIC("S")="I $P(^(0),U,4)=2!($P(^(0),U,4)=9000001)" S DIC="^DIBT(",DIC("A")="Enter SEARCH TEMPLATE name: ",DIC(0)="AEMQ" D ^DIC K DIC,DA,DR,DICR
  1. I Y=-1 S BCHQUIT="" Q
  1. S BCHSEAT=+Y
  1. ;
  1. Q
  1. D ;
  1. GETDATES ;
  1. BD ;get beginning date
  1. W ! K DIR,X,Y S DIR(0)="D^:DT:EP",DIR("A")="Enter Beginning Date of Service for search" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1. I $D(DIRUT) D DEL G TYPE
  1. S BCHBD=Y
  1. ED ;get ending date
  1. W ! K DIR,X,Y S DIR(0)="D^"_BCHBD_":DT:EP",DIR("A")="Enter Ending Date of Service for search" 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 BCHD=X S Y=BCHBD D DD^%DT S BCHBDD=Y S Y=BCHED D DD^%DT S BCHEDD=Y
  1. Q:$D(BCHRDTR)
  1. D ADD I $D(BCHQUIT) D DEL K BCHQUIT G D
  1. I '$D(BCHCAND) D D1 Q
  1. D TITLE I $D(BCHQUIT) K BCHQUIT G TYPE
  1. D ZIS
  1. Q
  1. D1 ;if visit, no prev defined report used
  1. D11 K ^BCHTRPT(BCHRPT,11),BCHRDTR D SCREEN I $D(BCHQUIT) K BCHQUIT D DEL G D
  1. D12 K ^BCHTRPT(BCHRPT,12) S BCHTCW=0 D COUNT I $D(BCHQUIT) K BCHQUIT G D11
  1. D13 D TITLE I $D(BCHQUIT) K BCHQUIT G D12
  1. D SAVE
  1. D ZIS
  1. Q
  1. SCREEN ;
  1. D SCREEN^BCHRL3
  1. Q
  1. COUNT ;count only or detailed report
  1. D COUNT^BCHRL3
  1. Q
  1. TITLE ;
  1. Q:BCHCTYP="T"
  1. K DIR,X,Y S DIR(0)="Y",DIR("A")="Would you like a custom title for this report",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1. I $D(DIRUT) S BCHQUIT=1 Q
  1. Q:Y=0
  1. S BCHLENG=$S(BCHTCW:BCHTCW-8,1:60)
  1. I Y=1 K DIR,X,Y S DIR(0)="F^3:"_BCHLENG,DIR("A")="Enter custom title",DIR("?")=" Enter from 3 to "_BCHLENG_" characters" D ^DIR K DIR
  1. G:$D(DIRUT) TITLE
  1. S BCHTITL=Y
  1. Q
  1. SAVE ;
  1. Q:$D(BCHCAND)
  1. Q:BCHCTYP'="D" ;--- must be a detailed report to be saved
  1. S BCHSAVE=""
  1. K DIR,X,Y S DIR(0)="Y",DIR("A")="Do you wish to SAVE this "_$S('$D(BCHEP1):"SEARCH/",1:"")_"PRINT/SORT logic for future use",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1. Q:$D(DIRUT)
  1. Q:'Y
  1. K DIR,X,Y S DIR(0)="9001003.8,.03",DIR("A")="Enter NAME for this REPORT DEFINITION" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1. G:$D(DIRUT) SAVE
  1. S BCHNAME=Y
  1. S DIE="^BCHTRPT(",DA=BCHRPT,DR=".02////1;.03///"_BCHNAME_";.06///"_BCHPTVS_";.05///"_BCHCTYP_";.11///"_$G(BCHRDTR) S:$D(BCHEP1) DR=DR_";.09///"_BCHPACK D CALLDIE^BCHUTIL
  1. Q
  1. ZIS ;call to XBDBQUE
  1. I 'BCHTCW S BCHTCW=IOM
  1. S BCHDONE=""
  1. D SHOW^BCHRLS,SHOWP^BCHRLS,SHOWR^BCHRLS
  1. D XIT1
  1. S XBRP="^BCHRLP",XBRC="^BCHRL1",XBRX="XIT^BCHRL",XBNS="BCH"
  1. D ^XBDBQUE
  1. D XIT
  1. Q
  1. DEL ;EP DELETE LOG ENTRY IF ONE EXISTS AND USER "^" OUT
  1. I $G(BCHRPT),$D(^BCHTRPT(BCHRPT,0)),'$P(^BCHTRPT(BCHRPT,0),U,2) S DIK="^BCHTRPT(",DA=BCHRPT D ^DIK K DIK,DA,DIC
  1. Q
  1. ADD ;
  1. D ADD^BCHRL01
  1. Q
  1. XIT ;
  1. D XIT^BCHRL1
  1. XIT1 ;
  1. D XIT1^BCHRL1
  1. Q