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