AMHGPCC ; IHS/CMI/MAW - AMHG PCC Visit Links 3/5/2009 8:10:19 AM ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
;
;
;
DEBUG(RETVAL,AMHSTR) ;-- debug entry point
D DEBUG^%Serenji("PCC^AMHGPCC(.RETVAL,.AMHSTR)")
Q
;
PCC(RETVAL,AMHSTR) ;-- create/edit PCC visit from MHSS RECORD ENTRY
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,P,R,AMHIEN,AMHVS,AMHGRET,AMHREC,AMHER
S P="|",R="~"
S RETVAL="^AMHTMP("_$J_")"
S AMHI=0
K ^AMHTMP($J)
S AMHIEN=$P(AMHSTR,P)
S AMHVS=$P(AMHSTR,P,2)
I '$G(AMHVS) S AMHVS=$P($G(^AMHREC(AMHIEN,0)),U,16)
D EN^AMHBHRU(.AMHGRET,AMHIEN,AMHVS)
I $E($G(AMHGRET),1,2)="-1" D
. S AMHER="0~"_$P(AMHGRET,$C(30),2)
I $G(AMHGRET)=1 D
. S AMHREC=$$GET1^DIQ(9002011,AMHIEN,.16,"I")
S @RETVAL@(AMHI)="T00030Result"_$C(30)
S AMHI=AMHI+1
S @RETVAL@(AMHI)=$S($G(AMHER)]"":AMHER,1:$G(AMHREC))_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
LIST(RETVAL,AMHSTR) ;-- get a list of visits for the user to choose from
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,P,R,AMHIEN,AMHSEL
S P="|",R="~"
S RETVAL="^AMHTMP("_$J_")"
S AMHI=0
K ^AMHTMP($J)
S AMHIEN=$P(AMHSTR,P)
D BSDAPI(.AMHSEL,AMHIEN)
S @RETVAL@(AMHI)="T00010BMXIEN^T00030Date^T00005Time^T00030Location^T00030Provider^T00030Clinic^T00030ServiceCategory^T00080POV"_$C(30)
N AMHDA
S AMHDA=0 F S AMHDA=$O(AMHSEL(AMHDA)) Q:'AMHDA D
. N AMHDATA,AMHDT,AMHTM,AMHLOC,AMHPRV,AMHCLN,AMHSC,AMHPOVC,AMHPOVN,AMHPOV
. S AMHDT=$$LVDT^AMHGU($P($P(^AUPNVSIT(AMHDA,0),U),"."))
. S AMHTM=$P($P(^AUPNVSIT(AMHDA,0),U),".",2)
. S AMHTM=$S($L(AMHTM)=1:AMHTM_"000",$L(AMHTM)=2:AMHTM_"00",$L(AMHTM)=3:AMHTM_"0",1:AMHTM)
. S AMHLOC=$$GET1^DIQ(9000010,AMHDA,.06)
. S AMHPRV=$$PRIMPROV^APCLV(AMHDA,"N")
. S AMHPOVC=$$PRIMPOV^APCLV(AMHDA,"C")
. S AMHPOVN=$$PRIMPOV^APCLV(AMHDA,"N")
. S AMHPOV=$S(AMHPOVN]"":AMHPOVC_"-"_AMHPOVN,1:"")
. S AMHCLN=$$GET1^DIQ(9000010,AMHDA,.08)
. S AMHSC=$$GET1^DIQ(9000010,AMHDA,.07)
. S AMHI=AMHI+1
. S @RETVAL@(AMHI)=AMHDA_U_AMHDT_U_AMHTM_U_AMHLOC_U_AMHPRV_U_AMHCLN_U_AMHSC_U_AMHPOV_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
K AMHIN
Q
;
BSDAPI(AMHV,AMHR) ;-- get list of visits and return amhv
K AMHIN ;clean out array
D KILL
S AMHR0=$G(^AMHREC(AMHR,0))
S AMHIN("VISIT DATE")=$P(AMHR0,U)
D GETTYPE
S AMHIN("VISIT TYPE")=APCDALVR("APCDTYPE")
S AMHIN("PAT")=$P(AMHR0,U,8)
S AMHIN("SITE")=$P(AMHR0,U,4)
;determine service category based on type of contact
S AMHIN("SRV CAT")=$P(^AMHTSET($P(AMHR0,U,7),0),U,3)
;D GETCLN
;I APCDALVR("APCDCLN")]"" S AMHIN("CLINIC CODE")=APCDALVR("APCDCLN")
S AMHIN("APCDAPPT")=$P(AMHR0,U,11)
S AMHIN("APCDOLOC")=$P(AMHR0,U,26)
S AMHIN("APCDEVM")=$P(AMHR0,U,29)
S AMHIN("APCDOPT")=$P($G(XQY0),U) I AMHIN("APCDOPT")]"" S AMHIN("APCDOPT")=$O(^DIC(19,"B",AMHIN("APCDOPT"),0))
S AMHIN("APCDCAF")=$S($P($G(^AMHSITE(DUZ(2),18)),U,8):"I",1:"R")
S AMHIN("NEVER ADD")=1 ;never add a visit just find matches
S AMHIN("TIME RANGE")=-1
S AMHIN("USR")=DUZ
K APCDALVR
K AMHV
D GETVISIT^BSDAPI4(.AMHIN,.AMHV)
S AMHERRR=$P(AMHV(0),U,2)
I AMHERRR]"" Q ;errored
I $P(AMHV(0),U)=1 S V=$O(AMHV(0)) I AMHV(V)="ADD" S AMHVSIT=V Q
;since more than one passed back display them to the user and quit
Q
;
GETTYPE ;get type of visit - use loc current type or affiliation of provider
S APCDALVR("APCDTYPE")=$S($P($G(^AMHSITE(DUZ(2),0)),U,2)]"":$P(^(0),U,2),1:"") Q:APCDALVR("APCDTYPE")]""
;S X=$P(^AUTTLOC($P(AMHR0,U,4),0),U,25) I X]"" S APCDALVR("APCDTYPE")=$S(X=1:"I",X=2:"6",X=3:"C",X=4:"U",X=5:"S",X=6:"T",1:"O") Q
S X=$P($G(^APCCCTRL($P(AMHR0,U,4),0)),U,4) I X]"" S APCDALVR("APCDTYPE")=X Q ;use pcc master control for site of loc of enc ihs/tucson/lab 11/30/95 patch 1
S X=$$PPAFFL^AMHUTIL(AMHR,"I") I X S APCDALVR("APCDTYPE")=$S(X=1:"I",X=2:"C",X=3:"T",X=8:"6",1:"") I APCDALVR("APCDTYPE")]"" Q
S X=$P($G(^APCCCTRL(DUZ(2),0)),U,4) I X]"" S APCDALVR("APCDTYPE")=X Q ;use pcc master control
S APCDALVR("APCDTYPE")="I" ;default to I if can't determine
Q
;
GETCLN ;determine clinic to pass
S APCDALVR("APCDCLN")=""
NEW X
S X=$P(AMHR0,U,7)
I X="" G GETCLN1
I $P($G(^AMHTSET(X,0)),U,2)=9 S APCDALVR("APCDCLN")=$O(^DIC(40.7,"C",30,"")) Q:APCDALVR("APCDCLN")]""
I $P($G(^AMHTSET(X,0)),U,2)=5 S APCDALVR("APCDCLN")=$O(^DIC(40.7,"C",11,"")) Q:APCDALVR("APCDCLN")]""
GETCLN1 ;
S APCDALVR("APCDCLN")=$P(AMHR0,U,25)
Q:APCDALVR("APCDCLN")]""
S APCDALVR("APCDCLN")=$S($P(AMHR0,U,2)="M":$O(^DIC(40.7,"C",14,"")),$P(AMHR0,U,2)="S":$O(^DIC(40.7,"C",48,"")),$P(AMHR0,U,2)="C":$O(^DIC(40.7,"C",43,0)),1:$O(^DIC(40.7,"C",C4,"")))
I APCDALVR("APCDCLN")="" S APCDALVR("APCDCLN")=$O(^DIC(40.7,"C",25,""))
Q
KILL ;
K APCDALVR,APCDPAT,APCDLOC,APCDTYPE,APCDCAT,APCDCLN,APCDTPRO,APCDTPS,APCDTPOV,APCDTNQ,APCDTTOP,APCDTLOU,APCDTPRV,APCDTAT,APCDATMP,APCDAFLG,APCDAUTO,APCDANE,AUPNTALK,APCDAPPT,APCDOLOC
Q
;
ACT(RETVAL,AMHSTR) ;-- check to see if the activity code can be passed to PCC
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,P,R,AMHIEN
S P="|",R="~"
S RETVAL="^AMHTMP("_$J_")"
S AMHI=0
K ^AMHTMP($J)
S AMHIEN=$P(AMHSTR,P)
S @RETVAL@(AMHI)="T00030Error"_$C(30)
S AMHI=AMHI+1
S @RETVAL@(AMHI)=$S($P($G(^AMHTACT(AMHIEN,0)),U,4):"",1:1)_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
AMHGPCC ; IHS/CMI/MAW - AMHG PCC Visit Links 3/5/2009 8:10:19 AM ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
+2 ;
+3 ;
+4 ;
DEBUG(RETVAL,AMHSTR) ;-- debug entry point
+1 DO DEBUG^%Serenji("PCC^AMHGPCC(.RETVAL,.AMHSTR)")
+2 QUIT
+3 ;
PCC(RETVAL,AMHSTR) ;-- create/edit PCC visit from MHSS RECORD ENTRY
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,P,R,AMHIEN,AMHVS,AMHGRET,AMHREC,AMHER
+3 SET P="|"
SET R="~"
+4 SET RETVAL="^AMHTMP("_$JOB_")"
+5 SET AMHI=0
+6 KILL ^AMHTMP($JOB)
+7 SET AMHIEN=$PIECE(AMHSTR,P)
+8 SET AMHVS=$PIECE(AMHSTR,P,2)
+9 IF '$GET(AMHVS)
SET AMHVS=$PIECE($GET(^AMHREC(AMHIEN,0)),U,16)
+10 DO EN^AMHBHRU(.AMHGRET,AMHIEN,AMHVS)
+11 IF $EXTRACT($GET(AMHGRET),1,2)="-1"
Begin DoDot:1
+12 SET AMHER="0~"_$PIECE(AMHGRET,$CHAR(30),2)
End DoDot:1
+13 IF $GET(AMHGRET)=1
Begin DoDot:1
+14 SET AMHREC=$$GET1^DIQ(9002011,AMHIEN,.16,"I")
End DoDot:1
+15 SET @RETVAL@(AMHI)="T00030Result"_$CHAR(30)
+16 SET AMHI=AMHI+1
+17 SET @RETVAL@(AMHI)=$SELECT($GET(AMHER)]"":AMHER,1:$GET(AMHREC))_$CHAR(30)
+18 SET @RETVAL@(AMHI+1)=$CHAR(31)
+19 QUIT
+20 ;
LIST(RETVAL,AMHSTR) ;-- get a list of visits for the user to choose from
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,P,R,AMHIEN,AMHSEL
+3 SET P="|"
SET R="~"
+4 SET RETVAL="^AMHTMP("_$JOB_")"
+5 SET AMHI=0
+6 KILL ^AMHTMP($JOB)
+7 SET AMHIEN=$PIECE(AMHSTR,P)
+8 DO BSDAPI(.AMHSEL,AMHIEN)
+9 SET @RETVAL@(AMHI)="T00010BMXIEN^T00030Date^T00005Time^T00030Location^T00030Provider^T00030Clinic^T00030ServiceCategory^T00080POV"_$CHAR(30)
+10 NEW AMHDA
+11 SET AMHDA=0
FOR
SET AMHDA=$ORDER(AMHSEL(AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+12 NEW AMHDATA,AMHDT,AMHTM,AMHLOC,AMHPRV,AMHCLN,AMHSC,AMHPOVC,AMHPOVN,AMHPOV
+13 SET AMHDT=$$LVDT^AMHGU($PIECE($PIECE(^AUPNVSIT(AMHDA,0),U),"."))
+14 SET AMHTM=$PIECE($PIECE(^AUPNVSIT(AMHDA,0),U),".",2)
+15 SET AMHTM=$SELECT($LENGTH(AMHTM)=1:AMHTM_"000",$LENGTH(AMHTM)=2:AMHTM_"00",$LENGTH(AMHTM)=3:AMHTM_"0",1:AMHTM)
+16 SET AMHLOC=$$GET1^DIQ(9000010,AMHDA,.06)
+17 SET AMHPRV=$$PRIMPROV^APCLV(AMHDA,"N")
+18 SET AMHPOVC=$$PRIMPOV^APCLV(AMHDA,"C")
+19 SET AMHPOVN=$$PRIMPOV^APCLV(AMHDA,"N")
+20 SET AMHPOV=$SELECT(AMHPOVN]"":AMHPOVC_"-"_AMHPOVN,1:"")
+21 SET AMHCLN=$$GET1^DIQ(9000010,AMHDA,.08)
+22 SET AMHSC=$$GET1^DIQ(9000010,AMHDA,.07)
+23 SET AMHI=AMHI+1
+24 SET @RETVAL@(AMHI)=AMHDA_U_AMHDT_U_AMHTM_U_AMHLOC_U_AMHPRV_U_AMHCLN_U_AMHSC_U_AMHPOV_$CHAR(30)
End DoDot:1
+25 SET @RETVAL@(AMHI+1)=$CHAR(31)
+26 KILL AMHIN
+27 QUIT
+28 ;
BSDAPI(AMHV,AMHR) ;-- get list of visits and return amhv
+1 ;clean out array
KILL AMHIN
+2 DO KILL
+3 SET AMHR0=$GET(^AMHREC(AMHR,0))
+4 SET AMHIN("VISIT DATE")=$PIECE(AMHR0,U)
+5 DO GETTYPE
+6 SET AMHIN("VISIT TYPE")=APCDALVR("APCDTYPE")
+7 SET AMHIN("PAT")=$PIECE(AMHR0,U,8)
+8 SET AMHIN("SITE")=$PIECE(AMHR0,U,4)
+9 ;determine service category based on type of contact
+10 SET AMHIN("SRV CAT")=$PIECE(^AMHTSET($PIECE(AMHR0,U,7),0),U,3)
+11 ;D GETCLN
+12 ;I APCDALVR("APCDCLN")]"" S AMHIN("CLINIC CODE")=APCDALVR("APCDCLN")
+13 SET AMHIN("APCDAPPT")=$PIECE(AMHR0,U,11)
+14 SET AMHIN("APCDOLOC")=$PIECE(AMHR0,U,26)
+15 SET AMHIN("APCDEVM")=$PIECE(AMHR0,U,29)
+16 SET AMHIN("APCDOPT")=$PIECE($GET(XQY0),U)
IF AMHIN("APCDOPT")]""
SET AMHIN("APCDOPT")=$ORDER(^DIC(19,"B",AMHIN("APCDOPT"),0))
+17 SET AMHIN("APCDCAF")=$SELECT($PIECE($GET(^AMHSITE(DUZ(2),18)),U,8):"I",1:"R")
+18 ;never add a visit just find matches
SET AMHIN("NEVER ADD")=1
+19 SET AMHIN("TIME RANGE")=-1
+20 SET AMHIN("USR")=DUZ
+21 KILL APCDALVR
+22 KILL AMHV
+23 DO GETVISIT^BSDAPI4(.AMHIN,.AMHV)
+24 SET AMHERRR=$PIECE(AMHV(0),U,2)
+25 ;errored
IF AMHERRR]""
QUIT
+26 IF $PIECE(AMHV(0),U)=1
SET V=$ORDER(AMHV(0))
IF AMHV(V)="ADD"
SET AMHVSIT=V
QUIT
+27 ;since more than one passed back display them to the user and quit
+28 QUIT
+29 ;
GETTYPE ;get type of visit - use loc current type or affiliation of provider
+1 SET APCDALVR("APCDTYPE")=$SELECT($PIECE($GET(^AMHSITE(DUZ(2),0)),U,2)]"":$PIECE(^(0),U,2),1:"")
IF APCDALVR("APCDTYPE")]""
QUIT
+2 ;S X=$P(^AUTTLOC($P(AMHR0,U,4),0),U,25) I X]"" S APCDALVR("APCDTYPE")=$S(X=1:"I",X=2:"6",X=3:"C",X=4:"U",X=5:"S",X=6:"T",1:"O") Q
+3 ;use pcc master control for site of loc of enc ihs/tucson/lab 11/30/95 patch 1
SET X=$PIECE($GET(^APCCCTRL($PIECE(AMHR0,U,4),0)),U,4)
IF X]""
SET APCDALVR("APCDTYPE")=X
QUIT
+4 SET X=$$PPAFFL^AMHUTIL(AMHR,"I")
IF X
SET APCDALVR("APCDTYPE")=$SELECT(X=1:"I",X=2:"C",X=3:"T",X=8:"6",1:"")
IF APCDALVR("APCDTYPE")]""
QUIT
+5 ;use pcc master control
SET X=$PIECE($GET(^APCCCTRL(DUZ(2),0)),U,4)
IF X]""
SET APCDALVR("APCDTYPE")=X
QUIT
+6 ;default to I if can't determine
SET APCDALVR("APCDTYPE")="I"
+7 QUIT
+8 ;
GETCLN ;determine clinic to pass
+1 SET APCDALVR("APCDCLN")=""
+2 NEW X
+3 SET X=$PIECE(AMHR0,U,7)
+4 IF X=""
GOTO GETCLN1
+5 IF $PIECE($GET(^AMHTSET(X,0)),U,2)=9
SET APCDALVR("APCDCLN")=$ORDER(^DIC(40.7,"C",30,""))
IF APCDALVR("APCDCLN")]""
QUIT
+6 IF $PIECE($GET(^AMHTSET(X,0)),U,2)=5
SET APCDALVR("APCDCLN")=$ORDER(^DIC(40.7,"C",11,""))
IF APCDALVR("APCDCLN")]""
QUIT
GETCLN1 ;
+1 SET APCDALVR("APCDCLN")=$PIECE(AMHR0,U,25)
+2 IF APCDALVR("APCDCLN")]""
QUIT
+3 SET APCDALVR("APCDCLN")=$SELECT($PIECE(AMHR0,U,2)="M":$ORDER(^DIC(40.7,"C",14,"")),$PIECE(AMHR0,U,2)="S":$ORDER(^DIC(40.7,"C",48,"")),$PIECE(AMHR0,U,2)="C":$ORDER(^DIC(40.7,"C",43,0)),1:$ORDER(^DIC(40.7,"C",C4,"")))
+4 IF APCDALVR("APCDCLN")=""
SET APCDALVR("APCDCLN")=$ORDER(^DIC(40.7,"C",25,""))
+5 QUIT
KILL ;
+1 KILL APCDALVR,APCDPAT,APCDLOC,APCDTYPE,APCDCAT,APCDCLN,APCDTPRO,APCDTPS,APCDTPOV,APCDTNQ,APCDTTOP,APCDTLOU,APCDTPRV,APCDTAT,APCDATMP,APCDAFLG,APCDAUTO,APCDANE,AUPNTALK,APCDAPPT,APCDOLOC
+2 QUIT
+3 ;
ACT(RETVAL,AMHSTR) ;-- check to see if the activity code can be passed to PCC
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,P,R,AMHIEN
+3 SET P="|"
SET R="~"
+4 SET RETVAL="^AMHTMP("_$JOB_")"
+5 SET AMHI=0
+6 KILL ^AMHTMP($JOB)
+7 SET AMHIEN=$PIECE(AMHSTR,P)
+8 SET @RETVAL@(AMHI)="T00030Error"_$CHAR(30)
+9 SET AMHI=AMHI+1
+10 SET @RETVAL@(AMHI)=$SELECT($PIECE($GET(^AMHTACT(AMHIEN,0)),U,4):"",1:1)_$CHAR(30)
+11 SET @RETVAL@(AMHI+1)=$CHAR(31)
+12 QUIT
+13 ;
