BMCAPI1 ;IHS/OIT/FCJ-API BY REQ FIELDS
;;4.0;REFERRED CARE INFO SYSTEM;**4**;JAN 09, 2006;Build 101
;IHS/OIT/FCJ NEW ROUTINE RELEASED W/PATCH 4
;
;NOTE: Currently not used for multiple or word processing fields
;BMCDFN=Array of PATIENT IEN's subcripted by the IEN (Not REQUIRED If Beginning date)
;BMCBDT=BEG DT (NOT REQUIRED if Patient IEN Array sent)
;BMCEDT=END DT (NOT REQUIRED)
;BMCFLDS=LIST OF FIELDS TO DEFINE (REQUIRED)
; Format=".01/I;.02/E"
; I=INTERAL FORMAT
; E=EXTERNAL FORMAT
; B=BOTH
;BMCGLB=GLOBAL TO SET THE LIST OF FIELDS (Required)
;FIELDS WILL BE SET IN GLOBAL IN ORDER SUBMITTED
;Example: BMCDFN,BMCRIEN,ORDER,BMCFLD,BMCTYP=VALUE
;
API(BMCPDFN,BMCBDT,BMCEDT,BMCFLDS,BMCGLB) ;EP FOR RCIS REFERRALS
Q:$G(BMCFLDS)=""
Q:$G(BMCGLB)=""
;
S BMCDT="",BMCQ="",BMCPFLG=0
I $G(BMCBDT)'="" S BMCDT=BMCBDT-1
;TEST PAT IEN ARRAY
S Y="" F I=0:1 S Y=$O(BMCPDFN(Y)) Q:(Y'?1N.N)!(I>0)
I I>0 S BMCPFLG=1 D PAT Q
I BMCBDT="",BMCPFLG=0 Q
;
DT ;SORT BY DATE IF PAT IEN NOT SENT
F S BMCDT=$O(^BMCREF("B",BMCDT)) Q:(BMCDT'?1N.N) D Q:BMCQ
.I $G(BMCEDT),BMCDT>BMCEDT S BMCQ=1 Q
.S BMCRIEN=""
.F S BMCRIEN=$O(^BMCREF("B",BMCDT,BMCRIEN)) Q:BMCRIEN'?1.N.N D
..S BMCDFN=$P(^BMCREF(BMCRIEN,0),U,3)
..D SET
D EXIT
Q
;
PAT ; SORT BY PATIENT THEN DATE IF EXISTS
;
S BMCDFN=0 F S BMCDFN=$O(BMCPDFN(BMCDFN)) S BMCDT=BMCBDT-1 Q:BMCDFN'?1N.N D
.F S BMCDT=$O(^BMCREF("AA",BMCDFN,BMCDT)) Q:BMCDT'?1N.N D Q:BMCQ
..I $G(BMCEDT),BMCDT>BMCEDT S BMCQ=1 Q
..S BMCRIEN=""
..F S BMCRIEN=$O(^BMCREF("AA",BMCDFN,BMCDT,BMCRIEN)) Q:BMCRIEN'?1N.N D SET
D EXIT
Q
;
SET ;SET REQUESTED FIELDS IN GLB
F I=1:1 D Q:'$G(BMC(I))
.Q:$P(BMCFLDS,";",I)=""
.S BMC(I)=$P(BMCFLDS,";",I)
.S BMCTYP=$P(BMC(I),"/",2)
.D:BMCTYP="B" INT,EXT
.D:BMCTYP="I" INT
.D:BMCTYP="E" EXT
Q
INT ;INTERNAL FORMAT
S @BMCGLB@(BMCDFN,BMCRIEN,I,$P(BMC(I),"/"),"I")=$$VALI^XBDIQ1(90001,BMCRIEN,$P(BMC(I),"/"))
Q
EXT ;EXTERNAL FORMAT
S @BMCGLB@(BMCDFN,BMCRIEN,I,$P(BMC(I),"/"),"E")=$$VAL^XBDIQ1(90001,BMCRIEN,$P(BMC(I),"/"))
Q
EXIT ;
K BMCDFN,BMCBDT,BMCEDT,BMCFLDS,BMCGLB,BMCDT,BMCRIEN,BMCDFN,I,BMCTYP,BMC,BMCQ,BMCPFLG
Q
BMCAPI1 ;IHS/OIT/FCJ-API BY REQ FIELDS
+1 ;;4.0;REFERRED CARE INFO SYSTEM;**4**;JAN 09, 2006;Build 101
+2 ;IHS/OIT/FCJ NEW ROUTINE RELEASED W/PATCH 4
+3 ;
+4 ;NOTE: Currently not used for multiple or word processing fields
+5 ;BMCDFN=Array of PATIENT IEN's subcripted by the IEN (Not REQUIRED If Beginning date)
+6 ;BMCBDT=BEG DT (NOT REQUIRED if Patient IEN Array sent)
+7 ;BMCEDT=END DT (NOT REQUIRED)
+8 ;BMCFLDS=LIST OF FIELDS TO DEFINE (REQUIRED)
+9 ; Format=".01/I;.02/E"
+10 ; I=INTERAL FORMAT
+11 ; E=EXTERNAL FORMAT
+12 ; B=BOTH
+13 ;BMCGLB=GLOBAL TO SET THE LIST OF FIELDS (Required)
+14 ;FIELDS WILL BE SET IN GLOBAL IN ORDER SUBMITTED
+15 ;Example: BMCDFN,BMCRIEN,ORDER,BMCFLD,BMCTYP=VALUE
+16 ;
API(BMCPDFN,BMCBDT,BMCEDT,BMCFLDS,BMCGLB) ;EP FOR RCIS REFERRALS
+1 IF $GET(BMCFLDS)=""
QUIT
+2 IF $GET(BMCGLB)=""
QUIT
+3 ;
+4 SET BMCDT=""
SET BMCQ=""
SET BMCPFLG=0
+5 IF $GET(BMCBDT)'=""
SET BMCDT=BMCBDT-1
+6 ;TEST PAT IEN ARRAY
+7 SET Y=""
FOR I=0:1
SET Y=$ORDER(BMCPDFN(Y))
IF (Y'?1N.N)!(I>0)
QUIT
+8 IF I>0
SET BMCPFLG=1
DO PAT
QUIT
+9 IF BMCBDT=""
IF BMCPFLG=0
QUIT
+10 ;
DT ;SORT BY DATE IF PAT IEN NOT SENT
+1 FOR
SET BMCDT=$ORDER(^BMCREF("B",BMCDT))
IF (BMCDT'?1N.N)
QUIT
Begin DoDot:1
+2 IF $GET(BMCEDT)
IF BMCDT>BMCEDT
SET BMCQ=1
QUIT
+3 SET BMCRIEN=""
+4 FOR
SET BMCRIEN=$ORDER(^BMCREF("B",BMCDT,BMCRIEN))
IF BMCRIEN'?1.N.N
QUIT
Begin DoDot:2
+5 SET BMCDFN=$PIECE(^BMCREF(BMCRIEN,0),U,3)
+6 DO SET
End DoDot:2
End DoDot:1
IF BMCQ
QUIT
+7 DO EXIT
+8 QUIT
+9 ;
PAT ; SORT BY PATIENT THEN DATE IF EXISTS
+1 ;
+2 SET BMCDFN=0
FOR
SET BMCDFN=$ORDER(BMCPDFN(BMCDFN))
SET BMCDT=BMCBDT-1
IF BMCDFN'?1N.N
QUIT
Begin DoDot:1
+3 FOR
SET BMCDT=$ORDER(^BMCREF("AA",BMCDFN,BMCDT))
IF BMCDT'?1N.N
QUIT
Begin DoDot:2
+4 IF $GET(BMCEDT)
IF BMCDT>BMCEDT
SET BMCQ=1
QUIT
+5 SET BMCRIEN=""
+6 FOR
SET BMCRIEN=$ORDER(^BMCREF("AA",BMCDFN,BMCDT,BMCRIEN))
IF BMCRIEN'?1N.N
QUIT
DO SET
End DoDot:2
IF BMCQ
QUIT
End DoDot:1
+7 DO EXIT
+8 QUIT
+9 ;
SET ;SET REQUESTED FIELDS IN GLB
+1 FOR I=1:1
Begin DoDot:1
+2 IF $PIECE(BMCFLDS,";",I)=""
QUIT
+3 SET BMC(I)=$PIECE(BMCFLDS,";",I)
+4 SET BMCTYP=$PIECE(BMC(I),"/",2)
+5 IF BMCTYP="B"
DO INT
DO EXT
+6 IF BMCTYP="I"
DO INT
+7 IF BMCTYP="E"
DO EXT
End DoDot:1
IF '$GET(BMC(I))
QUIT
+8 QUIT
INT ;INTERNAL FORMAT
+1 SET @BMCGLB@(BMCDFN,BMCRIEN,I,$PIECE(BMC(I),"/"),"I")=$$VALI^XBDIQ1(90001,BMCRIEN,$PIECE(BMC(I),"/"))
+2 QUIT
EXT ;EXTERNAL FORMAT
+1 SET @BMCGLB@(BMCDFN,BMCRIEN,I,$PIECE(BMC(I),"/"),"E")=$$VAL^XBDIQ1(90001,BMCRIEN,$PIECE(BMC(I),"/"))
+2 QUIT
EXIT ;
+1 KILL BMCDFN,BMCBDT,BMCEDT,BMCFLDS,BMCGLB,BMCDT,BMCRIEN,BMCDFN,I,BMCTYP,BMC,BMCQ,BMCPFLG
+2 QUIT
