Routine: AMHGSINT

AMHGSINT ; IHS/CMI/MAW - AMHG Intake Form Edits - frmIntake 9/16/2009 10:57:49 AM ;

 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

DEBUG(RETVAL,AMHSTR) ;-- debug entry point

 D DEBUG^%Serenji("EP^AMHGD(RETVAL,.AMHSTR)")

DEL(RETVAL,AMHSTR) ;-- delete an intake

 S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap

 N AMHI,P,R,AMHREC

 S P="|",R="~"

 S AMHREC=$P(AMHSTR,P)

 S RETVAL="^AMHTMP("_$J_")"

 S AMHI=0

 K ^AMHTMP($J)

 S DIK="^AMHRINTK(",DA=AMHREC D ^DIK

 S @RETVAL@(AMHI)="T00001Return"_$C(30)

 S @RETVAL@(AMHI+1)=$C(31)

ASS(RETVAL,AMHSTR) ;-- save assessment from assessment tab, called from SaveAssessment method of clsVisitDataEntry

 S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap

 N AMHI,P,R,AMHDM,AMHREC,AMHA,AMHP,AMHER,AMHIT,AMHPP,AMHPRG,AMHEDT,AMHIIT,AMHITYP,AMHUDT

 S P="|",R="~"

 S RETVAL="^AMHTMP("_$J_")"

 S AMHI=0

 I $G(AMHSTR)="" D CATSTR^AMHGU(.AMHSTR,.AMHSTR)

 K ^AMHTMP($J)

 S AMHDM=$P(AMHSTR,P)

 S AMHREC=$P(AMHSTR,P,2)

 ;S AMHA=$P(AMHSTR,P,3)

 S AMHP=$P(AMHSTR,P,3)

 S AMHIT=$P(AMHSTR,P,4)

 S AMHPP=$P(AMHSTR,P,5)

 S AMHPRG=$$SCI^AMHGT(9002011.13,.05,$P(AMHSTR,P,6))

 S AMHEDT=$P($P(AMHSTR,P,7),".")

 S AMHIIT=$P(AMHSTR,P,8)

 S AMHITYP=$P(AMHSTR,P,9)

 S AMHUDT=$P(AMHSTR,P,10)

 S AMHA=$P(AMHSTR,P,11)

 D ASSE(AMHDM,AMHREC,AMHA,AMHP,AMHIT,AMHPP,AMHPRG,AMHEDT,AMHIIT,AMHITYP,AMHUDT)

 S @RETVAL@(AMHI)="T00030Result"_$C(30)

 S AMHI=AMHI+1

 S @RETVAL@(AMHI)=$S($G(AMHER)]"":AMHER,1:$G(AMHIT))_$C(30)

 S @RETVAL@(AMHI+1)=$C(31)

ASSE(D,RC,A,P,IT,PP,PRG,EDT,IIT,ITYP,UDT) ;EP -- file assessment

 ;Q:$G(A)=""

 I $G(D)="A",$G(A)="" Q

 ;I '$O(^AMHRINTK("AD",RC,0)),$G(A)="" Q

 N AMHWP

 D ARRAYT^AMHGU(.AMHWP,A)  ;parse the text into an array

 N AMHFDA,AMHIENS,AMHERRR

 S AMHIENS=""

 ;S AMHIENS(1)=P

 I $G(IT) D

 . S AMHIENS=IT_","

 . S AMHIT=IT

 . I ITYP="I" D

 .. S AMHFDA(9002011.13,AMHIENS,.01)=EDT

 .. S AMHFDA(9002011.13,AMHIENS,.04)=PP

 .. S AMHFDA(9002011.13,AMHIENS,.05)=PRG

 .. S AMHFDA(9002011.13,AMHIENS,.06)=DUZ

 .. S AMHFDA(9002011.13,AMHIENS,.07)=UDT

 .. ;S AMHFDA(9002011.13,AMHIENS,.13)=DUZ  PR6XX

 . I ITYP="U" D

 .. S AMHFDA(9002011.13,AMHIENS,.01)=EDT

 .. S AMHFDA(9002011.13,AMHIENS,.04)=PP

 .. S AMHFDA(9002011.13,AMHIENS,.05)=PRG

 .. S AMHFDA(9002011.13,AMHIENS,.06)=DUZ

 .. S AMHFDA(9002011.13,AMHIENS,.07)=UDT

 . D FILE^DIE("K","AMHFDA","AMHERRR(1)")

 . ;Q:$O(^AMHRINTK(IT,11,RC,"B",0))

 . ;N AMHFDA,AMHIENS,AMHERRR

 . ;S AMHIENS="+2,"_IT_","

 . ;S AMHFDA(9002011.1311,AMHIENS,.01)=RC

 . ;I '$D(^AMHRINTK(IT,11)) S AMHFDA(9002011.1311,AMHIENS,.02)=1

 . ;D UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(1)")

 . I $D(AMHERRR) S AMHER="0~Edit Assessment"

 I '$G(IT) D

 . S AMHFDA(9002011.13,"+1,",.01)=EDT

 . S AMHFDA(9002011.13,"+1,",.02)=P

 . ;S AMHFDA(9002011.13,"+1,",.03)=RC

 . S AMHFDA(9002011.13,"+1,",.04)=PP

 . S AMHFDA(9002011.13,"+1,",.05)=PRG

 . S AMHFDA(9002011.13,"+1,",.06)=DUZ

 . S AMHFDA(9002011.13,"+1,",.07)=UDT

 . S AMHFDA(9002011.13,"+1,",.09)=ITYP

 . I $G(ITYP)="U" D

 .. S AMHFDA(9002011.13,"+1,",.1)=IIT

 . S AMHFDA(9002011.13,"+1,",.13)=DUZ

 . D UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(1)")

 . I $D(AMHERRR) S AMHER="0~Add Assessment" Q

 . S AMHIT=$G(AMHIENS(1))

 . ;N AMHVFDA,AMHVIENS,AMHVERR,AMHVRS

 . ;S AMHVIENS="+2,+1,"

 . ;S AMHVFDA(9002011.1311,"+2,"_AMHIT_",",.01)=RC

 . ;S AMHVFDA(9002011.1311,"+2,"_AMHIT_",",.02)=1

 . ;D UPDATE^DIE("","AMHVFDA","AMHVIENS","AMHVERR")

 . ;S AMHVRS=$G(AMHVIENS(2))

 N AMHFDA,AMHIENS,AMHERRR

 S AMHIENS=AMHIT_","

 D WP^AMHGU(.AMHERRR,9002011.13,AMHIENS,4100,.AMHWP)

