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

AMHGPCC.m

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