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

BCHABCH.m

Go to the documentation of this file. 
  1. BCHABCH ; IHS/CMI/LAB - CHR TO PCC LINK ROUTINE 27 Apr 2006 11:53 AM ; 
  1.  ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
  1.  ;
  1.  ;IHS/TUCSON/LAB - PATCH 3 6/26/97 - DON'T PASS VISITS WITH NO SERVICE TIME
  1.  ;chr to pcc link
  1.  ;chr system will pass array BCHEV
  1.  ;BCHEV("TYPE")=A,E OR D
  1.  ;Called from BCHALD routine to check BCHEV array and then
  1.  ;create, edit or delete a PCC Visit as appropriate.
  1.  ;
  1. EP ;EP - call from BCHALD DRIVER
  1.  W:'$D(ZTQUEUED) !!,"Updating PCC .. hold on.." H 2 ;IHS/CMI/TMJ PATCH #16
  1.  K BCHQUIT,APCDALVR
  1.  I '$D(BCHEV) Q  ;no array defined
  1.  I "AED"'[$G(BCHEV("TYPE")) Q  ;no appropriate type
  1.  D @BCHEV("TYPE")
  1.  D EOJ
  1.  Q
  1.  ;
  1. CHECK ;EP
  1.  I '$D(BCHEV("DATA0")) S BCHQUIT=20 Q  ;no data array
  1.  I '$P(BCHEV("DATA0"),U,4) S BCHQUIT=21 Q  ;no patient
  1.  I '$P(BCHEV("DATA0"),U,27) S BCHQUIT=1 Q  ;ihs/tucson/lab - added this line, patch 3 if no service time don't pass visit
  1.  S (BCHX,BCHGOT)=0 F  S BCHX=$O(BCHEV("POV",BCHX)) Q:BCHX'=+BCHX   D
  1.  .S X=$G(BCHEV("POV",BCHX,"SRV")) Q:'$P(X,U,4)  ;don't pass non-pcc services
  1.  .S BCHGOT=1
  1.  .Q
  1.  S:'BCHGOT BCHQUIT=1
  1.  ;make sure there is at least one codeable problem - patch 11
  1.  S (BCHX,BCHGOT)=0 F  S BCHX=$O(BCHEV("POV",BCHX)) Q:BCHX'=+BCHX   D
  1.  .S X=$G(BCHEV("POV",BCHX,"ICD9")) Q:X=""  ;don't pass non-pcc services
  1.  .S BCHGOT=1
  1.  .Q
  1.  S:'BCHGOT BCHQUIT=1
  1.  Q
  1. A ;EP - added a record
  1.  K APCDALVR,BCHQUIT
  1.  D CHECK
  1.  I $G(BCHQUIT) D EOJ Q  ;quit if not a visit pcc wants
  1.  I $L($T(^BSDAPI4)),$L($T(^APCDAPI4)) D  D EOJ Q
  1.  .D BSD
  1.  .I '$G(BCHVSIT) S BCHQUIT=2 D VSERROR Q
  1.  .D VFILES^BCHABC1
  1.  .S BCHV("9000010")=BCHVSIT
  1.  .D COMPLETE^BCHALD
  1.  .Q
  1.  D VISIT ;set up and create visit
  1.  I $G(BCHQUIT) D EOJ Q
  1.  D ^APCDALV ;create visit
  1.  I $D(APCDALVR("APCDAFLG")) S BCHQUIT=APCDALVR("APCDAFLG") D VSERROR Q
  1.  S BCHVSIT=APCDALVR("APCDVSIT")
  1.  D VFILES^BCHABC1
  1.  ;call protocol signifying a complete visit added to pcc files
  1.  S BCHV("9000010")=BCHVSIT
  1.  D COMPLETE^BCHALD
  1.  D EOJ
  1.  Q
  1. E ;edited a chr record
  1.  D E^BCHABC2
  1.  Q
  1. D ;
  1.  D D^BCHABC2
  1.  Q
  1. VISIT ;EP
  1.  S APCDALVR("APCDAUTO")="" S:BCHEV("TYPE")="A" APCDALVR("APCDADD")=""
  1.  S APCDALVR("APCDPAT")=$P(BCHEV("DATA0"),U,4)
  1.  S (APCDALVR("APCDDATE"),BCHDATK)=$P(BCHEV("DATA0"),U) ;date of visit .01
  1.  D GETLOC
  1.  I $G(BCHQUIT) D VSERROR Q
  1.  D GETTYPE ; get type of visit
  1.  I $G(BCHQUIT) D VSERROR Q
  1. SERVCAT ;get service category - if radio/telephone act loc use T
  1.  ;otherwise use A
  1.  ;I can't distinguish hospital from clinic
  1.  S APCDALVR("APCDCAT")=$S(BCHACTL="RT":"T",1:"A")
  1. CLINIC ;get clinic - if act. loc is home use 11 otherwise 01
  1.  S APCDALVR("APCDCLN")=$S(BCHACTL="HM":$O(^DIC(40.7,"C",11,"")),BCHACTL="SC":$O(^DIC(40.7,"C",22,0)),1:$O(^DIC(40.7,"C","25","")))
  1.  S APCDALVR("APCDAPPT")="U"
  1.  S APCDALVR("APCDCAF")="R"
  1.  Q
  1.  ;
  1. GETLOC ;get location of encounter
  1.  I '$D(BCHEV("ACTLOC")) S BCHQUIT=21 Q  ;can't tell activity location
  1.  S BCHACTL=$P(BCHEV("ACTLOC"),U,5)
  1.  S BCHLOC=$P(BCHEV("DATA0"),U,5)
  1.  I BCHLOC S APCDALVR("APCDLOC")=BCHLOC Q  ;quit if have a hosp/clinic pointer
  1.  I BCHACTL="HC" S BCHQUIT=24 Q
  1.  ;home visit
  1.  I BCHACTL="HM" S BCHLOC=$P(BCHEV("SITE"),U,5) I BCHLOC="" S BCHQUIT=22 Q
  1.  I BCHACTL="CH" S BCHLOC=$P(BCHEV("SITE"),U,6) I BCHLOC="" S BCHQUIT=27 Q
  1.  I BCHACTL="SC" S BCHLOC=$P(BCHEV("SITE"),U,16) I BCHLOC="" S BCHQUIT=28 Q
  1.  I 'BCHLOC S BCHLOC=$P(BCHEV("SITE"),U,9) I BCHLOC="" S BCHQUIT=23 Q
  1.  S APCDALVR("APCDLOC")=BCHLOC
  1.  Q
  1. GETTYPE ;get type of visit
  1.  S BCHLOC=$P(^AUTTLOC(APCDALVR("APCDLOC"),0),U,10) ;I $E(BCHLOC,5,6)>49 S APCDALVR("APCDTYPE")="T" Q  ;if not a clinic, set to tribal and quit
  1.  S X=$P(BCHEV("DATA0"),U,6)
  1.  I X="" S APCDALVR("APCDTYPE")=$S($P(BCHEV("SITE"),U,2)]"":$P(BCHEV("SITE"),U,2),1:"T") Q
  1.  I $P($G(^BCHTACTL(X,0)),U,2)=4 S APCDALVR("APCDTYPE")=$S($P(BCHEV("SITE"),U,4)]"":$P(BCHEV("SITE"),U,4),$P(BCHEV("SITE"),U,2)]"":$P(BCHEV("SITE"),U,2),1:"T") Q
  1.  S APCDALVR("APCDTYPE")=$P(BCHEV("SITE"),U,2) Q:APCDALVR("APCDTYPE")]""
  1.  S APCDALVR("APCDTYPE")="T"  ;if site parameters not set use T
  1.  Q
  1.  S APCDALVR("APCDTYPE")=$P(BCHEV("SITE"),U,4) Q:APCDALVR("APCDTYPE")'=""
  1.  S X=$P(^AUTTLOC(APCDALVR("APCDLOC"),0),U,25) I X]"" S APCDALVR("APCDTYPE")=$S(X=1:"I",X=2:"6",X=3:"C",X=6:"T",1:"O") Q  ;if loc updated use it
  1.  S X=$P($G(^APCCCTRL(DUZ(2),0)),U,4) I X]"" S APCDALVR("APCDTYPE")=X Q  ;use pcc master control if all else fails
  1.  S APCDALVR("APCDTYPE")="T" ;default to T if can't determine
  1.  Q
  1.  ;
  1. BSD ;
  1.  ;use BSDAPI4 and always force an add
  1.  K APCDALVR
  1.  S BCHVSIT=""
  1.  S BCHIN("FORCE ADD")=1
  1.  D VISIT
  1.  I $G(BCHQUIT) Q
  1.  S BCHIN("VISIT DATE")=APCDALVR("APCDDATE")
  1.  S BCHIN("VISIT TYPE")=APCDALVR("APCDTYPE")
  1.  S BCHIN("PAT")=APCDALVR("APCDPAT")
  1.  S BCHIN("SITE")=APCDALVR("APCDLOC")
  1.  S BCHIN("SRV CAT")=APCDALVR("APCDCAT")
  1.  S BCHIN("CLINIC CODE")=APCDALVR("APCDCLN")
  1.  S BCHIN("APCDAPPT")="U"
  1.  S BCHIN("APCDOPT")=$P($G(XQY0,U),U) I BCHIN("APCDOPT")]"" S BCHIN("APCDOPT")=$O(^DIC(19,"B",BCHIN("APCDOPT"),0))
  1.  S BCHIN("APCDCAF")="R"
  1.  S BCHIN("USR")=DUZ
  1.  S BCHIN("TIME RANGE")=-1
  1. BSDADD1 ;
  1.  K APCDALVR
  1.  S BCHVSIT=""
  1.  D GETVISIT^APCDAPI4(.BCHIN,.BCHV)
  1.  S BCHERR=$P(BCHV(0),U,2)
  1.  K BCHIN,APCDALVR
  1.  I BCHERR]"" S BCHQUIT=2 Q  ;errored
  1.  I $P(BCHV(0),U)=1 S V=$O(BCHV(0)) I BCHV(V)="ADD" S BCHVSIT=V Q
  1.  Q
  1. EOJ ;
  1.  K BCHLINK,BCHFILE,BCHERR,BCHQUIT,APCDALVR,BCHTYPE,BCHLOC,BCHDATK,BCHACTL,BCHIEN,BCHX,BCHGOT,BCHVSIT
  1.  K BCHEV
  1.  Q
  1. VSERROR ;EP
  1.  S BCHFILE="VISIT"
  1.  S BCHIEN=BCHEV("CHR IEN")
  1.  S BCHERR="VE"_BCHQUIT,BCHERR=$P($T(@BCHERR),";;",2)
  1.  S DFN=$P(BCHEV("DATA0"),U,4)
  1.  D LBULL^BCHALD
  1.  K DFN
  1.  Q
  1.  ;
  1. VE2 ;;inability to create visit
  1. VE3 ;;invalid visit parameters (date, location etc.)
  1. VE21 ;;No activity location passed. No Location determined.
  1. VE22 ;;No IHS Location for HOME in CHR SITE PARAMETER File.
  1. VE23 ;;No IHS Location for OTHER in CHR SITE PARAMETER File.
  1. VE24 ;;No Location of Encounter when Activity location is Hospital/Clinic.
  1. VE27 ;;No Location of Encounter for OFFICE in CHR SITE PARAMETER file.
  1. VE28 ;;No Location of Encounter for SCHOOL in CHR SITE PARAMETER file.
  1. VE29 ;;Error attempting to modify visit