Routine: AMHGSTP

AMHGSTP ; IHS/CMI/MAW - AMHG Save Treatment Plan 3/7/2009 8:49:18 PM ;

 ;;4.0;IHS BEHAVIORAL HEALTH;**1,4**;JUN 18, 2010;Build 28

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

 D DEBUG^%Serenji("NARR^AMHGSTP(.RETVAL,.AMHSTR)")

TP(RETVAL,AMHSTR) ;-- save treatment plan, called from clsTreatmentPlanDataEntry.SaveTreatmentPlan

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

 N AMHI,P,R,AMHDM,AMHREC,AMHP,AMHDE,AMHPRG,AMHTD,AMHRD,AMHDC,AMHDP,AMHCA,AMHCD,AMHCS,AMHPRBL,AMHER,AMHPP,AMHGAF,PP

 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 AMHP=$P(AMHSTR,P,3)

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

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

 S AMHPRG=$$SCI^AMHGT(9002011,.02,AMHPRG)

 S AMHTD=$P(AMHSTR,P,6)

 S AMHRD=$P(AMHSTR,P,7)

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

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

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

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

 S AMHCD=$P(AMHSTR,P,12)

 S AMHCS=$P(AMHSTR,P,13)

 S AMHPRBL=$P(AMHSTR,P,14)

 S AMHGAF=$P(AMHSTR,P,15)

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

 D ARRAY^AMHGU(.PP,AMHPP)

 D TP^AMHGETP(.AMHIEN,AMHDM,AMHREC,AMHP,AMHDE,AMHPRG,AMHTD,AMHRD,AMHDC,AMHDP,AMHA5,AMHCA,AMHCD,AMHCS,AMHPRBL,AMHGAF,.PP)

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

 S AMHI=AMHI+1

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

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

PRB(RETVAL,AMHSTR) ;-- save treatment plan problem, called from clsTreatmentPlanDataEntry.SaveProblem

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

 N AMHI,P,R,AMHDM,AMHREC,AMHP,AMHA1,AMHA2,AMHA3,AMHA4,AMHA5,A4,AMHER

 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 AMHP=$P(AMHSTR,P,3)

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

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

 S AMHA3=$P(AMHSTR,P,6)

 S AMHA4=$P(AMHSTR,P,7)

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

 D ARRAY^AMHGU(.A4,AMHA4)

 D A^AMHGETP(AMHREC,AMHA1,6)

 D A^AMHGETP(AMHREC,AMHA2,8)

 D A^AMHGETP(AMHREC,AMHA3,7)

 D AXIS4(AMHDM,AMHREC,.A4)

 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)

DX(RETVAL,AMHSTR) ;-- save treatment plan DX, called from clsTreatmentPlanDataEntry.SaveDx

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

 N AMHI,P,R,AMHDM,AMHREC,AMHP,AMHDX,AMHER

 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 AMHP=$P(AMHSTR,P,3)

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

 D A^AMHGETP(AMHREC,AMHDX,2100)

 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)

AXIS4(D,RC,A4) ;-- file axis 4 data

 N AMHDA,R

 S R="~"

 S AMHDA=0 F  S AMHDA=$O(A4(AMHDA)) Q:'AMHDA  D

 . N STR,PIEN,PCODE,PNARR

 . S STR=$G(A4(AMHDA))

 . S PIEN=$P(STR,R)

 . S PCODE=$P(STR,R,2)

 . S PNARR=$P(STR,R,3)

 . I '$$FNDAXIS4(PIEN,RC) D ADDAXIS4^AMHGETP(PIEN,RC)  Q

 I D="E" D  Q

 . D DELAXIS4^AMHGETP(RC,.A4)

FNDAXIS4(PI,RC) ;-- see if axis 4 exists

 N PDA,MTC

 S MTC=0

 S PDA=0 F  S PDA=$O(^AMHPTXP(RC,9,PDA)) Q:'PDA!($G(MTC))  D

 . I $P(^AMHPTXP(RC,9,PDA,0),U)=PI S MTC=1

 Q $G(MTC)

NARR(RETVAL,AMHSTR) ;save narrative, called from clsTreatmentPlanDataEntry.SaveNarrative method

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

 N AMHI,P,R,AMHDM,AMHREC,AMHP,AMHNARR,AMHER

 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 AMHP=$P(AMHSTR,P,3)

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

 D A^AMHGETP(AMHREC,AMHNARR,1800)

 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)

