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

AMHBHAPI.m

Go to the documentation of this file. 
  1. AMHBHAPI ; IHS/CMI/LAB - BH API'S ;
  1.  ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
  1.  ;
  1. RX(RETVAL) ;EP - TO RETURN PHARMACY SYSTEM
  1.  ;RETVAL - 0 if site is not running RPMS pharmacy
  1.  ;         ien of pharmacy system file
  1.  S RETVAL=+$P($G(^AMHSITE(DUZ(2),0)),U,34)
  1.  ;
  1. TIUF(RETVAL,FILE,IEN,WPFIELD) ;EP - TO RETURN FIELD NUMBER FOR WP
  1.  ;RETVAL - 0 - use word processing field for edit
  1.  ;         or
  1.  ;         field number to use for the TIU Document
  1.  ;         or
  1.  ;         -1^error message - error, could not determine value
  1.  ;
  1.  I '$G(FILE) S RETVAL="-1^FILE NUMBER NOT PASSED" Q
  1.  I '$D(^DD(FILE)) S RETVAL="-1^FILE NUMBER INVALID" Q
  1.  ;new record - return TIU field
  1.  I '$G(IEN) S RETVAL=$O(^AMHTIUF("AC",FILE,WPFIELD,0)) Q  ;new record so TIU
  1.  NEW G,R S G=^DIC(FILE,0,"GL")
  1.  S R=G_"IEN)"
  1.  I '$D(@R) S RETVAL=$O(^AMHTIUF("AC",FILE,WPFIELD,0)) Q  ;new record always use TIU
  1.  NEW N,S
  1.  S N=$P($P(^DD(FILE,WPFIELD,0),U,4),";",1)
  1.  S S=G_"IEN,N,0)"
  1.  I '$O(@S) S RETVAL=$O(^AMHTIUF("AC",FILE,WPFIELD,0)) Q  ;no word processing text
  1.  S RETVAL=0
  1.  Q
  1.  ;
  1. TESTTIUF ;
  1.  D TIUF(.AMHVAL,9002011,1249,3101)
  1.  Q
  1. TESTIEN ;
  1.  D TIUIEN(.AMHVAL,9002011,10000,1108)
  1.  Q
  1. TIUIEN(RETVAL,FILE,IEN,TIUFIELD) ;EP - API to return TIU Document ien from FILE,FIELD
  1.  ;Input:  FILE - file number
  1.  ;        IEN - ien of entry in file named in FILE
  1.  ;        TIUFIELD - field number for the TIU field
  1.  ;
  1.  ;Return Values:  if error:  -1^ERROR DESCRIPTION
  1.  ;                or
  1.  ;                0 if TIU field is blank
  1.  ;                or
  1.  ;                ien of TIU document from TIU field^TIU DOCUMENT TITLE^TIU DOCUMENT DATE/TIME
  1.  ;
  1.  I '$G(FILE) S RETVAL="-1^FILE NUMBER NOT PASSED" Q
  1.  I '$D(^DD(FILE)) S RETVAL="-1^FILE NUMBER INVALID" Q
  1.  I $G(IEN)="" S RETVAL="-1^IEN NOT PASSED" Q
  1.  I $G(TIUFIELD)="" S RETVAL="-1^TIU FIELD NOT PASSED" Q
  1.  NEW AMHTIUD
  1.  S AMHTIUD=$$VALI^XBDIQ1(FILE,IEN,TIUFIELD)
  1.  I AMHTIUD="" S RETVAL=0 Q
  1.  S RETVAL=AMHTIUD_U_$$VAL^XBDIQ1(8925,AMHTIUD,.01)_U_$$VAL^XBDIQ1(8925,AMHTIUD,1301)
  1.  Q
  1.  ;
  1. TESTV ;
  1.  D TIUVISIT(.AMHVAL,65498,3060221.12,2522,2,14,1)
  1.  W !,AMHVAL
  1.  Q
  1. TIUVISIT(RETVAL,DFN,DATE,LOCATION,TOC,CLINIC,PROVIDER) ;EP - API to create or find a visit
  1.  ;input parameters:    DFN - DFN of Patient
  1.  ;                     DATE - date and time of visit IN internal FM format
  1.  ;                     LOCATION - IEN of location of encounter from LOCATION file
  1.  ;                     TOC - ien of MHSS type of contact 
  1.  ;                     CLINIC - ien from clinic stop fle
  1.  ;                     PROVIDER - ien of primary provider
  1.  ;
  1.  ;error codes:    0^error message     
  1.  ;
  1.  ;RETVAL:  IEN of VISITS FOUND or error code
  1.  ;         If more than one visit found then pass back list 1234^2345^1919
  1.  ;         
  1.  I '$G(DFN) S RETVAL="0^INVALID DFN VALUE" Q
  1.  I '$D(^AUPNPAT(DFN)) S RETVAL="0^INVALID DFN VALUE" Q
  1.  I '$G(DATE)="" S RETVAL="0^DATE OF VISIT INVALID" Q
  1.  I '$D(DT) D ^XBKVAR
  1.  S AUPNTALK=""
  1.  NEW X,%DT,Y S X=DATE,%DT="TRXN" D ^%DT S X=Y I X=-1 S RETVAL="0^"_DATE_"^DATE INVALID FOR PATIENT,CANNOT CREATE VISIT .01 VALUE" Q
  1.  S Y=DFN D ^AUPNPAT
  1.  S X=$P(DATE,".",1)
  1.  D VSIT01^AUPNVSIT
  1.  I '$D(X) S RETVAL="0^"_DATE_"^DATE INVALID FOR PATIENT,CANNOT CREATE VISIT .01 VALUE" Q
  1.  I $G(LOCATION)="" S RETVAL="0^LOCATION OF ENCOUNTER MISSING" Q
  1.  I '$D(^AUTTLOC(LOCATION)) S RETVAL="0^LOCATION OF ENCOUNTER INVALID" Q
  1.  I '$G(TOC) S RETVAL="0^TYPE OF CONTACT MISSING" Q
  1.  I '$D(^AMHTSET(TOC)) S RETVAL="0^TYPE OF CONTACT INVALID" Q
  1.  I '$G(CLINIC) S RETVAL="0^CLINIC STOP MISSING" Q
  1.  I '$D(^DIC(40.7,CLINIC,0)) S RETVAL="0^CLINIC STOP INVALID" Q
  1.  ;I '$G(PROVIDER) S RETVAL="0^PRIMARY PROVIDER IEN MISSING" Q
  1.  I $G(PROVIDER),'$D(^VA(200,PROVIDER,0)) S RETVAL="0^PRIMARY PROVIDER IEN MISSING" Q
  1.  ;have good data, now create or get visit
  1.  D BSD I AMHERR]"" S RETVAL="0^PCC Visit not created" Q
  1.  I '$G(AMHVSIT) W !!,"Visit not created...notify supervisor." Q
  1.  S RETVAL=AMHVSIT
  1.  Q
  1. BSD ;
  1.  ;if non-interactive use BSDAPI4 and always force an add
  1.  ;in interative mode display to user for selection
  1.  K AMHIN ;clean out array
  1.  I '$P($G(^AMHSITE(DUZ(2),0)),U,33) S AMHIN("FORCE ADD")=1
  1.  ;I $D(ZTQUEUED) S AMHIN("FORCE ADD")=1
  1.  S AMHIN("VISIT DATE")=DATE
  1.  D GETTYPE
  1.  S AMHIN("VISIT TYPE")=AMHTYPE
  1.  S AMHIN("PAT")=DFN
  1.  S AMHIN("SITE")=LOCATION
  1.  ;determine service category based on type of contact
  1.  S AMHIN("SRV CAT")=$P(^AMHTSET(TOC,0),U,3)
  1.  S AMHIN("CLINIC CODE")=CLINIC
  1.  I $G(PROVIDER) S AMHIN("PROVIDER")=PROVIDER
  1.  S AMHIN("APCDCAF")="R"
  1.  S AMHIN("TIME RANGE")=-1
  1.  S AMHIN("USR")=DUZ
  1. BSDADD1 ;
  1.  K APCDALVR
  1.  K AMHV
  1.  D GETVISIT^APCDAPI4(.AMHIN,.AMHV)
  1.  S AMHERR=$P(AMHV(0),U,2)
  1.  I AMHERR]"" Q  ;errored
  1.  I $P(AMHV(0),U)=1 S V=$O(AMHV(0)) I AMHV(V)="ADD" S AMHVSIT=V Q
  1.  ;since more than one passed back GIVE THEM BACK TO THE CALLER SO THEY CAN CHOOSE
  1.  S X=0,C=0 F  S X=$O(AMHV(X)) Q:X=""  S C=C+1 S $P(AMHVSIT,U,C)=X
  1.  Q
  1. GETTYPE ;get type of visit - use loc current type or affiliation of provider
  1.  S AMHTYPE=$S($P($G(^AMHSITE(DUZ(2),0)),U,2)]"":$P(^(0),U,2),1:"") Q:AMHTYPE]""
  1.  S X=$P($G(^APCCCTRL(LOCATION,0)),U,4) I X]"" S AMHTYPE=X Q  ;use pcc master control for site of loc of enc ihs/tucson/lab 11/30/95 patch 1
  1.  S X=$$VALI^XBDIQ1(200,PROVIDER,9999999.01) I X S AMHTYPE=$S(X=1:"I",X=2:"C",X=3:"T",X=8:"6",1:"") I AMHTYPE]"" Q
  1.  S X=$P($G(^APCCCTRL(DUZ(2),0)),U,4) I X]"" S AMHTYPE=X Q  ;use pcc master control
  1.  S AMHTYPE="I" ;default to I if can't determine
  1.  Q