Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AMHGDINT

AMHGDINT.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ;
  1.  ;
  1. DEBUG(RETVAL,AMHSTR) ;-- debug entry point
  1.  D DEBUG^%Serenji("EP^AMHGD(RETVAL,.AMHSTR)")
  1.  Q
  1.  ;
  1. INT(RETVAL,AMHSTR) ;-- get intake documents to display on listview
  1.  S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
  1.  N AMHI,P,R,AMHPAT,AMHREC,AMHPRG,AMHINTR,AMHBD,AMHED,AMHIDT
  1.  S P="|",R="~"
  1.  S AMHPAT=$P(AMHSTR,P)
  1.  S AMHPRG=$P(AMHSTR,P,2)
  1.  S AMHBD=$P(AMHSTR,P,3)
  1.  S AMHED=$P(AMHSTR,P,4)
  1.  S AMHPRGI=$$SCI^AMHGT(9002011.13,.05,AMHPRG)
  1.  S RETVAL="^AMHTMP("_$J_")"
  1.  S AMHI=0
  1.  K ^AMHTMP($J)
  1.  S @RETVAL@(AMHI)="T00010BMXIEN^T00001Type^T00010AMHREC^T00030DateInitial^T00030Program^T00030ProviderInitial^T00030DateUpdate^T00030ProviderUpdate^T00001Signed^T00010IPIen^T00010UpdIen^T00010InitialIntake^T00030UpdateProgram^"
  1.  S @RETVAL@(AMHI)=@RETVAL@(AMHI)_"T00010UserUpdate^T00030DateofLastUpdate"_$C(30)
  1.  S AMHRCNT=0,AMHLINE=0
  1.  K AMHV
  1.  N AMHXI
  1.  S AMHXI=0 F  S AMHXI=$O(^AMHRINTK("AC",AMHPAT,AMHXI)) Q:AMHXI'=+AMHXI  D
  1.  .;S AMHINTR=$P(^AMHRINTK(AMHXI,0),U,3)
  1.  .;Q:'AMHINTR
  1.  .Q:'$$ALLOWINT^AMHLEIV(DUZ,AMHXI)
  1.  .I $P(^AMHRINTK(AMHXI,0),U,5)]"" Q:$P(^AMHRINTK(AMHXI,0),U,5)'=AMHPRGI
  1.  .Q:$P(^AMHRINTK(AMHXI,0),U,9)'="I"  ;only initial intakes
  1.  .S AMHIDT=$P($G(^AMHRINTK(AMHXI,0)),U)
  1.  .I AMHBD,AMHIDT<AMHBD Q
  1.  .I AMHED,AMHIDT>AMHED Q
  1.  .S AMHV(9999999-$P(^AMHRINTK(AMHXI,0),U),AMHXI)=""
  1.  S D=0,AMHLINE=0,AMHRCNT=0
  1.  F  S D=$O(AMHV(D)) Q:D'=+D  D
  1.  .S AMHXI=0 F  S AMHXI=$O(AMHV(D,AMHXI)) Q:AMHXI'=+AMHXI  D
  1.  ..N AMHIDT,AMHPRGE,AMHPI,AMHDU,AMHPU,AMHSIG,AMHPIEN,AMHUIEN,AMHUUP,AMHDLUP
  1.  ..S AMHL=""
  1.  ..S AMHRCNT=AMHRCNT+1
  1.  ..S AMHL=AMHRCNT
  1.  ..S AMHINTR=$P(^AMHRINTK(AMHXI,0),U,3)
  1.  ..S AMHIDT=$$LVDT^AMHGU($P(^AMHRINTK(AMHXI,0),U))
  1.  ..S AMHPRGE=$$GET1^DIQ(9002011.13,AMHXI,.05)
  1.  ..S AMHPI=$$GET1^DIQ(9002011.13,AMHXI,.04)
  1.  ..S AMHPIEN=$$GET1^DIQ(9002011.13,AMHXI,.04,"I")
  1.  ..S AMHUIEN=$$GET1^DIQ(9002011.13,AMHXI,.13,"I")
  1.  ..S AMHUUP=$$GET1^DIQ(9002011.13,AMHXI,.06,"I")
  1.  ..S AMHDLUP=$$GET1^DIQ(9002011.13,AMHXI,.07,"I")
  1.  ..S AMHSIG=$S($P($G(^AMHRINTK(AMHXI,0)),U,11):"Y",1:"N")
  1.  ..;I '$O(^AMHRINTK("AI",AMHXI,0)) D  Q
  1.  .. S AMHI=AMHI+1
  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)
  1.  ..N AMHY
  1.  ..S AMHY=0 F  S AMHY=$O(^AMHRINTK("AI",AMHXI,AMHY)) Q:AMHY'=+AMHY  D
  1.  ...S AMHL=""
  1.  ...N AMHDU,AMHPU,AMHSIG,AMHPIEN,AMHUIEN,AMHUUP,AMHDLUP
  1.  ...S AMHINTR=$P(^AMHRINTK(AMHY,0),U,3)
  1.  ...S AMHDU=$$LVDT^AMHGU($P($P(^AMHRINTK(AMHY,0),U),"."))
  1.  ...S AMHPU=$$VAL^XBDIQ1(9002011.13,AMHY,.04)
  1.  ...S AMHSIG=$S($P($G(^AMHRINTK(AMHY,0)),U,11):"Y",1:"N")
  1.  ...S AMHPIEN=$$GET1^DIQ(9002011.13,AMHY,.04,"I")
  1.  ...S AMHPRGE=$$GET1^DIQ(9002011.13,AMHY,.05)
  1.  ...S AMHUIEN=$$GET1^DIQ(9002011.13,AMHY,.13,"I")
  1.  ...S AMHUUP=$$GET1^DIQ(9002011.13,AMHY,.06,"I")
  1.  ...S AMHDLUP=$$GET1^DIQ(9002011.13,AMHY,.07,"I")
  1.  ...S AMHI=AMHI+1
  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)
  1.  ...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)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. UINT(RETVAL,AMHSTR) ;-- get list of update intakes based on initial passed in
  1.  S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
  1.  N AMHI,P,R,AMHIEN
  1.  S P="|",R="~"
  1.  S AMHIEN=$P(AMHSTR,P)
  1.  S AMHPRG=$P(AMHSTR,P,2)
  1.  S AMHPRGI=$$SCI^AMHGT(9002011,.02,AMHPRG)
  1.  S RETVAL="^AMHTMP("_$J_")"
  1.  S AMHI=0
  1.  K ^AMHTMP($J)
  1.  S @RETVAL@(AMHI)="T00010BMXIEN^T00010AMHREC^T00030DateUpdate^T00030ProviderUpdate^T00030Program^T00001Signed^T00010IPIen^T00010UpdIen"_$C(30)
  1.  S AMHRCNT=0,AMHLINE=0
  1.  K AMHV
  1.  N AMHY,AMHINTR,AMHPIEN,AMHUIEN,AMHSIG,SMHDU,AMHPU
  1.  S AMHY=0 F  S AMHY=$O(^AMHRINTK("AI",AMHIEN,AMHY)) Q:AMHY'=+AMHY  D
  1.  .S AMHL=""
  1.  .S AMHINTR=$P($G(^AMHRINTK(AMHY,0)),U,3)
  1.  .S AMHPIEN=$$GET1^DIQ(9002011.13,AMHY,.04,"I")
  1.  .S AMHUIEN=$$GET1^DIQ(9002011.13,AMHY,.06,"I")
  1.  .S AMHSIG=$S($P($G(^AMHRINTK(AMHY,0)),U,11):"Y",1:"N")
  1.  .S AMHDU=$$LVDT^AMHGU($P($P(^AMHRINTK(AMHY,0),U),"."))
  1.  .S AMHPU=$$VAL^XBDIQ1(9002011.13,AMHY,.04)
  1.  .S AMHI=AMHI+1
  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)
  1.  .S @RETVAL@(AMHI)=AMHY_U_AMHINTR_U_AMHDU_U_AMHPU_U_AMHPRG_U_AMHSIG_U_AMHPIEN_U_AMHUIEN_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. ASSESS(RETVAL,AMHSTR) ;-- retrieve the assessment for the assessment tab
  1.  S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
  1.  N AMHI,P,R,AMHIEN,AMHVIEN
  1.  S P="|",R="~"
  1.  S RETVAL="^AMHTMP("_$J_")"
  1.  S AMHI=0
  1.  K ^AMHTMP($J)
  1.  S AMHIEN=$P(AMHSTR,P)
  1.  S @RETVAL@(AMHI)="T00250Assessment"_$C(30)
  1.  N AMHDA
  1.  I $G(AMHIEN) D
  1.  . S AMHDA=0 F  S AMHDA=$O(^AMHRINTK(AMHIEN,41,AMHDA)) Q:'AMHDA  D
  1.  .. N AMHDATA
  1.  .. S AMHDATA=$G(^AMHRINTK(AMHIEN,41,AMHDA,0))
  1.  .. ;I AMHDATA'[$C(10) S AMHDATA=AMHDATA_$C(10)  ;cmi/maw 06/16/2010 try removing this and see what happens 11/18/2010
  1.  .. S AMHI=AMHI+1
  1.  .. S @RETVAL@(AMHI)=AMHDATA_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;