RD(RETVAL,AMHSTR) ;save review data, called from clsTreatmentPlanDataEntry.SaveReviewData method

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

 N AMHI,P,R,AMHDM,AMHREC,AMHP,AMHRD,AMHRDP,AMHRPS,RD,RDP,RPS,AMHER

 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 AMHP=$P(AMHSTR,P,3)

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

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

 S AMHRPS=$P(AMHSTR,P,6)

 D ARRAY^AMHGU(.RD,AMHRD)

 D ARRAY^AMHGU(.RDP,AMHRDP)

 D ARRAY^AMHGU(.RPS,AMHRPS)

 D RD^AMHGETP(AMHREC,.RD,.RDP,.RPS)

 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)

DEL(RETVAL,AMHSTR) ;-- mark a record as deleted

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

 N AMHI,P,R,AMHDM,AMHREC,AMHER

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

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

 S AMHI=0

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

 K ^AMHTMP($J)

 S AMHREC=$P(AMHSTR,P)

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

 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)

AMHGSTP   ; IHS/CMI/MAW - AMHG Save Treatment Plan 3/7/2009 8:49:18 PM ;

 +1       ;;4.0;IHS BEHAVIORAL HEALTH;**1,4**;JUN 18, 2010;Build 28

 +2       ;

 +3       ;

 +4       ;

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

 +1        DO DEBUG^%Serenji("NARR^AMHGSTP(.RETVAL,.AMHSTR)")

 +2        QUIT

 +3       ;

TP(RETVAL,AMHSTR) ;-- save treatment plan, called from clsTreatmentPlanDataEntry.SaveTreatmentPlan

 +1       ; m error trap

           SET X="MERR^AMHGU"

           SET @^%ZOSF("TRAP")

 +2        NEW AMHI,P,R,AMHDM,AMHREC,AMHP,AMHDE,AMHPRG,AMHTD,AMHRD,AMHDC,AMHDP,AMHCA,AMHCD,AMHCS,AMHPRBL,AMHER,AMHPP,AMHGAF,PP

 +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 AMHP=$PIECE(AMHSTR,P,3)

 +11       SET AMHDE=$PIECE(AMHSTR,P,4)

 +12       SET AMHPRG=$PIECE(AMHSTR,P,5)

 +13       SET AMHPRG=$$SCI^AMHGT(9002011,.02,AMHPRG)

 +14       SET AMHTD=$PIECE(AMHSTR,P,6)

 +15       SET AMHRD=$PIECE(AMHSTR,P,7)

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

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

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

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

 +20       SET AMHCD=$PIECE(AMHSTR,P,12)

 +21       SET AMHCS=$PIECE(AMHSTR,P,13)

 +22       SET AMHPRBL=$PIECE(AMHSTR,P,14)

 +23       SET AMHGAF=$PIECE(AMHSTR,P,15)

 +24       SET AMHPP=$PIECE(AMHSTR,P,16)

 +25       DO ARRAY^AMHGU(.PP,AMHPP)

 +26       DO TP^AMHGETP(.AMHIEN,AMHDM,AMHREC,AMHP,AMHDE,AMHPRG,AMHTD,AMHRD,AMHDC,AMHDP,AMHA5,AMHCA,AMHCD,AMHCS,AMHPRBL,AMHGAF,.PP)

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

 +28       SET AMHI=AMHI+1

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

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

 +31       QUIT

 +32      ;

PRB(RETVAL,AMHSTR) ;-- save treatment plan problem, called from clsTreatmentPlanDataEntry.SaveProblem

 +1       ; m error trap

           SET X="MERR^AMHGU"

           SET @^%ZOSF("TRAP")

 +2        NEW AMHI,P,R,AMHDM,AMHREC,AMHP,AMHA1,AMHA2,AMHA3,AMHA4,AMHA5,A4,AMHER

 +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 AMHP=$PIECE(AMHSTR,P,3)

 +11       SET AMHA1=$PIECE(AMHSTR,P,4)

 +12       SET AMHA2=$PIECE(AMHSTR,P,5)

 +13       SET AMHA3=$PIECE(AMHSTR,P,6)

 +14       SET AMHA4=$PIECE(AMHSTR,P,7)

 +15       SET AMHA5=$PIECE(AMHSTR,P,8)

 +16       DO ARRAY^AMHGU(.A4,AMHA4)

 +17       DO A^AMHGETP(AMHREC,AMHA1,6)

 +18       DO A^AMHGETP(AMHREC,AMHA2,8)

 +19       DO A^AMHGETP(AMHREC,AMHA3,7)

 +20       DO AXIS4(AMHDM,AMHREC,.A4)

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

 +22       SET AMHI=AMHI+1

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

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

 +25       QUIT

 +26      ;