AMHGSINT  ; IHS/CMI/MAW - AMHG Intake Form Edits - frmIntake 9/16/2009 10:57:49 AM ;

 +1       ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

 +2       ;

 +3       ;

DEBUG(RETVAL,AMHSTR) ;-- debug entry point

 +1        DO DEBUG^%Serenji("EP^AMHGD(RETVAL,.AMHSTR)")

 +2        QUIT

 +3       ;

DEL(RETVAL,AMHSTR) ;-- delete an intake

 +1       ; m error trap

           SET X="MERR^AMHGU"

           SET @^%ZOSF("TRAP")

 +2        NEW AMHI,P,R,AMHREC

 +3        SET P="|"

           SET R="~"

 +4        SET AMHREC=$PIECE(AMHSTR,P)

 +5        SET RETVAL="^AMHTMP("_$JOB_")"

 +6        SET AMHI=0

 +7        KILL ^AMHTMP($JOB)

 +8        SET DIK="^AMHRINTK("

           SET DA=AMHREC

           DO ^DIK

 +9        SET @RETVAL@(AMHI)="T00001Return"_$CHAR(30)

 +10       SET @RETVAL@(AMHI+1)=$CHAR(31)

 +11       QUIT

 +12      ;

ASS(RETVAL,AMHSTR) ;-- save assessment from assessment tab, called from SaveAssessment method of clsVisitDataEntry

 +1       ; m error trap

           SET X="MERR^AMHGU"

           SET @^%ZOSF("TRAP")

 +2        NEW AMHI,P,R,AMHDM,AMHREC,AMHA,AMHP,AMHER,AMHIT,AMHPP,AMHPRG,AMHEDT,AMHIIT,AMHITYP,AMHUDT

 +3        SET P="|"

           SET R="~"

 +4        SET RETVAL="^AMHTMP("_$JOB_")"

 +5        SET AMHI=0

 +6        IF $GET(AMHSTR)=""

               DO CATSTR^AMHGU(.AMHSTR,.AMHSTR)

 +7        KILL ^AMHTMP($JOB)

 +8        SET AMHDM=$PIECE(AMHSTR,P)

 +9        SET AMHREC=$PIECE(AMHSTR,P,2)

 +10      ;S AMHA=$P(AMHSTR,P,3)

 +11       SET AMHP=$PIECE(AMHSTR,P,3)

 +12       SET AMHIT=$PIECE(AMHSTR,P,4)

 +13       SET AMHPP=$PIECE(AMHSTR,P,5)

 +14       SET AMHPRG=$$SCI^AMHGT(9002011.13,.05,$PIECE(AMHSTR,P,6))

 +15       SET AMHEDT=$PIECE($PIECE(AMHSTR,P,7),".")

 +16       SET AMHIIT=$PIECE(AMHSTR,P,8)

 +17       SET AMHITYP=$PIECE(AMHSTR,P,9)

 +18       SET AMHUDT=$PIECE(AMHSTR,P,10)

 +19       SET AMHA=$PIECE(AMHSTR,P,11)

 +20       DO ASSE(AMHDM,AMHREC,AMHA,AMHP,AMHIT,AMHPP,AMHPRG,AMHEDT,AMHIIT,AMHITYP,AMHUDT)

 +21       SET @RETVAL@(AMHI)="T00030Result"_$CHAR(30)

 +22       SET AMHI=AMHI+1

 +23       SET @RETVAL@(AMHI)=$SELECT($GET(AMHER)]"":AMHER,1:$GET(AMHIT))_$CHAR(30)

 +24       SET @RETVAL@(AMHI+1)=$CHAR(31)

 +25       QUIT

 +26      ;

