AMHGSCOM ; IHS/CMI/MAW - AMHG Save Community Activity 3/6/2009 5:56:09 PM ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
;
;
;
;
DEBUG(RETVAL,AMHSTR) ;-- debug entry point
D DEBUG^%Serenji("COM^AMHGSCOM(.RETVAL,.AMHSTR)")
Q
;
COM(RETVAL,AMHSTR) ;-- save community activity called from clsCommunityDataEntry.SaveCommunityActivity method
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,P,R,AMHDM,AMHREC,AMHPP,AMHPRO,AMHTOC,AMHST,AMHAT,AMHNS,AMHTGT,AMHEDT,AMHLOC,AMHCOM,AMHACT,AMHLSS,AMHFLG,AMHPA,AMHSP,AMHPV,AMHN,APA,APV,AMHER,AMHCLN
S P="|",R="~"
S RETVAL="^AMHTMP("_$J_")"
S AMHI=0
K ^AMHTMP($J)
I $G(AMHSTR)="" D CATSTR^AMHGU(.AMHSTR,.AMHSTR)
S AMHDM=$P(AMHSTR,P)
S AMHREC=$P(AMHSTR,P,2)
S AMHPP=$P(AMHSTR,P,3)
S AMHPRO=$P(AMHSTR,P,4)
S AMHPRO=$$SCI^AMHGT(9002011,.02,AMHPRO)
S AMHTOC=$P(AMHSTR,P,5)
S AMHST=$TR($P(AMHSTR,P,6),":")
S AMHAT=$P(AMHSTR,P,7)
S AMHNS=$P(AMHSTR,P,8)
S AMHTGT=$$SCI^AMHGT(9002011,1106,$P(AMHSTR,P,9))
S AMHEDT=+$P(AMHSTR,P,10)
S AMHLOC=$P(AMHSTR,P,11)
S AMHCOM=$P(AMHSTR,P,12)
S AMHACT=$P(AMHSTR,P,13)
S AMHLSS=$P(AMHSTR,P,14)
S AMHFLG=$P(AMHSTR,P,15)
S AMHPA=$P(AMHSTR,P,16)
S AMHSP=$P(AMHSTR,P,17)
S AMHPV=$P(AMHSTR,P,18)
S AMHN=$P(AMHSTR,P,19)
S AMHCLN=$P(AMHSTR,P,20)
;S AMHEDT=AMHEDT_"."_AMHST
D ARRAY^AMHGU(.APA,AMHPA)
D ARRAY^AMHGU(.APV,AMHPV)
D MODV^AMHGECOM(.AMHREC,AMHDM,AMHREC,AMHPP,AMHPRO,AMHTOC,AMHST,AMHAT,AMHNS,AMHTGT,AMHEDT,AMHLOC,AMHCOM,AMHACT,AMHLSS,AMHFLG,AMHCLN)
D NOTES(AMHREC,AMHN)
D PA(AMHDM,AMHREC,.APA)
D POV^AMHGECOM(AMHDM,AMHREC,"",.APV)
D SP^AMHGSVF(AMHDM,AMHREC,"",AMHSP)
S @RETVAL@(AMHI)="T00030Result"_$C(30)
S AMHI=AMHI+1
S @RETVAL@(AMHI)=$S($G(AMHER)]"":AMHER,1:AMHREC)_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
NOTES(RC,N) ;-- file community notes
;Q:$G(N)=""
D ARRAYT^AMHGU(.AMHWP,N) ;parse the text into an array
N AMHFDA,AMHIENS,AMHERRR
S AMHIENS=RC_","
D WP^AMHGU(.AMHERRR,9002011,AMHIENS,8101,.AMHWP)
Q
;
PA(D,RC,PA) ;-- file prevention activities
N AMHDA
S AMHDA=0 F S AMHDA=$O(PA(AMHDA)) Q:'AMHDA D
. N AP,OTH
. S AP=+$G(PA(AMHDA))
. S OTH=$P($G(PA(AMHDA)),"~",4)
. D MODPA^AMHGECOM(AP,"",RC,OTH)
I D="E" D DELPA^AMHGECOM(RC,.PA)
Q
;
CPT(D,RC,P,CPT) ;-- file cpt codes from activity tab
N ACPT
D ARRAY^AMHGU(.ACPT,.CPT)
N AMHDA
S AMHDA=0 F S AMHDA=$O(ACPT(AMHDA)) Q:'AMHDA D
. N CPT
. S CPT=+$G(ACPT(AMHDA))
. D MODCPT^AMHGEVF(CPT,P,RC)
I D="E" D DELCPT^AMHGEVF(RC,.ACPT)
Q
;
SP(D,RC,P,SP) ;-- file secondary providers from activity tab
N ASP
D ARRAY^AMHGU(.ASP,.SP)
N AMHDA
S AMHDA=0 F S AMHDA=$O(ASP(AMHDA)) Q:'AMHDA D
. N PRV
. S PRV=+$G(ASP(AMHDA))
. D MODPRV^AMHGEVF(PRV,D,RC,P,"S")
I D="E" D DELPRV^AMHGEVF(RC,.ASP,"S")
Q
;
AMHGSCOM ; IHS/CMI/MAW - AMHG Save Community Activity 3/6/2009 5:56:09 PM ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
+2 ;
+3 ;
+4 ;
+5 ;
DEBUG(RETVAL,AMHSTR) ;-- debug entry point
+1 DO DEBUG^%Serenji("COM^AMHGSCOM(.RETVAL,.AMHSTR)")
+2 QUIT
+3 ;
COM(RETVAL,AMHSTR) ;-- save community activity called from clsCommunityDataEntry.SaveCommunityActivity method
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,P,R,AMHDM,AMHREC,AMHPP,AMHPRO,AMHTOC,AMHST,AMHAT,AMHNS,AMHTGT,AMHEDT,AMHLOC,AMHCOM,AMHACT,AMHLSS,AMHFLG,AMHPA,AMHSP,AMHPV,AMHN,APA,APV,AMHER,AMHCLN
+3 SET P="|"
SET R="~"
+4 SET RETVAL="^AMHTMP("_$JOB_")"
+5 SET AMHI=0
+6 KILL ^AMHTMP($JOB)
+7 IF $GET(AMHSTR)=""
DO CATSTR^AMHGU(.AMHSTR,.AMHSTR)
+8 SET AMHDM=$PIECE(AMHSTR,P)
+9 SET AMHREC=$PIECE(AMHSTR,P,2)
+10 SET AMHPP=$PIECE(AMHSTR,P,3)
+11 SET AMHPRO=$PIECE(AMHSTR,P,4)
+12 SET AMHPRO=$$SCI^AMHGT(9002011,.02,AMHPRO)
+13 SET AMHTOC=$PIECE(AMHSTR,P,5)
+14 SET AMHST=$TRANSLATE($PIECE(AMHSTR,P,6),":")
+15 SET AMHAT=$PIECE(AMHSTR,P,7)
+16 SET AMHNS=$PIECE(AMHSTR,P,8)
+17 SET AMHTGT=$$SCI^AMHGT(9002011,1106,$PIECE(AMHSTR,P,9))
+18 SET AMHEDT=+$PIECE(AMHSTR,P,10)
+19 SET AMHLOC=$PIECE(AMHSTR,P,11)
+20 SET AMHCOM=$PIECE(AMHSTR,P,12)
+21 SET AMHACT=$PIECE(AMHSTR,P,13)
+22 SET AMHLSS=$PIECE(AMHSTR,P,14)
+23 SET AMHFLG=$PIECE(AMHSTR,P,15)
+24 SET AMHPA=$PIECE(AMHSTR,P,16)
+25 SET AMHSP=$PIECE(AMHSTR,P,17)
+26 SET AMHPV=$PIECE(AMHSTR,P,18)
+27 SET AMHN=$PIECE(AMHSTR,P,19)
+28 SET AMHCLN=$PIECE(AMHSTR,P,20)
+29 ;S AMHEDT=AMHEDT_"."_AMHST
+30 DO ARRAY^AMHGU(.APA,AMHPA)
+31 DO ARRAY^AMHGU(.APV,AMHPV)
+32 DO MODV^AMHGECOM(.AMHREC,AMHDM,AMHREC,AMHPP,AMHPRO,AMHTOC,AMHST,AMHAT,AMHNS,AMHTGT,AMHEDT,AMHLOC,AMHCOM,AMHACT,AMHLSS,AMHFLG,AMHCLN)
+33 DO NOTES(AMHREC,AMHN)
+34 DO PA(AMHDM,AMHREC,.APA)
+35 DO POV^AMHGECOM(AMHDM,AMHREC,"",.APV)
+36 DO SP^AMHGSVF(AMHDM,AMHREC,"",AMHSP)
+37 SET @RETVAL@(AMHI)="T00030Result"_$CHAR(30)
+38 SET AMHI=AMHI+1
+39 SET @RETVAL@(AMHI)=$SELECT($GET(AMHER)]"":AMHER,1:AMHREC)_$CHAR(30)
+40 SET @RETVAL@(AMHI+1)=$CHAR(31)
+41 QUIT
+42 ;
NOTES(RC,N) ;-- file community notes
+1 ;Q:$G(N)=""
+2 ;parse the text into an array
DO ARRAYT^AMHGU(.AMHWP,N)
+3 NEW AMHFDA,AMHIENS,AMHERRR
+4 SET AMHIENS=RC_","
+5 DO WP^AMHGU(.AMHERRR,9002011,AMHIENS,8101,.AMHWP)
+6 QUIT
+7 ;
PA(D,RC,PA) ;-- file prevention activities
+1 NEW AMHDA
+2 SET AMHDA=0
FOR
SET AMHDA=$ORDER(PA(AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+3 NEW AP,OTH
+4 SET AP=+$GET(PA(AMHDA))
+5 SET OTH=$PIECE($GET(PA(AMHDA)),"~",4)
+6 DO MODPA^AMHGECOM(AP,"",RC,OTH)
End DoDot:1
+7 IF D="E"
DO DELPA^AMHGECOM(RC,.PA)
+8 QUIT
+9 ;
CPT(D,RC,P,CPT) ;-- file cpt codes from activity tab
+1 NEW ACPT
+2 DO ARRAY^AMHGU(.ACPT,.CPT)
+3 NEW AMHDA
+4 SET AMHDA=0
FOR
SET AMHDA=$ORDER(ACPT(AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+5 NEW CPT
+6 SET CPT=+$GET(ACPT(AMHDA))
+7 DO MODCPT^AMHGEVF(CPT,P,RC)
End DoDot:1
+8 IF D="E"
DO DELCPT^AMHGEVF(RC,.ACPT)
+9 QUIT
+10 ;
SP(D,RC,P,SP) ;-- file secondary providers from activity tab
+1 NEW ASP
+2 DO ARRAY^AMHGU(.ASP,.SP)
+3 NEW AMHDA
+4 SET AMHDA=0
FOR
SET AMHDA=$ORDER(ASP(AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+5 NEW PRV
+6 SET PRV=+$GET(ASP(AMHDA))
+7 DO MODPRV^AMHGEVF(PRV,D,RC,P,"S")
End DoDot:1
+8 IF D="E"
DO DELPRV^AMHGEVF(RC,.ASP,"S")
+9 QUIT
+10 ;
