AMHGDGP ; IHS/CMI/MAW - AMH Group Data Entry 1/22/2009 1:54:47 PM ;
;;4.0;IHS BEHAVIORAL HEALTH;**1,4,5**;JUN 02, 2010;Build 18
;
;
;
DEBUG(RETVAL,AMHSTR) ;-- debug entry point
D DEBUG^%Serenji("EP^AMHGDGP(RETVAL,.AMHSTR)")
Q
;
ENC(RETVAL,AMHSTR) ;-- retrieve group encounter information
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,P,R
S P="|",R="~"
S RETVAL="^AMHTMP("_$J_")"
S AMHI=0
K ^AMHTMP($J)
S @RETVAL@(AMHI)="T00010BMXIEN^T00030PrimaryProvider^T00030Program^T00030GroupName^T00030Clinic^T00030TypeofContact^T00030EncounterLocation^T00020EncounterDate^T00010ArrivalTime^T00050CommofService^T00050Activity^T00010ActivityTime"
S @RETVAL@(AMHI)=@RETVAL@(AMHI)_"^T00250ChiefComplaint"_$C(30)
N AMHIEN,AMHPRVI,AMHPRV,AMHPRGI,AMHPRG,AMHCLNI,AMHCLN,AMHCLNS,AMHCTI,AMHCT,AMHCTS,AMHARR,AMHENCDT,AMHELOCI,AMHELOC,AMHACI,AMHAC,AMHACS,AMHCOMMI,AMHCOMM
N AMHPRVS,AMHPRGS,AMHCLNS,AMHTOCS,AMHLOCS,AMHAPWIS,AMHCOMMS,AMHDT,AMHGRP,AMHGAT,AMHCC
S AMHIEN=$P(AMHSTR,P)
S AMHDT=$$GET1^DIQ(9002011.67,AMHIEN,.01,"I")
S AMHDT=$$VCDT^AMHGU(AMHDT)
S AMHGRP=$$GET1^DIQ(9002011.67,AMHIEN,.03,"I")
S AMHCTI=$$GET1^DIQ(9002011.67,AMHIEN,.08,"I")
S AMHCT=$$GET1^DIQ(9002011.67,AMHIEN,.08)
S AMHCTS=$S(AMHCTI:AMHCTI_R_AMHCT,1:"")
S AMHPRG=$$GET1^DIQ(9002011.67,AMHIEN,.02)
S AMHPRVI=$$GETPRVG^AMHGU(AMHIEN,"P")
S AMHPRV=$S($G(AMHPRVI):$$GET1^DIQ(200,AMHPRVI,.01),1:"")
S AMHPRVS=$S(AMHPRVI:AMHPRVI_R_AMHPRV,1:"")
S AMHACI=$$GET1^DIQ(9002011.67,AMHIEN,.07,"I")
S AMHAC=$S(AMHACI:$$GET1^DIQ(9002012,AMHACI,.02),1:"")
S AMHACS=$S(AMHACI:AMHACI_R_AMHAC,1:"")
S AMHCLNI=$$GET1^DIQ(9002011.67,AMHIEN,.14,"I")
S AMHCLN=$$GET1^DIQ(9002011.67,AMHIEN,.14)
S AMHCLNS=$S(AMHCLNI:AMHCLNI_R_AMHCLN,1:"")
S AMHARR=$P($$GET1^DIQ(9002011.67,AMHIEN,.01,"I"),".",2)
;I $G(AMHARR) D
;. I $L(AMHARR=1) S AMHARR=AMHARR_"000" Q
;. I $L(AMHARR=2) S AMHARR=AMHARR_"00" Q
;. I $L(AMHARR=3) S AMHARR=AMHARR_"0" Q
S AMHARR=""
S AMHELOCI=$$GET1^DIQ(9002011.67,AMHIEN,.05,"I")
I AMHELOCI,$P($G(^AUTTLOC(AMHELOCI,0)),U,27) S AMHELOCI="" ;don't bring back inactive
S AMHELOC=$$GET1^DIQ(9002011.67,AMHIEN,.05)
S AMHLOCS=$S(AMHELOCI:AMHELOCI_R_AMHELOC,1:"")
S AMHCOMMI=$$GET1^DIQ(9002011.67,AMHIEN,.06,"I")
I $G(AMHCOMMI),$P($G(^AUTTCOM(AMHCOMMI,0)),U,18) S AMHCOMMI="" ;don't bring back inactive
S AMHCOMM=$$GET1^DIQ(9002011.67,AMHIEN,.06)
S AMHCOMMS=$S(AMHCOMMI:AMHCOMMI_R_AMHCOMM,1:"")
S AMHGAT=$$GET1^DIQ(9002011.67,AMHIEN,.11)
S AMHCC=$$GET1^DIQ(9002011.67,AMHIEN,1200)
S AMHI=AMHI+1
S @RETVAL@(AMHI)=AMHIEN_U_AMHPRVS_U_AMHPRG_U_AMHGRP_U_AMHCLNS_U_AMHCTS_U_AMHLOCS_U_AMHDT_U_AMHARR_U_AMHCOMMS_U_AMHACS_U_AMHGAT_U_AMHCC_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
POV(RETVAL,AMHSTR) ;-- retrieve POV information
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,P,R,AMHIEN,AMHDUPE,AMHDATE
S P="|",R="~"
S RETVAL="^AMHTMP("_$J_")"
S AMHI=0
K ^AMHTMP($J)
S AMHIEN=$P(AMHSTR,P)
S AMHDUPE=$P(AMHSTR,P,2) ;p5
S AMHDATE=$P(AMHSTR,P,3)
S AMHDATE=$S(AMHDATE]"":AMHDATE,1:DT)
S @RETVAL@(AMHI)="T00010BMXIEN^T00010Code^T00100Narrative"_$C(30)
N AMHDA,AMHPOVI
S AMHDA=0 F S AMHDA=$O(^AMHGROUP(AMHIEN,21,AMHDA)) Q:'AMHDA D
. N AMHPOVI,AMHPOV,AMHPOVC,AMHPOVE,AMHPOVN
. S AMHPOVI=+$G(^AMHGROUP(AMHIEN,21,AMHDA,0))
. I $G(AMHDUPE) Q:'$$CHKD^AMHUTIL1(AMHPOVI,AMHDATE)
. S AMHPOV=$$GET1^DIQ(9002012.2,AMHPOVI,.01,"I")
. S AMHPOVC=$$GET1^DIQ(9002012.2,AMHPOVI,.01)
. S AMHPOVN=$P($G(^AMHGROUP(AMHIEN,21,AMHDA,0)),U,2)
. S AMHPOVE=$S($G(AMHPOVN)]"":$$GET1^DIQ(9999999.27,AMHPOVN,.01),1:$$GET1^DIQ(9002012.2,AMHPOVI,.02))
. S AMHI=AMHI+1
. S @RETVAL@(AMHI)=AMHPOVI_U_AMHPOVC_U_AMHPOVE_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
SOAP(RETVAL,AMHSTR) ;-- retrieve the SOAP for the group data tab
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)="T00250Soap"_$C(30)
N AMHDA
S AMHDA=0 F S AMHDA=$O(^AMHGROUP(AMHIEN,31,AMHDA)) Q:'AMHDA D
. N AMHDATA
. S AMHDATA=$G(^AMHGROUP(AMHIEN,31,AMHDA,0))
. ;I AMHDATA'[$C(10) S AMHDATA=AMHDATA_$C(10) ;cmi/maw 06/16/2010 try removing this and see what happens 11/18/2010
. S AMHI=AMHI+1
. S @RETVAL@(AMHI)=AMHDATA_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
CPT(RETVAL,AMHSTR) ;-- retrieve cpt codes for group data
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,P,R,AMHIEN,AMHDUPE,AMHDATE
S P="|",R="~"
S RETVAL="^AMHTMP("_$J_")"
S AMHI=0
K ^AMHTMP($J)
S AMHIEN=$P(AMHSTR,P)
S AMHDUPE=$P(AMHSTR,P,2)
S AMHDATE=$P(AMHSTR,P,3)
S AMHDATE=$S(AMHDATE]"":AMHDATE,1:DT)
S @RETVAL@(AMHI)="T00010BMXIEN^T00010Code^T00050Narrative^T00010Quantity^T00010Mod1IEN^T00010Mod1^T00010Mod2IEN^T00010Mod2"_$C(30)
N AMHDA
S AMHDA=0 F S AMHDA=$O(^AMHGROUP(AMHIEN,41,AMHDA)) Q:'AMHDA D
. N AMHCPTI,AMHCPT,AMHCPTE,AMHQTY,AMHMOD1I,AMHMOD1,AMHMOD2I,AMHMOD2
. S AMHCPTI=$P($G(^AMHGROUP(AMHIEN,41,AMHDA,0)),U)
. I $G(AMHDUPE) D CPT^AMHUTIL1(AMHCPTI,AMHDATE) I '$T Q
. S AMHQTY=$P($G(^AMHGROUP(AMHIEN,41,AMHDA,0)),U,2)
. I AMHQTY="" S AMHQTY=1
. I AMHQTY<1 S AMHQTY=1
. S AMHMOD1I=$P($G(^AMHGROUP(AMHIEN,41,AMHDA,0)),U,3)
. S AMHMOD1=$$GET1^DIQ(81.3,AMHMOD1I,.01)
. S AMHMOD2I=$P($G(^AMHGROUP(AMHIEN,41,AMHDA,0)),U,4)
. S AMHMOD2=$$GET1^DIQ(81.3,AMHMOD2I,.01)
. S AMHCPT=$$GET1^DIQ(81,AMHCPTI,.01)
. S AMHCPTE=$$GET1^DIQ(81,AMHCPTI,2)
. S AMHI=AMHI+1
. S @RETVAL@(AMHI)=AMHCPTI_U_AMHCPT_U_AMHCPTE_U_AMHQTY_U_AMHMOD1I_U_AMHMOD1_U_AMHMOD2I_U_AMHMOD2_$C(30) ;v4.0p1 ihs/cmi/maw changed 2nd piece to AMHCPT from AMHCPTI
S @RETVAL@(AMHI+1)=$C(31)
Q
;
SP(RETVAL,AMHSTR) ;-- retrieve secondary providers for group data tab
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)="T00010BMXIEN^T00030Provider"_$C(30)
N AMHDA
S AMHDA=0 F S AMHDA=$O(^AMHGROUP(AMHIEN,11,AMHDA)) Q:'AMHDA D
. N AMHSPRV,AMHSPRVI
. Q:$P($G(^AMHGROUP(AMHIEN,11,AMHDA,0)),U,2)'="S" ;filter out primary
. S AMHSPRVI=$P($G(^AMHGROUP(AMHIEN,11,AMHDA,0)),U)
. S AMHSPRV=$$GET1^DIQ(200,AMHSPRVI,.01)
. S AMHI=AMHI+1
. S @RETVAL@(AMHI)=AMHSPRVI_U_AMHSPRV_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
EDU(RETVAL,AMHSTR) ;-- retrieve group education topics
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)="T00010BMXIEN^T00030EducationTopic^T00010TimeSpent^T00030LevelOfUnderstanding^T00100Comment^T00050CPT^T00030Status^T00030Goal^T00050Provider"_$C(30)
N AMHDA
S AMHDA=0 F S AMHDA=$O(^AMHGROUP(AMHIEN,71,AMHDA)) Q:'AMHDA D
. N AMHEDU,AMHTS,AMHLOU,AMHCMT,AMHGOAL,AMHCPT,AMHST,AMHDATA,AMHEDUI,AMHCPT,AMHPRVI,AMHPRV
. S AMHDATA=$G(^AMHGROUP(AMHIEN,71,AMHDA,0))
. S AMHEDUI=$P(AMHDATA,U)
. S AMHEDU=$S(AMHEDUI:$$GET1^DIQ(9999999.09,AMHEDUI,.01),1:"")
. S AMHTS=$P(AMHDATA,U,4)
. S AMHLOU=$P(AMHDATA,U,6)
. I $G(AMHLOU)]"" S AMHLOU=$$SCE^AMHGT(9002011.6771,.06,AMHLOU)
. S AMHCMT=$G(^AMHGROUP(AMHIEN,71,AMHDA,11))
. S AMHGOAL=$P(AMHDATA,U,7)
. S AMHST=$P(AMHDATA,U,8)
. I $G(AMHST)]"" S AMHST=$$SCE^AMHGT(9002011.6771,.08,AMHST)
. S AMHCPT=$P(AMHDATA,U,5)
. S AMHPRVI=$P(AMHDATA,U,2)
. S AMHPRV=$S(AMHPRVI:AMHPRVI_"-"_$$GET1^DIQ(200,AMHPRVI,.01),1:"")
. S AMHI=AMHI+1
. S @RETVAL@(AMHI)=AMHDA_U_AMHEDU_U_AMHTS_U_AMHLOU_U_AMHCMT_U_AMHCPT_U_AMHST_U_AMHGOAL_U_AMHPRV_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
PAT(RETVAL,AMHSTR) ;-- get patients for group patients tab
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)="T00010BMXIEN^T00010PatientIEN^T00010AMHREC^T00030PatientName^T00001Sex^T00010Age^T00020DOB^T00010Chart^T00030DOD"_$C(30)
N AMHDA
S AMHDA=0 F S AMHDA=$O(^AMHGROUP(AMHIEN,51,AMHDA)) Q:'AMHDA D
. N AMHPAT,AMHPNM,AMHSX,AMHAGE,AMHDOB,AMHCHT,AMHREC,AMHDOD
. S AMHPAT=$G(^AMHGROUP(AMHIEN,51,AMHDA,0))
. S AMHREC=$$GETREC^AMHGU(AMHPAT,AMHIEN)
. S AMHPNM=$$GET1^DIQ(2,AMHPAT,.01)
. S AMHSX=$$GET1^DIQ(2,AMHPAT,.02,"I")
. S AMHAGE=$$AGE^AUPNPAT(AMHPAT)
. S AMHDOB=$$GET1^DIQ(2,AMHPAT,.03,"I")
. S AMHCHT=$$HRN^AUPNPAT(AMHPAT,DUZ(2))
. S AMHDOD=$$GET1^DIQ(2,AMHPAT,.351)
. S AMHI=AMHI+1
. S @RETVAL@(AMHI)=AMHIEN_U_AMHPAT_U_AMHREC_U_AMHPNM_U_AMHSX_U_AMHAGE_U_$$LVDT^AMHGU(AMHDOB)_U_AMHCHT_U_AMHDOD_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
AMHGDGP ; IHS/CMI/MAW - AMH Group Data Entry 1/22/2009 1:54:47 PM ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;**1,4,5**;JUN 02, 2010;Build 18
+2 ;
+3 ;
+4 ;
DEBUG(RETVAL,AMHSTR) ;-- debug entry point
+1 DO DEBUG^%Serenji("EP^AMHGDGP(RETVAL,.AMHSTR)")
+2 QUIT
+3 ;
ENC(RETVAL,AMHSTR) ;-- retrieve group encounter information
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,P,R
+3 SET P="|"
SET R="~"
+4 SET RETVAL="^AMHTMP("_$JOB_")"
+5 SET AMHI=0
+6 KILL ^AMHTMP($JOB)
+7 SET @RETVAL@(AMHI)="T00010BMXIEN^T00030PrimaryProvider^T00030Program^T00030GroupName^T00030Clinic^T00030TypeofContact^T00030EncounterLocation^T00020EncounterDate^T00010ArrivalTime^T00050CommofService^T00050Activity^T00010ActivityTime"
+8 SET @RETVAL@(AMHI)=@RETVAL@(AMHI)_"^T00250ChiefComplaint"_$CHAR(30)
+9 NEW AMHIEN,AMHPRVI,AMHPRV,AMHPRGI,AMHPRG,AMHCLNI,AMHCLN,AMHCLNS,AMHCTI,AMHCT,AMHCTS,AMHARR,AMHENCDT,AMHELOCI,AMHELOC,AMHACI,AMHAC,AMHACS,AMHCOMMI,AMHCOMM
+10 NEW AMHPRVS,AMHPRGS,AMHCLNS,AMHTOCS,AMHLOCS,AMHAPWIS,AMHCOMMS,AMHDT,AMHGRP,AMHGAT,AMHCC
+11 SET AMHIEN=$PIECE(AMHSTR,P)
+12 SET AMHDT=$$GET1^DIQ(9002011.67,AMHIEN,.01,"I")
+13 SET AMHDT=$$VCDT^AMHGU(AMHDT)
+14 SET AMHGRP=$$GET1^DIQ(9002011.67,AMHIEN,.03,"I")
+15 SET AMHCTI=$$GET1^DIQ(9002011.67,AMHIEN,.08,"I")
+16 SET AMHCT=$$GET1^DIQ(9002011.67,AMHIEN,.08)
+17 SET AMHCTS=$SELECT(AMHCTI:AMHCTI_R_AMHCT,1:"")
+18 SET AMHPRG=$$GET1^DIQ(9002011.67,AMHIEN,.02)
+19 SET AMHPRVI=$$GETPRVG^AMHGU(AMHIEN,"P")
+20 SET AMHPRV=$SELECT($GET(AMHPRVI):$$GET1^DIQ(200,AMHPRVI,.01),1:"")
+21 SET AMHPRVS=$SELECT(AMHPRVI:AMHPRVI_R_AMHPRV,1:"")
+22 SET AMHACI=$$GET1^DIQ(9002011.67,AMHIEN,.07,"I")
+23 SET AMHAC=$SELECT(AMHACI:$$GET1^DIQ(9002012,AMHACI,.02),1:"")
+24 SET AMHACS=$SELECT(AMHACI:AMHACI_R_AMHAC,1:"")
+25 SET AMHCLNI=$$GET1^DIQ(9002011.67,AMHIEN,.14,"I")
+26 SET AMHCLN=$$GET1^DIQ(9002011.67,AMHIEN,.14)
+27 SET AMHCLNS=$SELECT(AMHCLNI:AMHCLNI_R_AMHCLN,1:"")
+28 SET AMHARR=$PIECE($$GET1^DIQ(9002011.67,AMHIEN,.01,"I"),".",2)
+29 ;I $G(AMHARR) D
+30 ;. I $L(AMHARR=1) S AMHARR=AMHARR_"000" Q
+31 ;. I $L(AMHARR=2) S AMHARR=AMHARR_"00" Q
+32 ;. I $L(AMHARR=3) S AMHARR=AMHARR_"0" Q
+33 SET AMHARR=""
+34 SET AMHELOCI=$$GET1^DIQ(9002011.67,AMHIEN,.05,"I")
+35 ;don't bring back inactive
IF AMHELOCI
IF $PIECE($GET(^AUTTLOC(AMHELOCI,0)),U,27)
SET AMHELOCI=""
+36 SET AMHELOC=$$GET1^DIQ(9002011.67,AMHIEN,.05)
+37 SET AMHLOCS=$SELECT(AMHELOCI:AMHELOCI_R_AMHELOC,1:"")
+38 SET AMHCOMMI=$$GET1^DIQ(9002011.67,AMHIEN,.06,"I")
+39 ;don't bring back inactive
IF $GET(AMHCOMMI)
IF $PIECE($GET(^AUTTCOM(AMHCOMMI,0)),U,18)
SET AMHCOMMI=""
+40 SET AMHCOMM=$$GET1^DIQ(9002011.67,AMHIEN,.06)
+41 SET AMHCOMMS=$SELECT(AMHCOMMI:AMHCOMMI_R_AMHCOMM,1:"")
+42 SET AMHGAT=$$GET1^DIQ(9002011.67,AMHIEN,.11)
+43 SET AMHCC=$$GET1^DIQ(9002011.67,AMHIEN,1200)
+44 SET AMHI=AMHI+1
+45 SET @RETVAL@(AMHI)=AMHIEN_U_AMHPRVS_U_AMHPRG_U_AMHGRP_U_AMHCLNS_U_AMHCTS_U_AMHLOCS_U_AMHDT_U_AMHARR_U_AMHCOMMS_U_AMHACS_U_AMHGAT_U_AMHCC_$CHAR(30)
+46 SET @RETVAL@(AMHI+1)=$CHAR(31)
+47 QUIT
+48 ;
POV(RETVAL,AMHSTR) ;-- retrieve POV information
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,P,R,AMHIEN,AMHDUPE,AMHDATE
+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 ;p5
SET AMHDUPE=$PIECE(AMHSTR,P,2)
+9 SET AMHDATE=$PIECE(AMHSTR,P,3)
+10 SET AMHDATE=$SELECT(AMHDATE]"":AMHDATE,1:DT)
+11 SET @RETVAL@(AMHI)="T00010BMXIEN^T00010Code^T00100Narrative"_$CHAR(30)
+12 NEW AMHDA,AMHPOVI
+13 SET AMHDA=0
FOR
SET AMHDA=$ORDER(^AMHGROUP(AMHIEN,21,AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+14 NEW AMHPOVI,AMHPOV,AMHPOVC,AMHPOVE,AMHPOVN
+15 SET AMHPOVI=+$GET(^AMHGROUP(AMHIEN,21,AMHDA,0))
+16 IF $GET(AMHDUPE)
IF '$$CHKD^AMHUTIL1(AMHPOVI,AMHDATE)
QUIT
+17 SET AMHPOV=$$GET1^DIQ(9002012.2,AMHPOVI,.01,"I")
+18 SET AMHPOVC=$$GET1^DIQ(9002012.2,AMHPOVI,.01)
+19 SET AMHPOVN=$PIECE($GET(^AMHGROUP(AMHIEN,21,AMHDA,0)),U,2)
+20 SET AMHPOVE=$SELECT($GET(AMHPOVN)]"":$$GET1^DIQ(9999999.27,AMHPOVN,.01),1:$$GET1^DIQ(9002012.2,AMHPOVI,.02))
+21 SET AMHI=AMHI+1
+22 SET @RETVAL@(AMHI)=AMHPOVI_U_AMHPOVC_U_AMHPOVE_$CHAR(30)
End DoDot:1
+23 SET @RETVAL@(AMHI+1)=$CHAR(31)
+24 QUIT
+25 ;
SOAP(RETVAL,AMHSTR) ;-- retrieve the SOAP for the group data tab
+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)="T00250Soap"_$CHAR(30)
+9 NEW AMHDA
+10 SET AMHDA=0
FOR
SET AMHDA=$ORDER(^AMHGROUP(AMHIEN,31,AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+11 NEW AMHDATA
+12 SET AMHDATA=$GET(^AMHGROUP(AMHIEN,31,AMHDA,0))
+13 ;I AMHDATA'[$C(10) S AMHDATA=AMHDATA_$C(10) ;cmi/maw 06/16/2010 try removing this and see what happens 11/18/2010
+14 SET AMHI=AMHI+1
+15 SET @RETVAL@(AMHI)=AMHDATA_$CHAR(30)
End DoDot:1
+16 SET @RETVAL@(AMHI+1)=$CHAR(31)
+17 QUIT
+18 ;
CPT(RETVAL,AMHSTR) ;-- retrieve cpt codes for group data
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,P,R,AMHIEN,AMHDUPE,AMHDATE
+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 AMHDUPE=$PIECE(AMHSTR,P,2)
+9 SET AMHDATE=$PIECE(AMHSTR,P,3)
+10 SET AMHDATE=$SELECT(AMHDATE]"":AMHDATE,1:DT)
+11 SET @RETVAL@(AMHI)="T00010BMXIEN^T00010Code^T00050Narrative^T00010Quantity^T00010Mod1IEN^T00010Mod1^T00010Mod2IEN^T00010Mod2"_$CHAR(30)
+12 NEW AMHDA
+13 SET AMHDA=0
FOR
SET AMHDA=$ORDER(^AMHGROUP(AMHIEN,41,AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+14 NEW AMHCPTI,AMHCPT,AMHCPTE,AMHQTY,AMHMOD1I,AMHMOD1,AMHMOD2I,AMHMOD2
+15 SET AMHCPTI=$PIECE($GET(^AMHGROUP(AMHIEN,41,AMHDA,0)),U)
+16 IF $GET(AMHDUPE)
DO CPT^AMHUTIL1(AMHCPTI,AMHDATE)
IF '$TEST
QUIT
+17 SET AMHQTY=$PIECE($GET(^AMHGROUP(AMHIEN,41,AMHDA,0)),U,2)
+18 IF AMHQTY=""
SET AMHQTY=1
+19 IF AMHQTY<1
SET AMHQTY=1
+20 SET AMHMOD1I=$PIECE($GET(^AMHGROUP(AMHIEN,41,AMHDA,0)),U,3)
+21 SET AMHMOD1=$$GET1^DIQ(81.3,AMHMOD1I,.01)
+22 SET AMHMOD2I=$PIECE($GET(^AMHGROUP(AMHIEN,41,AMHDA,0)),U,4)
+23 SET AMHMOD2=$$GET1^DIQ(81.3,AMHMOD2I,.01)
+24 SET AMHCPT=$$GET1^DIQ(81,AMHCPTI,.01)
+25 SET AMHCPTE=$$GET1^DIQ(81,AMHCPTI,2)
+26 SET AMHI=AMHI+1
+27 ;v4.0p1 ihs/cmi/maw changed 2nd piece to AMHCPT from AMHCPTI
SET @RETVAL@(AMHI)=AMHCPTI_U_AMHCPT_U_AMHCPTE_U_AMHQTY_U_AMHMOD1I_U_AMHMOD1_U_AMHMOD2I_U_AMHMOD2_$CHAR(30)
End DoDot:1
+28 SET @RETVAL@(AMHI+1)=$CHAR(31)
+29 QUIT
+30 ;
SP(RETVAL,AMHSTR) ;-- retrieve secondary providers for group data tab
+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)="T00010BMXIEN^T00030Provider"_$CHAR(30)
+9 NEW AMHDA
+10 SET AMHDA=0
FOR
SET AMHDA=$ORDER(^AMHGROUP(AMHIEN,11,AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+11 NEW AMHSPRV,AMHSPRVI
+12 ;filter out primary
IF $PIECE($GET(^AMHGROUP(AMHIEN,11,AMHDA,0)),U,2)'="S"
QUIT
+13 SET AMHSPRVI=$PIECE($GET(^AMHGROUP(AMHIEN,11,AMHDA,0)),U)
+14 SET AMHSPRV=$$GET1^DIQ(200,AMHSPRVI,.01)
+15 SET AMHI=AMHI+1
+16 SET @RETVAL@(AMHI)=AMHSPRVI_U_AMHSPRV_$CHAR(30)
End DoDot:1
+17 SET @RETVAL@(AMHI+1)=$CHAR(31)
+18 QUIT
+19 ;
EDU(RETVAL,AMHSTR) ;-- retrieve group education topics
+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)="T00010BMXIEN^T00030EducationTopic^T00010TimeSpent^T00030LevelOfUnderstanding^T00100Comment^T00050CPT^T00030Status^T00030Goal^T00050Provider"_$CHAR(30)
+9 NEW AMHDA
+10 SET AMHDA=0
FOR
SET AMHDA=$ORDER(^AMHGROUP(AMHIEN,71,AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+11 NEW AMHEDU,AMHTS,AMHLOU,AMHCMT,AMHGOAL,AMHCPT,AMHST,AMHDATA,AMHEDUI,AMHCPT,AMHPRVI,AMHPRV
+12 SET AMHDATA=$GET(^AMHGROUP(AMHIEN,71,AMHDA,0))
+13 SET AMHEDUI=$PIECE(AMHDATA,U)
+14 SET AMHEDU=$SELECT(AMHEDUI:$$GET1^DIQ(9999999.09,AMHEDUI,.01),1:"")
+15 SET AMHTS=$PIECE(AMHDATA,U,4)
+16 SET AMHLOU=$PIECE(AMHDATA,U,6)
+17 IF $GET(AMHLOU)]""
SET AMHLOU=$$SCE^AMHGT(9002011.6771,.06,AMHLOU)
+18 SET AMHCMT=$GET(^AMHGROUP(AMHIEN,71,AMHDA,11))
+19 SET AMHGOAL=$PIECE(AMHDATA,U,7)
+20 SET AMHST=$PIECE(AMHDATA,U,8)
+21 IF $GET(AMHST)]""
SET AMHST=$$SCE^AMHGT(9002011.6771,.08,AMHST)
+22 SET AMHCPT=$PIECE(AMHDATA,U,5)
+23 SET AMHPRVI=$PIECE(AMHDATA,U,2)
+24 SET AMHPRV=$SELECT(AMHPRVI:AMHPRVI_"-"_$$GET1^DIQ(200,AMHPRVI,.01),1:"")
+25 SET AMHI=AMHI+1
+26 SET @RETVAL@(AMHI)=AMHDA_U_AMHEDU_U_AMHTS_U_AMHLOU_U_AMHCMT_U_AMHCPT_U_AMHST_U_AMHGOAL_U_AMHPRV_$CHAR(30)
End DoDot:1
+27 SET @RETVAL@(AMHI+1)=$CHAR(31)
+28 QUIT
+29 ;
PAT(RETVAL,AMHSTR) ;-- get patients for group patients tab
+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)="T00010BMXIEN^T00010PatientIEN^T00010AMHREC^T00030PatientName^T00001Sex^T00010Age^T00020DOB^T00010Chart^T00030DOD"_$CHAR(30)
+9 NEW AMHDA
+10 SET AMHDA=0
FOR
SET AMHDA=$ORDER(^AMHGROUP(AMHIEN,51,AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+11 NEW AMHPAT,AMHPNM,AMHSX,AMHAGE,AMHDOB,AMHCHT,AMHREC,AMHDOD
+12 SET AMHPAT=$GET(^AMHGROUP(AMHIEN,51,AMHDA,0))
+13 SET AMHREC=$$GETREC^AMHGU(AMHPAT,AMHIEN)
+14 SET AMHPNM=$$GET1^DIQ(2,AMHPAT,.01)
+15 SET AMHSX=$$GET1^DIQ(2,AMHPAT,.02,"I")
+16 SET AMHAGE=$$AGE^AUPNPAT(AMHPAT)
+17 SET AMHDOB=$$GET1^DIQ(2,AMHPAT,.03,"I")
+18 SET AMHCHT=$$HRN^AUPNPAT(AMHPAT,DUZ(2))
+19 SET AMHDOD=$$GET1^DIQ(2,AMHPAT,.351)
+20 SET AMHI=AMHI+1
+21 SET @RETVAL@(AMHI)=AMHIEN_U_AMHPAT_U_AMHREC_U_AMHPNM_U_AMHSX_U_AMHAGE_U_$$LVDT^AMHGU(AMHDOB)_U_AMHCHT_U_AMHDOD_$CHAR(30)
End DoDot:1
+22 SET @RETVAL@(AMHI+1)=$CHAR(31)
+23 QUIT
+24 ;