DX(RETVAL,AMHSTR) ;-- save treatment plan DX, called from clsTreatmentPlanDataEntry.SaveDx

 +1       ; m error trap

           SET X="MERR^AMHGU"

           SET @^%ZOSF("TRAP")

 +2        NEW AMHI,P,R,AMHDM,AMHREC,AMHP,AMHDX,AMHER

 +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 AMHP=$PIECE(AMHSTR,P,3)

 +11       SET AMHDX=$PIECE(AMHSTR,P,4)

 +12       DO A^AMHGETP(AMHREC,AMHDX,2100)

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

 +14       SET AMHI=AMHI+1

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

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

 +17       QUIT

 +18      ;

AXIS4(D,RC,A4) ;-- file axis 4 data

 +1        NEW AMHDA,R

 +2        SET R="~"

 +3        SET AMHDA=0

FOR

               SET AMHDA=$ORDER(A4(AMHDA))

               IF 'AMHDA

                   QUIT

               Begin DoDot:1

 +4                NEW STR,PIEN,PCODE,PNARR

 +5                SET STR=$GET(A4(AMHDA))

 +6                SET PIEN=$PIECE(STR,R)

 +7                SET PCODE=$PIECE(STR,R,2)

 +8                SET PNARR=$PIECE(STR,R,3)

 +9                IF '$$FNDAXIS4(PIEN,RC)

                       DO ADDAXIS4^AMHGETP(PIEN,RC)

                       QUIT

               End DoDot:1

 +10       IF D="E"

               Begin DoDot:1

 +11               DO DELAXIS4^AMHGETP(RC,.A4)

               End DoDot:1

               QUIT

 +12       QUIT

 +13      ;

FNDAXIS4(PI,RC) ;-- see if axis 4 exists

 +1        NEW PDA,MTC

 +2        SET MTC=0

 +3        SET PDA=0

FOR

               SET PDA=$ORDER(^AMHPTXP(RC,9,PDA))

               IF 'PDA!($GET(MTC))

                   QUIT

               Begin DoDot:1

 +4                IF $PIECE(^AMHPTXP(RC,9,PDA,0),U)=PI

                       SET MTC=1

               End DoDot:1

 +5        QUIT $GET(MTC)

 +6       ;

NARR(RETVAL,AMHSTR) ;save narrative, called from clsTreatmentPlanDataEntry.SaveNarrative method

 +1       ; m error trap

           SET X="MERR^AMHGU"

           SET @^%ZOSF("TRAP")

 +2        NEW AMHI,P,R,AMHDM,AMHREC,AMHP,AMHNARR,AMHER

 +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 AMHP=$PIECE(AMHSTR,P,3)

 +11       SET AMHNARR=$PIECE(AMHSTR,P,4)

 +12       DO A^AMHGETP(AMHREC,AMHNARR,1800)

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

 +14       SET AMHI=AMHI+1

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

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

 +17       QUIT

 +18      ;

RD(RETVAL,AMHSTR) ;save review data, called from clsTreatmentPlanDataEntry.SaveReviewData method

 +1       ; m error trap

           SET X="MERR^AMHGU"

           SET @^%ZOSF("TRAP")

 +2        NEW AMHI,P,R,AMHDM,AMHREC,AMHP,AMHRD,AMHRDP,AMHRPS,RD,RDP,RPS,AMHER

 +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 AMHP=$PIECE(AMHSTR,P,3)

 +11       SET AMHRD=$PIECE(AMHSTR,P,4)

 +12       SET AMHRDP=$PIECE(AMHSTR,P,5)

 +13       SET AMHRPS=$PIECE(AMHSTR,P,6)

 +14       DO ARRAY^AMHGU(.RD,AMHRD)

 +15       DO ARRAY^AMHGU(.RDP,AMHRDP)

 +16       DO ARRAY^AMHGU(.RPS,AMHRPS)

 +17       DO RD^AMHGETP(AMHREC,.RD,.RDP,.RPS)

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

 +19       SET AMHI=AMHI+1

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

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

 +22       QUIT

 +23      ;

DEL(RETVAL,AMHSTR) ;-- mark a record as deleted

 +1       ; m error trap

           SET X="MERR^AMHGU"

           SET @^%ZOSF("TRAP")

 +2        NEW AMHI,P,R,AMHDM,AMHREC,AMHER

 +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 AMHREC=$PIECE(AMHSTR,P)

 +9        SET DIK="^AMHPTXP("

           SET DA=AMHREC

           DO ^DIK

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

 +11       SET AMHI=AMHI+1

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

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

 +14       QUIT

 +15      ;

AMHGSTP.m