AMHGDINT ; IHS/CMI/MAW - AMHG Intake Form Data - frmIntake 9/16/2009 10:57:49 AM ;
;;4.0;IHS BEHAVIORAL HEALTH;**1**;JUN 18, 2010;Build 8
;
;
;
DEBUG(RETVAL,AMHSTR) ;-- debug entry point
D DEBUG^%Serenji("EP^AMHGD(RETVAL,.AMHSTR)")
Q
;
INT(RETVAL,AMHSTR) ;-- get intake documents to display on listview
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,P,R,AMHPAT,AMHREC,AMHPRG,AMHINTR,AMHBD,AMHED,AMHIDT
S P="|",R="~"
S AMHPAT=$P(AMHSTR,P)
S AMHPRG=$P(AMHSTR,P,2)
S AMHBD=$P(AMHSTR,P,3)
S AMHED=$P(AMHSTR,P,4)
S AMHPRGI=$$SCI^AMHGT(9002011.13,.05,AMHPRG)
S RETVAL="^AMHTMP("_$J_")"
S AMHI=0
K ^AMHTMP($J)
S @RETVAL@(AMHI)="T00010BMXIEN^T00001Type^T00010AMHREC^T00030DateInitial^T00030Program^T00030ProviderInitial^T00030DateUpdate^T00030ProviderUpdate^T00001Signed^T00010IPIen^T00010UpdIen^T00010InitialIntake^T00030UpdateProgram^"
S @RETVAL@(AMHI)=@RETVAL@(AMHI)_"T00010UserUpdate^T00030DateofLastUpdate"_$C(30)
S AMHRCNT=0,AMHLINE=0
K AMHV
N AMHXI
S AMHXI=0 F S AMHXI=$O(^AMHRINTK("AC",AMHPAT,AMHXI)) Q:AMHXI'=+AMHXI D
.;S AMHINTR=$P(^AMHRINTK(AMHXI,0),U,3)
.;Q:'AMHINTR
.Q:'$$ALLOWINT^AMHLEIV(DUZ,AMHXI)
.I $P(^AMHRINTK(AMHXI,0),U,5)]"" Q:$P(^AMHRINTK(AMHXI,0),U,5)'=AMHPRGI
.Q:$P(^AMHRINTK(AMHXI,0),U,9)'="I" ;only initial intakes
.S AMHIDT=$P($G(^AMHRINTK(AMHXI,0)),U)
.I AMHBD,AMHIDT<AMHBD Q
.I AMHED,AMHIDT>AMHED Q
.S AMHV(9999999-$P(^AMHRINTK(AMHXI,0),U),AMHXI)=""
S D=0,AMHLINE=0,AMHRCNT=0
F S D=$O(AMHV(D)) Q:D'=+D D
.S AMHXI=0 F S AMHXI=$O(AMHV(D,AMHXI)) Q:AMHXI'=+AMHXI D
..N AMHIDT,AMHPRGE,AMHPI,AMHDU,AMHPU,AMHSIG,AMHPIEN,AMHUIEN,AMHUUP,AMHDLUP
..S AMHL=""
..S AMHRCNT=AMHRCNT+1
..S AMHL=AMHRCNT
..S AMHINTR=$P(^AMHRINTK(AMHXI,0),U,3)
..S AMHIDT=$$LVDT^AMHGU($P(^AMHRINTK(AMHXI,0),U))
..S AMHPRGE=$$GET1^DIQ(9002011.13,AMHXI,.05)
..S AMHPI=$$GET1^DIQ(9002011.13,AMHXI,.04)
..S AMHPIEN=$$GET1^DIQ(9002011.13,AMHXI,.04,"I")
..S AMHUIEN=$$GET1^DIQ(9002011.13,AMHXI,.13,"I")
..S AMHUUP=$$GET1^DIQ(9002011.13,AMHXI,.06,"I")
..S AMHDLUP=$$GET1^DIQ(9002011.13,AMHXI,.07,"I")
..S AMHSIG=$S($P($G(^AMHRINTK(AMHXI,0)),U,11):"Y",1:"N")
..;I '$O(^AMHRINTK("AI",AMHXI,0)) D Q
.. S AMHI=AMHI+1
.. S @RETVAL@(AMHI)=AMHXI_U_"I"_U_AMHINTR_U_AMHIDT_U_AMHPRGE_U_AMHPI_U_U_U_AMHSIG_U_AMHPIEN_U_AMHUIEN_U_""_U_""_U_AMHUUP_U_AMHDLUP_$C(30)
..N AMHY
..S AMHY=0 F S AMHY=$O(^AMHRINTK("AI",AMHXI,AMHY)) Q:AMHY'=+AMHY D
...S AMHL=""
...N AMHDU,AMHPU,AMHSIG,AMHPIEN,AMHUIEN,AMHUUP,AMHDLUP
...S AMHINTR=$P(^AMHRINTK(AMHY,0),U,3)
...S AMHDU=$$LVDT^AMHGU($P($P(^AMHRINTK(AMHY,0),U),"."))
...S AMHPU=$$VAL^XBDIQ1(9002011.13,AMHY,.04)
...S AMHSIG=$S($P($G(^AMHRINTK(AMHY,0)),U,11):"Y",1:"N")
...S AMHPIEN=$$GET1^DIQ(9002011.13,AMHY,.04,"I")
...S AMHPRGE=$$GET1^DIQ(9002011.13,AMHY,.05)
...S AMHUIEN=$$GET1^DIQ(9002011.13,AMHY,.13,"I")
...S AMHUUP=$$GET1^DIQ(9002011.13,AMHY,.06,"I")
...S AMHDLUP=$$GET1^DIQ(9002011.13,AMHY,.07,"I")
...S AMHI=AMHI+1
...;S @RETVAL@(AMHI)=AMHXI_U_"U"_U_AMHINTR_U_AMHIDT_U_AMHPRGE_U_AMHPI_U_AMHDU_U_AMHPU_U_AMHSIG_U_AMHPIEN_U_AMHUIEN_$C(30)
...S @RETVAL@(AMHI)=AMHY_U_"U"_U_AMHINTR_U_U_U_U_AMHDU_U_AMHPU_U_AMHSIG_U_AMHPIEN_U_AMHUIEN_U_AMHXI_U_AMHPRGE_U_AMHUUP_U_AMHDLUP_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
UINT(RETVAL,AMHSTR) ;-- get list of update intakes based on initial passed in
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,P,R,AMHIEN
S P="|",R="~"
S AMHIEN=$P(AMHSTR,P)
S AMHPRG=$P(AMHSTR,P,2)
S AMHPRGI=$$SCI^AMHGT(9002011,.02,AMHPRG)
S RETVAL="^AMHTMP("_$J_")"
S AMHI=0
K ^AMHTMP($J)
S @RETVAL@(AMHI)="T00010BMXIEN^T00010AMHREC^T00030DateUpdate^T00030ProviderUpdate^T00030Program^T00001Signed^T00010IPIen^T00010UpdIen"_$C(30)
S AMHRCNT=0,AMHLINE=0
K AMHV
N AMHY,AMHINTR,AMHPIEN,AMHUIEN,AMHSIG,SMHDU,AMHPU
S AMHY=0 F S AMHY=$O(^AMHRINTK("AI",AMHIEN,AMHY)) Q:AMHY'=+AMHY D
.S AMHL=""
.S AMHINTR=$P($G(^AMHRINTK(AMHY,0)),U,3)
.S AMHPIEN=$$GET1^DIQ(9002011.13,AMHY,.04,"I")
.S AMHUIEN=$$GET1^DIQ(9002011.13,AMHY,.06,"I")
.S AMHSIG=$S($P($G(^AMHRINTK(AMHY,0)),U,11):"Y",1:"N")
.S AMHDU=$$LVDT^AMHGU($P($P(^AMHRINTK(AMHY,0),U),"."))
.S AMHPU=$$VAL^XBDIQ1(9002011.13,AMHY,.04)
.S AMHI=AMHI+1
.;S @RETVAL@(AMHI)=AMHXI_U_"U"_U_AMHINTR_U_AMHIDT_U_AMHPRGE_U_AMHPI_U_AMHDU_U_AMHPU_U_AMHSIG_U_AMHPIEN_U_AMHUIEN_$C(30)
.S @RETVAL@(AMHI)=AMHY_U_AMHINTR_U_AMHDU_U_AMHPU_U_AMHPRG_U_AMHSIG_U_AMHPIEN_U_AMHUIEN_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
ASSESS(RETVAL,AMHSTR) ;-- retrieve the assessment for the assessment tab
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,P,R,AMHIEN,AMHVIEN
S P="|",R="~"
S RETVAL="^AMHTMP("_$J_")"
S AMHI=0
K ^AMHTMP($J)
S AMHIEN=$P(AMHSTR,P)
S @RETVAL@(AMHI)="T00250Assessment"_$C(30)
N AMHDA
I $G(AMHIEN) D
. S AMHDA=0 F S AMHDA=$O(^AMHRINTK(AMHIEN,41,AMHDA)) Q:'AMHDA D
.. N AMHDATA
.. S AMHDATA=$G(^AMHRINTK(AMHIEN,41,AMHDA,0))
.. ;I AMHDATA'[$C(10) S AMHDATA=AMHDATA_$C(10) ;cmi/maw 06/16/2010 try removing this and see what happens 11/18/2010
.. S AMHI=AMHI+1
.. S @RETVAL@(AMHI)=AMHDATA_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
AMHGDINT ; IHS/CMI/MAW - AMHG Intake Form Data - frmIntake 9/16/2009 10:57:49 AM ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;**1**;JUN 18, 2010;Build 8
+2 ;
+3 ;
+4 ;
DEBUG(RETVAL,AMHSTR) ;-- debug entry point
+1 DO DEBUG^%Serenji("EP^AMHGD(RETVAL,.AMHSTR)")
+2 QUIT
+3 ;
INT(RETVAL,AMHSTR) ;-- get intake documents to display on listview
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,P,R,AMHPAT,AMHREC,AMHPRG,AMHINTR,AMHBD,AMHED,AMHIDT
+3 SET P="|"
SET R="~"
+4 SET AMHPAT=$PIECE(AMHSTR,P)
+5 SET AMHPRG=$PIECE(AMHSTR,P,2)
+6 SET AMHBD=$PIECE(AMHSTR,P,3)
+7 SET AMHED=$PIECE(AMHSTR,P,4)
+8 SET AMHPRGI=$$SCI^AMHGT(9002011.13,.05,AMHPRG)
+9 SET RETVAL="^AMHTMP("_$JOB_")"
+10 SET AMHI=0
+11 KILL ^AMHTMP($JOB)
+12 SET @RETVAL@(AMHI)="T00010BMXIEN^T00001Type^T00010AMHREC^T00030DateInitial^T00030Program^T00030ProviderInitial^T00030DateUpdate^T00030ProviderUpdate^T00001Signed^T00010IPIen^T00010UpdIen^T00010InitialIntake^T00030UpdateProgram^"
+13 SET @RETVAL@(AMHI)=@RETVAL@(AMHI)_"T00010UserUpdate^T00030DateofLastUpdate"_$CHAR(30)
+14 SET AMHRCNT=0
SET AMHLINE=0
+15 KILL AMHV
+16 NEW AMHXI
+17 SET AMHXI=0
FOR
SET AMHXI=$ORDER(^AMHRINTK("AC",AMHPAT,AMHXI))
IF AMHXI'=+AMHXI
QUIT
Begin DoDot:1
+18 ;S AMHINTR=$P(^AMHRINTK(AMHXI,0),U,3)
+19 ;Q:'AMHINTR
+20 IF '$$ALLOWINT^AMHLEIV(DUZ,AMHXI)
QUIT
+21 IF $PIECE(^AMHRINTK(AMHXI,0),U,5)]""
IF $PIECE(^AMHRINTK(AMHXI,0),U,5)'=AMHPRGI
QUIT
+22 ;only initial intakes
IF $PIECE(^AMHRINTK(AMHXI,0),U,9)'="I"
QUIT
+23 SET AMHIDT=$PIECE($GET(^AMHRINTK(AMHXI,0)),U)
+24 IF AMHBD
IF AMHIDT<AMHBD
QUIT
+25 IF AMHED
IF AMHIDT>AMHED
QUIT
+26 SET AMHV(9999999-$PIECE(^AMHRINTK(AMHXI,0),U),AMHXI)=""
End DoDot:1
+27 SET D=0
SET AMHLINE=0
SET AMHRCNT=0
+28 FOR
SET D=$ORDER(AMHV(D))
IF D'=+D
QUIT
Begin DoDot:1
+29 SET AMHXI=0
FOR
SET AMHXI=$ORDER(AMHV(D,AMHXI))
IF AMHXI'=+AMHXI
QUIT
Begin DoDot:2
+30 NEW AMHIDT,AMHPRGE,AMHPI,AMHDU,AMHPU,AMHSIG,AMHPIEN,AMHUIEN,AMHUUP,AMHDLUP
+31 SET AMHL=""
+32 SET AMHRCNT=AMHRCNT+1
+33 SET AMHL=AMHRCNT
+34 SET AMHINTR=$PIECE(^AMHRINTK(AMHXI,0),U,3)
+35 SET AMHIDT=$$LVDT^AMHGU($PIECE(^AMHRINTK(AMHXI,0),U))
+36 SET AMHPRGE=$$GET1^DIQ(9002011.13,AMHXI,.05)
+37 SET AMHPI=$$GET1^DIQ(9002011.13,AMHXI,.04)
+38 SET AMHPIEN=$$GET1^DIQ(9002011.13,AMHXI,.04,"I")
+39 SET AMHUIEN=$$GET1^DIQ(9002011.13,AMHXI,.13,"I")
+40 SET AMHUUP=$$GET1^DIQ(9002011.13,AMHXI,.06,"I")
+41 SET AMHDLUP=$$GET1^DIQ(9002011.13,AMHXI,.07,"I")
+42 SET AMHSIG=$SELECT($PIECE($GET(^AMHRINTK(AMHXI,0)),U,11):"Y",1:"N")
+43 ;I '$O(^AMHRINTK("AI",AMHXI,0)) D Q
+44 SET AMHI=AMHI+1
+45 SET @RETVAL@(AMHI)=AMHXI_U_"I"_U_AMHINTR_U_AMHIDT_U_AMHPRGE_U_AMHPI_U_U_U_AMHSIG_U_AMHPIEN_U_AMHUIEN_U_""_U_""_U_AMHUUP_U_AMHDLUP_$CHAR(30)
+46 NEW AMHY
+47 SET AMHY=0
FOR
SET AMHY=$ORDER(^AMHRINTK("AI",AMHXI,AMHY))
IF AMHY'=+AMHY
QUIT
Begin DoDot:3
+48 SET AMHL=""
+49 NEW AMHDU,AMHPU,AMHSIG,AMHPIEN,AMHUIEN,AMHUUP,AMHDLUP
+50 SET AMHINTR=$PIECE(^AMHRINTK(AMHY,0),U,3)
+51 SET AMHDU=$$LVDT^AMHGU($PIECE($PIECE(^AMHRINTK(AMHY,0),U),"."))
+52 SET AMHPU=$$VAL^XBDIQ1(9002011.13,AMHY,.04)
+53 SET AMHSIG=$SELECT($PIECE($GET(^AMHRINTK(AMHY,0)),U,11):"Y",1:"N")
+54 SET AMHPIEN=$$GET1^DIQ(9002011.13,AMHY,.04,"I")
+55 SET AMHPRGE=$$GET1^DIQ(9002011.13,AMHY,.05)
+56 SET AMHUIEN=$$GET1^DIQ(9002011.13,AMHY,.13,"I")
+57 SET AMHUUP=$$GET1^DIQ(9002011.13,AMHY,.06,"I")
+58 SET AMHDLUP=$$GET1^DIQ(9002011.13,AMHY,.07,"I")
+59 SET AMHI=AMHI+1
+60 ;S @RETVAL@(AMHI)=AMHXI_U_"U"_U_AMHINTR_U_AMHIDT_U_AMHPRGE_U_AMHPI_U_AMHDU_U_AMHPU_U_AMHSIG_U_AMHPIEN_U_AMHUIEN_$C(30)
+61 SET @RETVAL@(AMHI)=AMHY_U_"U"_U_AMHINTR_U_U_U_U_AMHDU_U_AMHPU_U_AMHSIG_U_AMHPIEN_U_AMHUIEN_U_AMHXI_U_AMHPRGE_U_AMHUUP_U_AMHDLUP_$CHAR(30)
End DoDot:3
End DoDot:2
End DoDot:1
+62 SET @RETVAL@(AMHI+1)=$CHAR(31)
+63 QUIT
+64 ;
UINT(RETVAL,AMHSTR) ;-- get list of update intakes based on initial passed in
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,P,R,AMHIEN
+3 SET P="|"
SET R="~"
+4 SET AMHIEN=$PIECE(AMHSTR,P)
+5 SET AMHPRG=$PIECE(AMHSTR,P,2)
+6 SET AMHPRGI=$$SCI^AMHGT(9002011,.02,AMHPRG)
+7 SET RETVAL="^AMHTMP("_$JOB_")"
+8 SET AMHI=0
+9 KILL ^AMHTMP($JOB)
+10 SET @RETVAL@(AMHI)="T00010BMXIEN^T00010AMHREC^T00030DateUpdate^T00030ProviderUpdate^T00030Program^T00001Signed^T00010IPIen^T00010UpdIen"_$CHAR(30)
+11 SET AMHRCNT=0
SET AMHLINE=0
+12 KILL AMHV
+13 NEW AMHY,AMHINTR,AMHPIEN,AMHUIEN,AMHSIG,SMHDU,AMHPU
+14 SET AMHY=0
FOR
SET AMHY=$ORDER(^AMHRINTK("AI",AMHIEN,AMHY))
IF AMHY'=+AMHY
QUIT
Begin DoDot:1
+15 SET AMHL=""
+16 SET AMHINTR=$PIECE($GET(^AMHRINTK(AMHY,0)),U,3)
+17 SET AMHPIEN=$$GET1^DIQ(9002011.13,AMHY,.04,"I")
+18 SET AMHUIEN=$$GET1^DIQ(9002011.13,AMHY,.06,"I")
+19 SET AMHSIG=$SELECT($PIECE($GET(^AMHRINTK(AMHY,0)),U,11):"Y",1:"N")
+20 SET AMHDU=$$LVDT^AMHGU($PIECE($PIECE(^AMHRINTK(AMHY,0),U),"."))
+21 SET AMHPU=$$VAL^XBDIQ1(9002011.13,AMHY,.04)
+22 SET AMHI=AMHI+1
+23 ;S @RETVAL@(AMHI)=AMHXI_U_"U"_U_AMHINTR_U_AMHIDT_U_AMHPRGE_U_AMHPI_U_AMHDU_U_AMHPU_U_AMHSIG_U_AMHPIEN_U_AMHUIEN_$C(30)
+24 SET @RETVAL@(AMHI)=AMHY_U_AMHINTR_U_AMHDU_U_AMHPU_U_AMHPRG_U_AMHSIG_U_AMHPIEN_U_AMHUIEN_$CHAR(30)
End DoDot:1
+25 SET @RETVAL@(AMHI+1)=$CHAR(31)
+26 QUIT
+27 ;
ASSESS(RETVAL,AMHSTR) ;-- retrieve the assessment for the assessment tab
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,P,R,AMHIEN,AMHVIEN
+3 SET P="|"
SET R="~"
+4 SET RETVAL="^AMHTMP("_$JOB_")"
+5 SET AMHI=0
+6 KILL ^AMHTMP($JOB)
+7 SET AMHIEN=$PIECE(AMHSTR,P)
+8 SET @RETVAL@(AMHI)="T00250Assessment"_$CHAR(30)
+9 NEW AMHDA
+10 IF $GET(AMHIEN)
Begin DoDot:1
+11 SET AMHDA=0
FOR
SET AMHDA=$ORDER(^AMHRINTK(AMHIEN,41,AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:2
+12 NEW AMHDATA
+13 SET AMHDATA=$GET(^AMHRINTK(AMHIEN,41,AMHDA,0))
+14 ;I AMHDATA'[$C(10) S AMHDATA=AMHDATA_$C(10) ;cmi/maw 06/16/2010 try removing this and see what happens 11/18/2010
+15 SET AMHI=AMHI+1
+16 SET @RETVAL@(AMHI)=AMHDATA_$CHAR(30)
End DoDot:2
End DoDot:1
+17 SET @RETVAL@(AMHI+1)=$CHAR(31)
+18 QUIT
+19 ;
