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

AMHBHRP2.m

Go to the documentation of this file.
  1. AMHBHRP2 ; IHS/CMI/LAB - behavioral health display for GUI ;
  1. ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
  1. ;
  1. ;
  1. ;
  1. TEST ;
  1. D SUICSTND(.RETVAL,"01/01/1900","12/31/2005","")
  1. Q
  1. SUICSTND(AMHARRAY,AMHBD,AMHED,AMHCOMM) ;EP - AMHBH RPT SUICIDE STANDARD
  1. S JOB=$J,AMHGUI=1,XWBWRAP=1
  1. S ZTIO="",ZTQUEUED=1
  1. S AMHARRAY="^XTMP(""AMHRPT"","_$J_")"
  1. I $G(AMHBD)="" S ^XTMP("AMHRPT",JOB,.5)=2,^XTMP("AMHRPT",JOB,1)="Invalid beginning date passed" D KILL Q
  1. D DT^DILF("X",AMHBD,.AMHBD)
  1. I $G(AMHBD)=-1 S ^XTMP("AMHRPT",JOB,.5)=2,^XTMP("AMHRPT",JOB,1)="Invalid beginning date passed" D KILL Q
  1. I $G(AMHED)="" S ^XTMP("AMHRPT",JOB,.5)=2,^XTMP("AMHRPT",JOB,1)="Invalid ending date passed" D KILL Q
  1. D DT^DILF("X",AMHED,.AMHED)
  1. I $G(AMHED)=-1 S ^XTMP("AMHRPT",JOB,.5)=2,^XTMP("AMHRPT",JOB,1)="Invalid ending date passed" D KILL Q
  1. I $G(AMHCOMM),'$D(^AUTTCOM(AMHCOMM,0)) S ^XTMP("AMHRPT",JOB,.5)=2,^XTMP("AMHRPT",JOB,1)="Invalid IEN of community entry passed" D KILL Q
  1. I AMHCOMM S AMHCOMM(AMHCOMM)=""
  1. I 'AMHCOMM K AMHCOMM
  1. K ^XTMP("AMHRPT",JOB)
  1. S ^XTMP("AMHRPTRUN",JOB)=""
  1. D ^XBKSET
  1. S AMHSD=$$FMADD^XLFDT(AMHBD,-1)_".9999"
  1. D PROC^AMHRPSU1
  1. ;S ZTRTN="TSK^AMHBHRP2",ZTIO="",ZTDESC="AMH SUICIDE STANDARD REPORT",ZTSAVE("AMH*")="",ZTSAVE("JOB")="",ZTDTH=$H D ^%ZTLOAD
  1. ;F I=1:1:120 Q:$G(^XTMP("AMHRPTRUN",$J))="DONE" H 1
  1. ;D KILL
  1. ;Q
  1. ;
  1. TSK ;
  1. D ^XBKSET
  1. S ^XTMP("AMHRPTRUN",JOB)="START"
  1. D GUIR^XBLM("PRINT^AMHRPSU1","^XTMP(""AMHRPT"",JOB)")
  1. S ^XTMP("AMHRPT",JOB,.5)=$O(^XTMP("AMHRPT",JOB,""),-1)+1
  1. S ^XTMP("AMHRPTRUN",JOB)="DONE"
  1. D KILL
  1. Q
  1. ;
  1. KILL ;
  1. K AMHOA,AMHBT,AMHTOT
  1. K AMHCTR,AMHGUI,AMHSF,DIC,JOB,X,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
  1. D EOJ^AMHRPSU1
  1. Q