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