Routine: AMHGDGP

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)")

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)

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)

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)

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)

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)

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)

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)

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      ;

AMHGDGP.m