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