- 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