ASSE(D,RC,A,P,IT,PP,PRG,EDT,IIT,ITYP,UDT) ;EP -- file assessment

 +1       ;Q:$G(A)=""

 +2        IF $GET(D)="A"

               IF $GET(A)=""

                   QUIT

 +3       ;I '$O(^AMHRINTK("AD",RC,0)),$G(A)="" Q

 +4        NEW AMHWP

 +5       ;parse the text into an array

           DO ARRAYT^AMHGU(.AMHWP,A)

 +6        NEW AMHFDA,AMHIENS,AMHERRR

 +7        SET AMHIENS=""

 +8       ;S AMHIENS(1)=P

 +9        IF $GET(IT)

               Begin DoDot:1

 +10               SET AMHIENS=IT_","

 +11               SET AMHIT=IT

 +12               IF ITYP="I"

                       Begin DoDot:2

 +13                       SET AMHFDA(9002011.13,AMHIENS,.01)=EDT

 +14                       SET AMHFDA(9002011.13,AMHIENS,.04)=PP

 +15                       SET AMHFDA(9002011.13,AMHIENS,.05)=PRG

 +16                       SET AMHFDA(9002011.13,AMHIENS,.06)=DUZ

 +17                       SET AMHFDA(9002011.13,AMHIENS,.07)=UDT

 +18      ;S AMHFDA(9002011.13,AMHIENS,.13)=DUZ  PR6XX

                       End DoDot:2

 +19               IF ITYP="U"

                       Begin DoDot:2

 +20                       SET AMHFDA(9002011.13,AMHIENS,.01)=EDT

 +21                       SET AMHFDA(9002011.13,AMHIENS,.04)=PP

 +22                       SET AMHFDA(9002011.13,AMHIENS,.05)=PRG

 +23                       SET AMHFDA(9002011.13,AMHIENS,.06)=DUZ

 +24                       SET AMHFDA(9002011.13,AMHIENS,.07)=UDT

                       End DoDot:2

 +25               DO FILE^DIE("K","AMHFDA","AMHERRR(1)")

 +26      ;Q:$O(^AMHRINTK(IT,11,RC,"B",0))

 +27      ;N AMHFDA,AMHIENS,AMHERRR

 +28      ;S AMHIENS="+2,"_IT_","

 +29      ;S AMHFDA(9002011.1311,AMHIENS,.01)=RC

 +30      ;I '$D(^AMHRINTK(IT,11)) S AMHFDA(9002011.1311,AMHIENS,.02)=1

 +31      ;D UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(1)")

 +32               IF $DATA(AMHERRR)

                       SET AMHER="0~Edit Assessment"

               End DoDot:1

 +33       IF '$GET(IT)

               Begin DoDot:1

 +34               SET AMHFDA(9002011.13,"+1,",.01)=EDT

 +35               SET AMHFDA(9002011.13,"+1,",.02)=P

 +36      ;S AMHFDA(9002011.13,"+1,",.03)=RC

 +37               SET AMHFDA(9002011.13,"+1,",.04)=PP

 +38               SET AMHFDA(9002011.13,"+1,",.05)=PRG

 +39               SET AMHFDA(9002011.13,"+1,",.06)=DUZ

 +40               SET AMHFDA(9002011.13,"+1,",.07)=UDT

 +41               SET AMHFDA(9002011.13,"+1,",.09)=ITYP

 +42               IF $GET(ITYP)="U"

                       Begin DoDot:2

 +43                       SET AMHFDA(9002011.13,"+1,",.1)=IIT

                       End DoDot:2

 +44               SET AMHFDA(9002011.13,"+1,",.13)=DUZ

 +45               DO UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(1)")

 +46               IF $DATA(AMHERRR)

                       SET AMHER="0~Add Assessment"

                       QUIT

 +47               SET AMHIT=$GET(AMHIENS(1))

 +48      ;N AMHVFDA,AMHVIENS,AMHVERR,AMHVRS

 +49      ;S AMHVIENS="+2,+1,"

 +50      ;S AMHVFDA(9002011.1311,"+2,"_AMHIT_",",.01)=RC

 +51      ;S AMHVFDA(9002011.1311,"+2,"_AMHIT_",",.02)=1

 +52      ;D UPDATE^DIE("","AMHVFDA","AMHVIENS","AMHVERR")

 +53      ;S AMHVRS=$G(AMHVIENS(2))

               End DoDot:1

 +54       NEW AMHFDA,AMHIENS,AMHERRR

 +55       SET AMHIENS=AMHIT_","

 +56       DO WP^AMHGU(.AMHERRR,9002011.13,AMHIENS,4100,.AMHWP)

 +57       QUIT

 +58      ;

AMHGSINT.m