- 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 Feb 19, 2025@00:11:47 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