AMHGSCOM.m

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      ;