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

AMHGD.m

Go to the documentation of this file. 
  1. AMHGD ; IHS/CMI/MAW - AMHG Get Data for GUI Front End 11/25/2008 9:38:11 AM ; 26 Jun 2017  3:55 PM
  1.  ;;4.0;IHS BEHAVIORAL HEALTH;**1,4,8**;JUN 02, 2010;Build 7
  1.  ;
  1.  ;
  1.  ;
  1. DEBUG(RETVAL,AMHSTR) ;-- debug entry point
  1.  D DEBUG^%Serenji("ADML^AMHGD(.RETVAL,.AMHSTR)")
  1.  Q
  1.  ;
  1. VISITL(RETVAL,AMHSTR) ;-- get visit list for record selector screen
  1.  S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
  1.  N AMHI,AMHP,AMHE,AMHB,P,AMHIVB,AMHIVE,AMHDA,AMHIEN
  1.  S P="|"
  1.  S RETVAL="^AMHTMP("_$J_")"
  1.  S AMHI=0
  1.  K ^AMHTMP($J)
  1.  S @RETVAL@(AMHI)="T00010BMXIEN^T00030SortDate^T00030Date^T00050POV^T00020Axis V^T00020Clinic^T00020Activity^T00020Visit Type^T00020Contact Type^T00030Provider^T00001Signed^T00001EHR^T00001DeleteIntakes^T00030LocationofEncounter"
  1.  S @RETVAL@(AMHI)=@RETVAL@(AMHI)_"^T00001Group"_U_"T00080Program"_$C(30)
  1.  S AMHB=$P(AMHSTR,P)
  1.  S AMHE=$P(AMHSTR,P,2)
  1.  S AMHP=$P(AMHSTR,P,3)
  1.  S AMHIVB=(9999999-AMHB)+.9999
  1.  S AMHIVE=(9999999-AMHE)-.0001
  1.  S AMHDA=AMHIVE F  S AMHDA=$O(^AMHREC("AE",AMHP,AMHDA)) Q:'AMHDA!(AMHDA>AMHIVB)  D
  1.  . S AMHIEN=0 F  S AMHIEN=$O(^AMHREC("AE",AMHP,AMHDA,AMHIEN)) Q:'AMHIEN  D
  1.  .. N AMHD0,AHMD11,AMHD14,AHMD15,AHMD16,AMHD17,AMHD21,AMHESIG,AMHPOVE,AMHIDEL,AMHLOC,AMHGRP
  1.  .. N AMHDT,AMHPOV,AMHAXV,AMHCLN,AMHACT,AMHVT,AMHCT,AMHPRV,AMHPOVI,AMHPRVI,AMHACTI,AMHEHR
  1.  .. N AMHPRVM,AMHPROG
  1.  .. S AMHPRVM=0
  1.  .. Q:'$$ALLOWVI^AMHUTIL(DUZ,AMHIEN)  ;screen on user and visit
  1.  .. S AMHD0=$G(^AMHREC(AMHIEN,0))
  1.  .. S AMHDT=$P($$GET1^DIQ(9002011,AMHIEN,.01,"I"),".")
  1.  .. S AMHPOVI=$O(^AMHRPRO("AD",AMHIEN,0))
  1.  .. S AMHPOV=$S($G(AMHPOVI):$$GET1^DIQ(9002011.01,AMHPOVI,.01,"I"),1:"")
  1.  .. S AMHPOVE=$S($G(AMHPOVI):$$GET1^DIQ(9002011.01,AMHPOVI,.04),1:"")
  1.  .. I $G(AMHPOVE)="" S AMHPOVE=$S($G(AMHPOV):$$GET1^DIQ(9002012.2,AMHPOV,.02),1:"")
  1.  .. S AMHAXV=$$GET1^DIQ(9002011,AMHIEN,.14)
  1.  .. S AMHCLN=$$GET1^DIQ(9002011,AMHIEN,.25)
  1.  .. S AMHACTI=$$GET1^DIQ(9002011,AMHIEN,.06,"I")
  1.  .. S AMHACT=$S($G(AMHACTI):$$GET1^DIQ(9002012,AMHACTI,.02),1:"")
  1.  .. S AMHVT=$$GET1^DIQ(9002011,AMHIEN,.33)
  1.  .. S AMHCT=$$GET1^DIQ(9002011,AMHIEN,.07)
  1.  .. S AMHPRVI=$$GETPRV^AMHGU(AMHIEN,"P")
  1.  .. S AMHPRV=$S($G(AMHPRVI):$$GET1^DIQ(200,AMHPRVI,.01),1:"")
  1.  .. S AMHESIG=$S('$$GET1^DIQ(9002011,AMHIEN,1112,"I"):"*",1:"")
  1.  .. S AMHEHR=$$GET1^DIQ(9002011,AMHIEN,1110,"I")
  1.  .. I $G(AMHEHR) S AMHESIG=""  ;cmi/maw pr580/581
  1.  .. S AMHIDEL=$$IINTAKE^AMHLEDEL(AMHIEN)
  1.  .. S AMHLOC=$$GET1^DIQ(9002011,AMHIEN,.04)
  1.  .. S AMHGRP=$$GET1^DIQ(9002011,AMHIEN,.34,"I")
  1.  .. S AMHPROG=$$GET1^DIQ(9002011,AMHIEN,.02)
  1.  .. S AMHI=AMHI+1
  1.  .. S @RETVAL@(AMHI)=AMHIEN_U_AMHDT_U_$$LVDT^AMHGU(AMHDT)_U_AMHPOVE_U_AMHAXV_U_AMHCLN_U_AMHACT_U_AMHVT_U_AMHCT_U_AMHPRV_U_AMHESIG_U_AMHEHR_U_AMHIDEL_U_AMHLOC_U_AMHGRP_U_AMHPROG_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. VISITAP(RETVAL,AMHSTR) ;-- get visit list for record selector screen all patients
  1.  S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
  1.  N AMHI,AMHP,AMHE,AMHB,P,AMHIVB,AMHIVE,AMHDA,R,AMHIEN
  1.  S P="|",R="~"
  1.  S RETVAL="^AMHTMP("_$J_")"
  1.  S AMHI=0
  1.  K ^AMHTMP($J)
  1.  S @RETVAL@(AMHI)="T00010BMXIEN^T00030SortDate^T00030Date^T00040Patient^T00010Chart^T00001Sex^T00030DOB^T00050POV^T00020Axis V^T00020Clinic^T00020Activity^T00020Visit Type^T00020Contact Type^T00030Provider^T00001Signed^T00001EHR"
  1.  S @RETVAL@(AMHI)=@RETVAL@(AMHI)_"^T00001DeleteIntakes^T00030LocationofEncounter^T00001Group^T00001Spt^T02500Message^T00080Program"_$C(30)
  1.  S AMHB=$P(AMHSTR,P)
  1.  S AMHE=$P(AMHSTR,P,2)
  1.  S AMHP=$P(AMHSTR,P,3)
  1.  S AMHIVB=(9999999-AMHB)+.0001
  1.  S AMHIVE=(9999999-AMHE)-.9999
  1.  S AMHDA=AMHIVE F  S AMHDA=$O(^AMHREC("AB",AMHDA)) Q:'AMHDA!(AMHDA>AMHIVB)  D
  1.  . S AMHIEN=0 F  S AMHIEN=$O(^AMHREC("AB",AMHDA,AMHIEN)) Q:'AMHIEN  D
  1.  .. N AMHD0,AHMD11,AMHD14,AHMD15,AHMD16,AMHD17,AMHD21,AMHPIEN,AMHPAT,AMHCHT,AMHDOB,AMHSEX,AMHPOVE,AMHLOC,AMHLOCI,AMHLOCA
  1.  .. N AMHDT,AMHPOV,AMHAXV,AMHCLN,AMHACT,AMHVT,AMHCT,AMHPRV,AMHPOVI,AMHPRVI,AMHACTI,AMHESIG,AMHEHR,AMHIDEL,AMHNCHT,AMHGRP
  1.  .. N AMHPRVM,AMHSPT,AMHMSG,AMHPROG
  1.  .. S AMHPRVM=0
  1.  .. Q:'$$ALLOWVI^AMHUTIL(DUZ,AMHIEN)  ;screen on user and visit
  1.  .. S AMHD0=$G(^AMHREC(AMHIEN,0))
  1.  .. S AMHPIEN=$P(AMHD0,U,8)
  1.  .. Q:'AMHPIEN
  1.  .. S AMHPAT=$$GET1^DIQ(2,AMHPIEN,.01)
  1.  .. S AMHCHT=$$HRN^AUPNPAT(AMHPIEN,DUZ(2))
  1.  .. S AMHDOB=$$GET1^DIQ(2,AMHPIEN,.03,"I")
  1.  .. S AMHDOB=$$LVDT^AMHGU(AMHDOB)
  1.  .. S AMHSEX=$$GET1^DIQ(2,AMHPIEN,.02,"I")
  1.  .. S AMHDT=$P($$GET1^DIQ(9002011,AMHIEN,.01,"I"),".")
  1.  .. S AMHPOVI=$O(^AMHRPRO("AD",AMHIEN,0))
  1.  .. S AMHPOV=$S($G(AMHPOVI):$$GET1^DIQ(9002011.01,AMHPOVI,.01,"I"),1:"")
  1.  .. S AMHPOVE=$S($G(AMHPOVI):$$GET1^DIQ(9002011.01,AMHPOVI,.04),1:"")
  1.  .. I $G(AMHPOVE)="" S AMHPOVE=$S($G(AMHPOV):$$GET1^DIQ(9002012.2,AMHPOV,.02),1:"")
  1.  .. S AMHAXV=$$GET1^DIQ(9002011,AMHIEN,.14)
  1.  .. S AMHCLN=$$GET1^DIQ(9002011,AMHIEN,.25)
  1.  .. S AMHACTI=$$GET1^DIQ(9002011,AMHIEN,.06,"I")
  1.  .. S AMHACT=$S($G(AMHACTI):$$GET1^DIQ(9002012,AMHACTI,.02),1:"")
  1.  .. S AMHVT=$$GET1^DIQ(9002011,AMHIEN,.33)
  1.  .. S AMHCT=$$GET1^DIQ(9002011,AMHIEN,.07)
  1.  .. S AMHPRVI=$$GETPRV^AMHGU(AMHIEN,"P")
  1.  .. S AMHPRV=$S($G(AMHPRVI):$$GET1^DIQ(200,AMHPRVI,.01),1:"")
  1.  .. S AMHESIG=$S('$$GET1^DIQ(9002011,AMHIEN,1112,"I"):"*",1:"")
  1.  .. S AMHEHR=$$GET1^DIQ(9002011,AMHIEN,1110,"I")
  1.  .. I $G(AMHEHR) S AMHESIG=""  ;cmi/maw pr580/581
  1.  .. S AMHIDEL=$$IINTAKE^AMHLEDEL(AMHIEN)
  1.  .. S AMHLOC=$$GET1^DIQ(9002011,AMHIEN,.04)
  1.  .. S AMHLOCI=$$GET1^DIQ(9002011,AMHIEN,.04,"I")
  1.  .. S AMHLOCA=$S(AMHLOCI:$$GET1^DIQ(9999999.06,AMHLOCI,.08),1:"")
  1.  .. S AMHGRP=$$GET1^DIQ(9002011,AMHIEN,.34,"I")
  1.  .. S AMHNCHT=AMHLOCA_$$HRN^AUPNPAT(AMHPIEN,AMHLOCI)
  1.  .. S AMHSPT=$$SPT^AMHGDA(AMHPIEN)
  1.  .. S AMHPROG=$$GET1^DIQ(9002011,AMHIEN,.02)
  1.  .. I $G(AMHSPT) D
  1.  ... S AMHDOB="**SENSITIVE**"
  1.  ... S AMHMSG=$G(AMHDGMSG)
  1.  .. S AMHI=AMHI+1
  1.  .. S @RETVAL@(AMHI)=AMHIEN_U_AMHDT_U_$$LVDT^AMHGU(AMHDT)_U_AMHPIEN_R_AMHPAT_U_AMHNCHT_U_AMHSEX_U_AMHDOB_U_AMHPOVE_U_AMHAXV_U_AMHCLN_U_AMHACT_U_AMHVT_U_AMHCT_U_AMHPRV_U_AMHESIG_U_AMHEHR_U_AMHIDEL_U_AMHLOC_U_AMHGRP_U_$G(AMHSPT)
  1.  .. S @RETVAL@(AMHI)=@RETVAL@(AMHI)_U_$G(AMHMSG)_U_AMHPROG_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. CML(RETVAL,AMHSTR) ;-- get case management list for record selector screen
  1.  S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
  1.  N AMHI,AMHP,AMHE,AMHB,P,AMHIVB,AMHIVE,AMHDA,AMHIEN
  1.  S P="|",R="~"
  1.  S RETVAL="^AMHTMP("_$J_")"
  1.  S AMHI=0
  1.  K ^AMHTMP($J)
  1.  S @RETVAL@(AMHI)="T00010BMXIEN^T00030SortDate^T00030OpenDate^T00030AdmitDate^T00030ClosedDate^T00050Disposition^T00030Program^T00030Provider"_$C(30)
  1.  S AMHB=$P(AMHSTR,P)
  1.  S AMHE=$P(AMHSTR,P,2)
  1.  S AMHP=$P(AMHSTR,P,3)
  1.  S AMHIVB=(9999999-AMHB)+.0001
  1.  S AMHIVE=(9999999-AMHE)-.9999
  1.  S AMHDA=AMHIVE F  S AMHDA=$O(^AMHPCASE("AA",AMHP,AMHDA)) Q:'AMHDA!(AMHDA>AMHIVB)  D
  1.  . S AMHIEN=0 F  S AMHIEN=$O(^AMHPCASE("AA",AMHP,AMHDA,AMHIEN)) Q:'AMHIEN  D
  1.  .. N AMHCO,AMHCA,AMHCC,AMHDSPI,AMHDSP,AMHDSPS,AMHPRGI,AMHPRG,AMHPRGS,AMHPRVI,AMHPRV,AMHPRVS
  1.  .. Q:'$$ALLOWCD^AMHLCD(DUZ,AMHIEN)  ;screen on duz and case
  1.  .. S AMHCO=$$GET1^DIQ(9002011.58,AMHIEN,.01,"I")
  1.  .. S AMHCA=$$GET1^DIQ(9002011.58,AMHIEN,.04,"I")
  1.  .. S AMHCC=$$GET1^DIQ(9002011.58,AMHIEN,.05,"I")
  1.  .. S AMHDSPI=$$GET1^DIQ(9002011.58,AMHIEN,.06,"I")
  1.  .. S AMHDSP=$$GET1^DIQ(9002011.58,AMHIEN,.06)
  1.  .. I AMHDSPI S AMHDSPS=AMHDSPI_R_AMHDSP
  1.  .. S AMHPRGI=$$GET1^DIQ(9002011.58,AMHIEN,.03,"I")
  1.  .. S AMHPRG=$$GET1^DIQ(9002011.58,AMHIEN,.03)
  1.  .. I AMHPRGI]"" S AMHPRGS=AMHPRGI_R_AMHPRG
  1.  .. S AMHPRVI=$$GET1^DIQ(9002011.58,AMHIEN,.08,"I")
  1.  .. S AMHPRV=$$GET1^DIQ(9002011.58,AMHIEN,.08)
  1.  .. I AMHPRVI S AMHPRVS=AMHPRVI_R_AMHPRV
  1.  .. S AMHI=AMHI+1
  1.  .. S @RETVAL@(AMHI)=AMHIEN_U_AMHCO_U_$$LVDT^AMHGU(AMHCO)_U_$$LVDT^AMHGU(AMHCA)_U_$$LVDT^AMHGU(AMHCC)_U_$G(AMHDSPS)_U_$G(AMHPRGS)_U_$G(AMHPRVS)_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. TPL(RETVAL,AMHSTR) ;-- get treatment plans for record selector screen
  1.  S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
  1.  N AMHI,AMHP,AMHE,AMHB,P,AMHIVB,AMHIVE,AMHDA,AMHIEN
  1.  S P="|",R="~"
  1.  S RETVAL="^AMHTMP("_$J_")"
  1.  S AMHI=0
  1.  K ^AMHTMP($J)
  1.  S @RETVAL@(AMHI)="T00010BMXIEN^T00030SortDate^T00030DateEstablished^T00030Program^T00030Status^T00080Problem^T00030Provider^T00030ReviewDate^T00010Reviews"_$C(30)
  1.  S AMHB=$P(AMHSTR,P)
  1.  S AMHE=$P(AMHSTR,P,2)
  1.  S AMHP=$P(AMHSTR,P,3)
  1.  S AMHIVB=(9999999-AMHB)+.0001
  1.  S AMHIVE=(9999999-AMHE)-.9999
  1.  S AMHDA=AMHIVE F  S AMHDA=$O(^AMHPTXP("AA",AMHP,AMHDA)) Q:'AMHDA!(AMHDA>AMHIVB)  D
  1.  . S AMHIEN=0 F  S AMHIEN=$O(^AMHPTXP("AA",AMHP,AMHDA,AMHIEN)) Q:'AMHIEN  D
  1.  .. N AMHDE,AMHPRG,AMHST,AMHPRB,AMHPRV,AMHRD
  1.  .. N AMHPRVM,AMHRCNT
  1.  .. S AMHPRVM=0
  1.  .. Q:'$$ALLOWTP^AMHLETP(DUZ,AMHIEN)  ;screen on user and treatment plan
  1.  .. S AMHDE=$$GET1^DIQ(9002011.56,AMHIEN,.01,"I")
  1.  .. S AMHPRG=$$GET1^DIQ(9002011.56,AMHIEN,.17)
  1.  .. S AMHST=$$GET1^DIQ(9002011.56,AMHIEN,.15)
  1.  .. S AMHPRB=$$GET1^DIQ(9002011.56,AMHIEN,1101)
  1.  .. I AMHPRB="" S AMHPRB=$G(^AMHPTXP(AMHIEN,21,1,0))  ;v4.0p4 display the dx if no problem
  1.  .. S AMHPRV=$$GET1^DIQ(9002011.56,AMHIEN,.04)
  1.  .. S AMHRD=$$GET1^DIQ(9002011.56,AMHIEN,.09,"I")
  1.  .. S AMHRCNT=+$P($G(^AMHPTXP(AMHIEN,41,0)),U,4)
  1.  .. S AMHI=AMHI+1
  1.  .. S @RETVAL@(AMHI)=AMHIEN_U_AMHDE_U_$$LVDT^AMHGU(AMHDE)_U_AMHPRG_U_AMHST_U_AMHPRB_U_AMHPRV_U_$$LVDT^AMHGU(AMHRD)_U_AMHRCNT_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. TPLAP(RETVAL,AMHSTR) ;-- get treatment plans for record selector screen all patients
  1.  S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
  1.  N AMHI,AMHP,AMHE,AMHB,P,AMHIVB,AMHIVE,AMHDA,AMHIEN
  1.  S P="|",R="~"
  1.  S RETVAL="^AMHTMP("_$J_")"
  1.  S AMHI=0
  1.  K ^AMHTMP($J)
  1.  S @RETVAL@(AMHI)="T00010BMXIEN^T00030SortDate^T00030DateEstablished^T00040Patient^T00010Chart^T00001Sex^T00030DOB^T00030Program^T00030Status^T00080Problem^T00030Provider^T00030ReviewDate^T00010Reviews^T00001Spt^T02500Message"_$C(30)
  1.  S AMHB=$P(AMHSTR,P)
  1.  S AMHE=$P(AMHSTR,P,2)
  1.  S AMHP=$P(AMHSTR,P,3)
  1.  S AMHIVB=(9999999-AMHB)+.0001
  1.  S AMHIVE=(9999999-AMHE)-.9999
  1.  S AMHDA=AMHIVE F  S AMHDA=$O(^AMHPTXP("AB",AMHDA)) Q:'AMHDA!(AMHDA>AMHIVB)  D
  1.  . S AMHIEN=0 F  S AMHIEN=$O(^AMHPTXP("AB",AMHDA,AMHIEN)) Q:'AMHIEN  D
  1.  .. N AMHDE,AMHPRG,AMHST,AMHPRB,AMHPRV,AMHRD,AMHPIEN,AMHPAT,AMHDOB,AMHSEX,AMHCHT
  1.  .. N AMHPRVM,AMHSPT,AMHMSG
  1.  .. S AMHPRVM=0
  1.  .. Q:'$$ALLOWTP^AMHLETP(DUZ,AMHIEN)  ;screen on user and treatment plan
  1.  .. S AMHPIEN=$$GET1^DIQ(9002011.56,AMHIEN,.02,"I")
  1.  .. Q:'AMHPIEN
  1.  .. S AMHPAT=$$GET1^DIQ(2,AMHPIEN,.01)
  1.  .. S AMHCHT=$$HRN^AUPNPAT(AMHPIEN,DUZ(2))
  1.  .. S AMHDOB=$$GET1^DIQ(2,AMHPIEN,.03,"I")
  1.  .. S AMHDOB=$$LVDT^AMHGU(AMHDOB)
  1.  .. S AMHSEX=$$GET1^DIQ(2,AMHPIEN,.02,"I")
  1.  .. S AMHDE=$$GET1^DIQ(9002011.56,AMHIEN,.01,"I")
  1.  .. S AMHPRG=$$GET1^DIQ(9002011.56,AMHIEN,.17)
  1.  .. S AMHST=$$GET1^DIQ(9002011.56,AMHIEN,.15)
  1.  .. S AMHPRB=$$GET1^DIQ(9002011.56,AMHIEN,1101)
  1.  .. I AMHPRB="" S AMHPRB=$G(^AMHPTXP(AMHIEN,21,1,0))  ;v4.0p4 display the dx if no problem
  1.  .. S AMHPRV=$$GET1^DIQ(9002011.56,AMHIEN,.04)
  1.  .. S AMHRD=$$GET1^DIQ(9002011.56,AMHIEN,.09,"I")
  1.  .. S AMHRCNT=+$P($G(^AMHPTXP(AMHIEN,41,0)),U,4)
  1.  .. S AMHSPT=$$SPT^AMHGDA(AMHPIEN)
  1.  .. I $G(AMHSPT) D
  1.  ... S AMHDOB="**SENSITIVE**"
  1.  ... S AMHMSG=$G(AMHDGMSG)
  1.  .. S AMHI=AMHI+1
  1.  .. S @RETVAL@(AMHI)=AMHIEN_U_AMHDE_U_$$LVDT^AMHGU(AMHDE)_U_AMHPIEN_R_AMHPAT_U_AMHCHT_U_AMHSEX_U_AMHDOB_U_AMHPRG_U_AMHST_U_AMHPRB_U_AMHPRV_U_$$LVDT^AMHGU(AMHRD)_U_AMHRCNT_U_+$G(AMHSPT)_U_$G(AMHMSG)_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. SFL(RETVAL,AMHSTR) ;-- get suicide forms for record selector screen
  1.  S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
  1.  N AMHI,AMHP,AMHE,AMHB,P,AMHIVB,AMHIVE,AMHDA,AMHIEN
  1.  S P="|",R="~"
  1.  S RETVAL="^AMHTMP("_$J_")"
  1.  S AMHI=0
  1.  K ^AMHTMP($J)
  1.  S @RETVAL@(AMHI)="T00010BMXIEN^T00030SortDate^T00030Date^T00030LocalCaseNumber^T00030Provider^T00080SuicidalBehavior^T00001Incomplete"_$C(30)
  1.  S AMHB=$P(AMHSTR,P)
  1.  S AMHE=$P(AMHSTR,P,2)
  1.  S AMHP=$P(AMHSTR,P,3)
  1.  S AMHIVB=(9999999-AMHB)+.0001
  1.  S AMHIVE=(9999999-AMHE)-.9999
  1.  S AMHDA=AMHIVE F  S AMHDA=$O(^AMHPSUIC("AA",AMHP,AMHDA)) Q:'AMHDA!(AMHDA>AMHIVB)  D
  1.  . S AMHIEN=0 F  S AMHIEN=$O(^AMHPSUIC("AA",AMHP,AMHDA,AMHIEN)) Q:'AMHIEN  D
  1.  .. N AMHPRVM
  1.  .. S AMHPRVM=0
  1.  .. Q:'$$ALLOW^AMHSFR(DUZ,AMHIEN)  ;screen on user and suicide form
  1.  .. N AMHD,AMHLCN,AMHPRV,AMHSB,AMHINC
  1.  .. S AMHINC=$S($$INCOMPSF^AMHLESF(AMHIEN):"I",1:"")  ;v4.0 p1
  1.  .. S AMHD=$$GET1^DIQ(9002011.65,AMHIEN,.06,"I")
  1.  .. S AMHLCN=$$GET1^DIQ(9002011.65,AMHIEN,.02)
  1.  .. S AMHPRV=$$GET1^DIQ(9002011.65,AMHIEN,.03)
  1.  .. S AMHSB=$$GET1^DIQ(9002011.65,AMHIEN,.13)
  1.  .. S AMHI=AMHI+1
  1.  .. S @RETVAL@(AMHI)=AMHIEN_U_AMHD_U_$$LVDT^AMHGU(AMHD)_U_AMHLCN_U_AMHPRV_U_AMHSB_U_AMHINC_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. SFLAP(RETVAL,AMHSTR) ;-- get suicide forms for record selector screen all patients
  1.  S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
  1.  N AMHI,AMHP,AMHE,AMHB,P,AMHIVB,AMHIVE,AMHDA,AMHIEN
  1.  S P="|",R="~"
  1.  S RETVAL="^AMHTMP("_$J_")"
  1.  S AMHI=0
  1.  K ^AMHTMP($J)
  1.  S @RETVAL@(AMHI)="T00010BMXIEN^T00030SortDate^T00030Date^T00040Patient^T00010Chart^T00001Sex^T00030DOB^T00030LocalCaseNumber^T00030Provider^T00080SuicidalBehavior^T00001Spt^T02500Message^T00001Incomplete"_$C(30)
  1.  S AMHB=$P(AMHSTR,P)
  1.  S AMHE=$P(AMHSTR,P,2)
  1.  S AMHP=$P(AMHSTR,P,3)
  1.  S AMHIVB=(9999999-AMHB)+.0001
  1.  S AMHIVE=(9999999-AMHE)-.9999
  1.  S AMHDA=AMHIVE F  S AMHDA=$O(^AMHPSUIC("AB",AMHDA)) Q:'AMHDA!(AMHDA>AMHIVB)  D
  1.  . S AMHIEN=0 F  S AMHIEN=$O(^AMHPSUIC("AB",AMHDA,AMHIEN)) Q:'AMHIEN  D
  1.  .. N AMHPRVM
  1.  .. S AMHPRVM=0
  1.  .. Q:'$$ALLOW^AMHSFR(DUZ,AMHIEN)  ;screen on user and suicide form
  1.  .. N AMHD,AMHLCN,AMHPRV,AMHSB,AMHPIEN,AMHPAT,AMHSPT,AMHMSG,AMHCHT,AMHSEX,AMHINC
  1.  .. S AMHPIEN=$$GET1^DIQ(9002011.65,AMHIEN,.04,"I")
  1.  .. Q:'AMHPIEN
  1.  .. S AMHINC=$S($$INCOMPSF^AMHLESF(AMHIEN):"I",1:"")  ;v4.0 p1
  1.  .. S AMHPAT=$$GET1^DIQ(2,AMHPIEN,.01)
  1.  .. S AMHCHT=$$HRN^AUPNPAT(AMHPIEN,DUZ(2))
  1.  .. S AMHDOB=$$GET1^DIQ(2,AMHPIEN,.03,"I")
  1.  .. S AMHDOB=$$LVDT^AMHGU(AMHDOB)
  1.  .. S AMHSEX=$$GET1^DIQ(2,AMHPIEN,.02,"I")
  1.  .. S AMHD=$$GET1^DIQ(9002011.65,AMHIEN,.06,"I")
  1.  .. S AMHLCN=$$GET1^DIQ(9002011.65,AMHIEN,.02)
  1.  .. S AMHPRV=$$GET1^DIQ(9002011.65,AMHIEN,.03)
  1.  .. S AMHSB=$$GET1^DIQ(9002011.65,AMHIEN,.13)
  1.  .. S AMHSPT=$$SPT^AMHGDA(AMHPIEN)
  1.  .. I $G(AMHSPT) D
  1.  ... S AMHDOB="**SENSITIVE**"
  1.  ... S AMHMSG=$G(AMHDGMSG)
  1.  .. S AMHI=AMHI+1
  1.  .. S @RETVAL@(AMHI)=AMHIEN_U_AMHD_U_$$LVDT^AMHGU(AMHD)_U_AMHPIEN_R_AMHPAT_U_AMHCHT_U_AMHSEX_U_AMHDOB_U_AMHLCN_U_AMHPRV_U_AMHSB_U_+$G(AMHSPT)_U_$G(AMHMSG)_U_AMHINC_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;