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