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

VIABMS2.m

Go to the documentation of this file.
  1. VIABMS2 ;SGU/GJW - VIA BMS RPCs ;04/15/2016
  1. ;;1.0;VISTA INTEGRATION ADAPTER;**11,13**;06-FEB-2014;Build 7
  1. ;The following RPC is in support of the Bed Management System (BMS). This RPC reads the parameter "Path"
  1. ;and determine from that parameter which data to return. All BMS requests are handled by this one RPC.
  1. ;Continuation of VIABMS RPC VIAB BMS
  1. ;
  1. HOSLOC ;Returns a list of hospital locations from File #44;ICR-10040;ICR-4782
  1. ;Input - VIA("PATH")="LISTHOSPITALLOCATIONS" [required]
  1. ;VIA("IENS")=Hospital IEN, (multiple IENs separated by comma) [optional]
  1. ;VIA("MAX")=Maximum number of records returned [optional]
  1. ;VIA("FROM")=starting value (IEN) [optional]
  1. ;Data returned
  1. ; .01 Name,1 Abbreviation,99 Telephone,42 WardLocation
  1. N VIADATA,START,I,CNT,FLAG,OFFSET
  1. I VIAIENS'="" D HOSLOC2(.RESULT,VIAIENS) Q
  1. S VIADATA=$NA(^TMP($J,"VIADATA"))
  1. K @VIADATA
  1. S START=+VIAFROM
  1. S FLAG=0
  1. S I=START,CNT=0
  1. F S I=$O(^SC(I)) Q:I'>0!(CNT'<VIAMAX) D
  1. .S CNT=CNT+1
  1. .S:CNT=VIAMAX FLAG=1
  1. .S @VIADATA@(CNT)=$$HOSLOC1(I)
  1. I FLAG D
  1. .S RESULT(1)="[Misc]"
  1. .S RESULT(2)="MORE^"_$O(^SC(I),-1)
  1. .S RESULT(3)="[Data]"
  1. .S OFFSET=3
  1. I 'FLAG D
  1. .S RESULT(1)="[Data]"
  1. .S OFFSET=1
  1. S I=0
  1. F S I=$O(@VIADATA@(I)) Q:I'>0 D
  1. .S RESULT(I+OFFSET)=@VIADATA@(I)
  1. K @VIADATA
  1. Q
  1. ;
  1. HOSLOC1(J) ;
  1. Q:J=0 "0^No Hospital Location (IEN=0)^^^"
  1. Q:'$D(^SC(J)) J_"^No Hospital Location (IEN="_J_")^^^"
  1. S REC=J
  1. S $P(REC,U,2)=$P($G(^SC(J,0)),U)
  1. S $P(REC,U,3)=$P($G(^SC(J,0)),U,2)
  1. S $P(REC,U,4)=$P($G(^SC(J,99)),U)
  1. S $P(REC,U,5)=$P($G(^SC(J,42)),U)
  1. Q REC
  1. ;
  1. HOSLOC2(RESULT,IENS) ;
  1. N I,IEN,CNT
  1. S CNT=0
  1. S RESULT(1)="[Data]"
  1. F I=1:1:$L(IENS,",") D
  1. .S IEN=$P(IENS,",",I)
  1. .S CNT=CNT+1
  1. .S RESULT(CNT+1)=$$HOSLOC1(IEN)
  1. Q
  1. ;
  1. WALK(STARTI,STARTJ,MAX,START,END,ROOT) ;
  1. N I,J,CNT,STOP,PREVI,PREVJ,VAL,DGPAT,MORE,JJ,II
  1. S (STOP,CNT,J,PREVI,PREVJ,MORE)=0
  1. S I=$G(STARTI,0)
  1. S J=$G(STARTJ,0)
  1. S PATIEN=VIAPIEN
  1. S START=$G(START,0)
  1. S I=$S(START>I:START,1:I)
  1. S END=$G(END,9999999)
  1. S MAX=$G(MAX,5000)
  1. S ROOT=$G(ROOT,$NA(^TMP($J,"VIADATA")))
  1. I PATIEN="" D
  1. .F S I=$O(^DGPM("B",I)) Q:I=""!(CNT=MAX)!(I>END) D Q:(CNT=MAX) ;changed from "AD"
  1. ..F S J=$O(^DGPM("B",I,J)) Q:J=""!(CNT=MAX) D Q:(CNT=MAX)
  1. ...S VAL=$$MVTR^VIABMS1(J)
  1. ...S @ROOT@(CNT)=VAL,CNT=CNT+1
  1. ...S:CNT'>MAX PREVJ=J,PREVI=I
  1. .S MORE=$S(CNT=MAX&(J'=""):1,1:0)
  1. I PATIEN'="" D
  1. .F S J=$O(^DGPM("C",PATIEN,J)) Q:J=""!(CNT=MAX) D Q:CNT=MAX
  1. ..S I=$$GET1^DIQ(405,J,.01,"I")
  1. ..I I'<START,I'>END D
  1. ...S VAL=$$MVTR^VIABMS1(J)
  1. ...S @ROOT@(CNT)=VAL,CNT=CNT+1
  1. ...S:CNT'>MAX PREVJ=J,PREVI=I
  1. .;if no dates
  1. .I CNT,START=0,(END=9999999) D Q
  1. ..S JJ=PREVJ,JJ=$O(^DGPM("C",PATIEN,PREVJ))
  1. ..S:JJ'="" MORE=1,PREVI=$$GET1^DIQ(405,PREVJ,.01,"I")
  1. ..;S:PREVI="" PREVI=$$GET1^DIQ(405,PREVJ,.01,"I")
  1. .;if dates
  1. .I CNT S JJ=PREVJ F S JJ=$O(^DGPM("C",PATIEN,JJ)) Q:JJ=""!(MORE) D Q:MORE
  1. ..S II=$$GET1^DIQ(405,JJ,.01,"I")
  1. ..I II'<START,II'>END S MORE=1
  1. ;
  1. DONE ;
  1. Q PREVI_U_PREVJ_U_MORE
  1. ;
  1. LPATMVT2 ;This is the original code that is not used, but left here for reference as it uses the default LDIC logic.
  1. ;Returns a list of patient movement records from the PATIENT MOVEMENT file #405;ICR-1865
  1. ;Input - VIA("PATH")="LISTPATIENTMOVEMENT" [required]
  1. ; VIA("PATIEN")=Patient IEN [required, if no date range]
  1. ; VIA("SDATE")=Start Date for search [optional]
  1. ; VIA("EDATE")=End Date for search [optional]
  1. ; VIA("MAX")=n [optional]
  1. ;Data returned
  1. ; .01 MovementDate,101 EnteredDate,100 Entered By,.02 TransactionTypeId,.03 PatientIen,
  1. ; .04 TypeOfMovementIen,.06 WardLocationId,.07 RoomBedId,.14 CurrentAdmissionIen
  1. N VIAFILE,VIAFIELDS,VIAXREF,VIALAGS,VIASCRN,I
  1. S VIAFILE=405
  1. S VIAFIELDS=".01;100;101;.02;.03;.04;.06;.07;.14"
  1. S VIAFLAGS="IP"
  1. D:(VIASDT'=""!(VIAEDT'="")) DTCHK^VIABMS(.RESULT,VIASDT,VIAEDT) I $D(RESULT) Q
  1. I VIAPIEN="" D
  1. .S VIAXREF="AD"
  1. .S VIASCRN="S VIAXX=$P($G(^DGPM(Y,""USR"")),U,2) I VIAXX'<VIASDT,VIAXX'>VIAEDT"
  1. I VIAPIEN'=""&(VIASDT'=""!(VIAEDT'="")) D
  1. .S VIAXREF="C"
  1. .S VIASCRN="S VIAXX=$P($G(^DGPM(Y,""USR"")),U,2) I VIAXX'<VIASDT,VIAXX'>VIAEDT,$P(^DGPM(Y,0),U,3)=VIAPIEN"
  1. I VIAPIEN'="",VIASDT="",VIAEDT="" D
  1. .S VIAXREF="C"
  1. .S VIASCRN="I $P(^DGPM(Y,0),U,3)=VIAPIEN"
  1. D LDIC^VIABMS
  1. ;Trim the last two pieces off the right
  1. S I=""
  1. F S I=$O(RESULT(I)) Q:I="" D
  1. .I RESULT(I)'?1"[".A1"]" S RESULT(I)=$P(RESULT(I),U,1,10)
  1. Q
  1. ;
  1. LSTPAT2 ;Returns a list of patients from File #2;ICR-10035, ICR-6607
  1. ;Input - VIA("PATH")="LISTPATIENT" [required]
  1. ; VIA("IENS")=Patient DFN, (multiple IENs separated by comma) [required, optional if date range provided]
  1. ; VIA("SDATE")=Start Date for search [optional if patient DFN provided]
  1. ; VIA("EDATE")=End Date for search [optional if patient DFN provided]
  1. ; VIA("FROM")=Starting Index record for search (DATE[,DFN]) [optional]
  1. ; VIA("MAX")=n [optional]
  1. ;Data returned
  1. ;.01 Name, .02 Sex, .03 DateofBirth, .09 SSN, .097 DateEnteredintoFile, .103 TreatingSpecialty,
  1. ;.109 ExcludefromFacilityDir, .1041 AttendingPhysician, .105 Admission + ShortDx, .302 SCPercentage
  1. N I,X,ROOT,STARTI,STARTJ,ENDI,ENDJ,MORED,RES,VAL
  1. I VIASDT="",VIAEDT="",VIAIENS="" S VIAER="Missing DATE parameters" D ERR^VIABMS(VIAER) Q
  1. I VIAEDT<VIASDT S VIAER="END date cannot be before START date" D ERR^VIABMS(VIAER) Q
  1. ;Only retain the date portion
  1. S VIASDT=$P(VIASDT,".")
  1. S VIAEDT=$P(VIAEDT,".")
  1. ;Check to see if any data remains
  1. I VIASDT="",VIAIENS'="" G CONTX
  1. I '$D(^DPT("BMS",VIASDT))&$O(^DPT("BMS",VIASDT))="" D Q
  1. .S RESULT(1)="[Data]"
  1. CONTX ;
  1. S MORED=0
  1. S ROOT=$NA(^TMP("VIADATA",$J))
  1. I VIAIENS'="" D Q
  1. .S RESULT(1)="[Data]"
  1. .F I=1:1:$L(VIAIENS,",") D
  1. ..S X=$P(VIAIENS,",",I)
  1. ..S:X'="" RESULT(I+1)=$$PTR2(X)
  1. I VIAIENS="" D
  1. .S VAL=$$SEEK(+VIASDT)
  1. .S STARTI=$P(VAL,U),STARTJ=$P(VAL,U,2)
  1. .I VIAFROM'="" S STARTI=$P(VIAFROM,"~"),STARTJ=$P(VIAFROM,"~",2)
  1. .S RES=""
  1. .S:STARTI="" RESULT(1)="[Data]"
  1. .S:STARTI'="" RES=$$WALK3(ROOT,VIAMAX,STARTI,STARTJ)
  1. .S ENDI=$P(RES,U),ENDJ=$P(RES,U,2),MORED=$P(RES,U,3)
  1. I MORED=0 D
  1. .S RESULT(1)="[Data]"
  1. .S I=""
  1. .F S I=$O(@ROOT@(I)) Q:I'>0 S RESULT(I+1)=@ROOT@(I)
  1. I MORED=1 D
  1. .S RESULT(1)="[Misc]"
  1. .S RESULT(2)="MORE^"_ENDI_"~"_ENDJ
  1. .S RESULT(3)="[Data]"
  1. .S I=""
  1. .F S I=$O(@ROOT@(I)) Q:I'>0 S RESULT(I+3)=@ROOT@(I)
  1. K @ROOT
  1. Q
  1. ;
  1. SEEK(SDATE) ;
  1. N I,J
  1. Q:SDATE="" U
  1. I $D(^DPT("BMS",SDATE)) S I=SDATE
  1. E S I=$O(^DPT("BMS",SDATE))
  1. Q:I="" U
  1. S J=$O(^DPT("BMS",I,""))
  1. Q $G(I)_U_$G(J)
  1. ;
  1. WALK3(ROOT,MAX,STARTI,STARTJ) ;
  1. S ROOT=$G(ROOT,$NA(^TMP("VIADATA",$J))) ;data root
  1. S MAX=$G(MAX,5000)
  1. S STARTI=$G(STARTI)
  1. S STARTJ=$G(STARTJ)
  1. N I,J,CNT,FIRST,MORE,IROOT
  1. S I=STARTI,J=STARTJ
  1. S IROOT=$NA(^DPT("BMS")) ;index root
  1. K @ROOT
  1. S CNT=0,ENDI=0,ENDJ=0
  1. F D Q:I=""!(CNT'<MAX)
  1. .F D Q:J=""!(CNT'<MAX)
  1. ..I VIASDT'="",$$ENTERED(J)'<VIASDT,$$ENTERED(J)'>VIAEDT D
  1. ...D VISIT(I,J,ROOT,.CNT)
  1. ..S:(CNT<MAX) J=$O(@IROOT@(I,J))
  1. .S:(CNT<MAX) I=$O(@IROOT@(I))
  1. S MORE=$S(CNT=MAX:1,1:0)
  1. Q $$NEXT(I,J)_U_MORE
  1. ;
  1. VISIT(I,J,ROOT,CNT) ;
  1. S CNT=CNT+1
  1. S @ROOT@(CNT)=$$PTR2(J)
  1. Q
  1. ;
  1. ENTERED(VIAIEN) ;
  1. Q:VIAIEN="" ""
  1. Q $P($G(^DPT(VIAIEN,0)),U,16)
  1. ;
  1. NEXT(I,J) ;
  1. N VAL,K,L
  1. ;first, some sanity checking
  1. I I="" S VAL=U G NXTQ
  1. S K=$O(^DPT("BMS",I,J))
  1. I K'="" S VAL=I_U_K G NXTQ
  1. S K=$O(^DPT("BMS",I))
  1. S L=$O(^DPT("BMS",K,""))
  1. S VAL=K_U_L
  1. NXTQ ;
  1. Q VAL
  1. ;
  1. PTR2(VIAIEN) ;
  1. Q:'$D(^DPT(VIAIEN,0)) ""
  1. N REC,ADM,DX,NODE0,NODE103,NODE109,NODE1041,NODE105,NODE3
  1. S NODE0=^DPT(VIAIEN,0)
  1. S NODE103=$G(^DPT(VIAIEN,.103))
  1. S NODE109=$G(^DPT(VIAIEN,.109))
  1. S NODE1041=$G(^DPT(VIAIEN,.1041))
  1. S NODE105=$G(^DPT(VIAIEN,.105))
  1. S NODE3=$G(^DPT(VIAIEN,.3))
  1. S REC=VIAIEN_U_$P(NODE0,U) ;.01
  1. S REC=REC_U_$P(NODE0,U,2) ;.02
  1. S REC=REC_U_$P(NODE0,U,3) ;.03
  1. S REC=REC_U_$P(NODE0,U,9) ;.09
  1. S REC=REC_U_$P(NODE0,U,16) ;.097
  1. S REC=REC_U_$P(NODE103,U) ;.103
  1. S REC=REC_U_$P(NODE1041,U) ;.1041
  1. S ADM=$P(NODE105,U)
  1. S REC=REC_U_ADM
  1. I ADM'="",$D(^DGPM(ADM,0)) S REC=REC_"~"_$P(^(0),U,10) ;.105
  1. S REC=REC_U_$P(NODE109,U) ;.109
  1. S REC=REC_U_$P(NODE3,U,2) ;.302
  1. Q REC
  1. ;
  1. GPATMVT ; Returns a patient movement records from the PATIENT MOVEMENT file #405;ICR-1865
  1. ;Input - VIA("PATH")="GETPATIENTMOVEMENT" [required]
  1. ; VIA("IENS")="Patient Movement IEN" [required, optional if no other parameter]
  1. ; VIA("MOVDATE")=Movement Date [optional, required if no Patient Movement IEN]
  1. ; VIA("MOVTYPE")=Movement Type [optional, required if no Patient Movement IEN]
  1. ; VIA("PATIEN")=Patient IEN [optional, required if no Patient Movement IEN]
  1. ;Data returned
  1. ; .01 MovementDate,101 EnteredDate,100 Entered By,.02 TransactionTypeId,.03 PatientIen,
  1. ; .04 TypeOfMovementIen,.06 WardLocationId,.07 RoomBedId,.14 CurrentAdmissionIen
  1. I VIAIENS="",VIAMDT="",VIAMTYP="",VIAPIEN="" S VIAER="Missing Input parameters" D ERR^VIABMS(VIAER) Q
  1. I VIAIENS'="" D Q ;Note that other parameters are ignored
  1. .N I,IEN,CNT
  1. .S CNT=0
  1. .S RESULT(1)="[Data]"
  1. .F I=1:1:$L(VIAIENS) D
  1. ..S IEN=$P(VIAIENS,",",I)
  1. ..I IEN>0,$D(^DGPM(IEN,0)) D
  1. ...S CNT=CNT+1
  1. ...S RESULT(CNT+1)=$$GMVTR^VIABMS(IEN)
  1. I VIAIENS="",VIAMDT'="",VIAMTYP'="",VIAPIEN'="" D Q
  1. .S RESULT(1)="[Data]"
  1. .I $D(^DGPM("AC",VIAMDT,VIAMTYP,VIAPIEN)) D Q
  1. ..S IEN=$O(^DGPM("AC",VIAMDT,VIAMTYP,VIAPIEN,""))
  1. ..S RESULT(2)=$$GMVTR^VIABMS(IEN)
  1. S VIAER="Movement date, movement type, and patient IEN are required."
  1. D ERR^VIABMS(VIAER)
  1. Q