VIABMS ;AAC/JMC,AFS/PB - VIA BMS RPCs ;10/31/17 14:34
;;1.0;VISTA INTEGRATION ADAPTER;**8,10,11,15,19**;06-FEB-2014;Build 1
;
;The routine is in support of the Bed Management System (BMS) and is linked to VIAB BMS RPC. The RPC
;determines what data is returned from what is passed in the input parameter VIA("PATH"). All BMS requests
;are handled by this one RPC.
;
; RPC VIAB BMS
; ICR 10035 PATIENT FILE
; ICR 10040 HOSPITAL LOCATION FILE [File #44;fields .01,1,42]
; ICR 10060 NEW PERSON FILE [File 200;fields .01,30] (supported)
; ICR 6609 WARD [Access to File #42;fields .01,.017,.2] (private)
; ICR 4782 CLINIC PHONE [File #44;field 99]
; ICR 2652 DBIA2652 [File #42.4;field .01] (controlled)
; ICR 4433 NAME: DBIA4433 [API SDAPI^SDAMA301] (supported)
; ICR 5771 ORDERS FILE DATA [File #100;field #5] (controlled)
; ICR 6610 FACILITY MOVEMENT File #405.1;fields .01,.04] (private)
; ICR 6607 SC PERCENTAGE [File #2;field .302] (private)
; ICR 10090 INSTITUTION FILE (supported)
; ICR 7140 ED LOG [File 230;"ADST" XREF from field 1.2]
; ICR 7141 TRACKING CODE [File 233.1;field .05]
Q
;
EN(RESULT,VIA) ; entry point for RPC
N VIATAG,VIAER
S VIATAG=""
I $O(VIA(""))="" S VIAER="Missing Parameters" D ERR(VIAER) Q
I $G(VIA("PATH"))="" S VIAER="Missing PATH Parameters" D ERR(VIAER) Q
; -- parse array to parameters
D PARSE(.VIA)
D PATH(.VIATAG)
I VIATAG'="" D @VIATAG
D KVAR
Q
;
PARSE(VIA) ; -- array parsing to parameters
S VIAIENS=$G(VIA("IENS"))
S VIAFLAGS=$G(VIA("FLAGS"))
S VIAMAX=$G(VIA("MAX")) I VIAMAX>5000 S VIAMAX=5000
;I $G(VIAMAX)="" S VIAMAX=1000
I $G(VIAMAX)="" S VIAMAX=5000
S VIAFROM=$G(VIA("FROM"))
S VIATO=$G(VIA("TO")) ;search returns data up to a certain value for I.
S VIAPART=$G(VIA("PART"))
S VIAXREF=$G(VIA("XREF"))
S VIASCRN=$G(VIA("SCREEN"))
S VIAID=$G(VIA("ID"))
S VIASDT=$G(VIA("SDATE"))
S VIAEDT=$G(VIA("EDATE"))
S VIALEDT=$G(VIA("LASTEDT"))
S VIAMDT=$G(VIA("MOVDATE"))
S VIAMTYP=$G(VIA("MOVTYPE"))
S VIAPIEN=$G(VIA("PATIEN"))
S VIACIEN=$G(VIA("CLNIEN"))
S VIAOIEN=$G(VIA("ORDIEN"))
S VIASSN=$G(VIA("SSN"))
S VIAVAL=$G(VIA("VALUE"))
Q
;
PATH(VIATAG) ;The PATH parameter determines the line tag executed and data returned by the RPC.
N X,I
S X=""
F I=1:1 S X=$P($T(HNDL+I),";;",2) Q:(X="END")!(X="") I $$UP^XLFSTR(VIA("PATH"))=$P(X,";") S VIATAG=$P(X,";",2) Q
Q
;
GETACT ;returns activity from the ED LOG (#230) file
;Input - VIA("PATH")="GETACTIVITY" [required]
; VIA("FROM")=start date/time (exclusive) [required]
; VIA("TO")=end date/time (inclusive) [required]
;Data returned
;
;DISPOSITION TIME (#1.3)
;PATIENT ID (#.06)
;FACILITY ID (#.02)
;COMPLAINT (#1.1)
;DIAGNOSIS TIME (#1.4)
;
N I,Y,NODE0,NODE1,VAL,DISP,DFN,INST,IEN,DISPI,TCFLGS,DISPI
S:VIASDT="" VIASDT=VIAFROM ;alias
S:VIAEDT="" VIAEDT=VIATO ;alias
S N=0
D SET("[Data]")
S I=VIASDT-.0000000001
F S I=$O(^EDP(230,"ADST",I)) Q:((I="")!('$$BETWEEN(I,VIASDT,VIAEDT))) D
.S IEN=""
.F S IEN=$O(^EDP(230,"ADST",I,IEN)) Q:IEN="" D ;*19 added loop and changed conditionals
..S DISP=$$GET1^DIQ(230,IEN_",",1.2,"E")
..S DISPI=$$GET1^DIQ(230,IEN_",",1.2,"I"),TCFLAG=$$UP^XLFSTR($$GET1^DIQ(233.1,DISPI_",",.05,"E"))
..;only look at FLAGS = "VA"
..Q:(TCFLAG'="VA")
..S VAL=""
..S NODE0=$G(^EDP(230,IEN,0))
..S NODE1=$G(^EDP(230,IEN,1))
..S VAL=VAL_$P(NODE1,U,3) ;DISPOSITION TIME (#1.3)
..S DFN=$P(NODE0,U,6) ;PATIENT ID (#.06)
..S VAL=VAL_U_DFN
..S INST=$P(NODE0,U,2) ;INSTITUTION (#.02)
..S VAL=VAL_U_$$GET1^DIQ(4,INST_",",99) ;station number
..S VAL=VAL_U_$P(NODE1,U) ;COMPLAINT (#1.1)
..S VAL=VAL_U_$P(NODE1,U,4) ;DIAGNOSIS TIME (#1.4)
..D SET(VAL)
..Q
.Q
M RESULT=Y
Q
;
;If VIAA (resp. VIAB) is an exact date only match it against the date part of VIAX.
BETWEEN(VIAX,VIAA,VIAB) ;
N LEX,REX,X1,X2
S LEX=$S(VIAA[".":1,1:0)
S REX=$S(VIAB[".":1,1:0)
S X1=$S(LEX:VIAX,1:$P(VIAX,"."))
S X2=$S(REX:VIAX,1:$P(VIAX,"."))
Q ((X1'<VIAA)&(X2'>VIAB))
;
PRIMDX(VIADA) ;return primary diagnosis
N I,PRIM,RES,IENS,DX
S I=0,RES=""
F S I=$O(^EDP(230,VIADA,4,I)) Q:I'>0 D
. S PRIM=$P($G(^EDP(230,VIADA,4,I,0)),U,3)
.I PRIM D Q
. . S IENS=I_","_VIADA_","
. . S DX=$$GET1^DIQ(230.04,IENS,.02,"E")
Q DX
;
GETPAT ;Returns patient information based on DFN from File #2;ICR-10035, ICR-6607
;Input - VIA("PATH")="GETPATIENT" [required]
; VIA("IENS")=Patient DFN, [required]
;Data returned
; .01 Name,.02 Sex,.03 DateOfBirth,.09 SocialSecurityNumber,.097 DateEnteredIntoFile,
; .103 TreatingSpecialty,, .1041 AttendingPhysician,.302 ServiceConnectedPercentage,.105 CurrentAdmission,.1 Diagnosis [Short] from File #405
N VIAFILE,VIAFIELDS,VIAFLAGS,X,VAL
I VIAIENS="" S VIAER="Missing IENS Parameters" D ERR(VIAER) Q
S VIAFILE=2,VIAFIELDS=".01;.02;.03;.09;.097;.103;.1041;.105;.109;.302",VIAFLAGS="IE"
D GDIQ
; add Field .1 DIAGNOSIS [SHORT] from File #405 to result of .105 field in File #2.
S X=1 F S X=$O(RESULT(X)) Q:'X I RESULT(X)["^.105^" S VAL=$P(RESULT(X),U,4) I VAL'="" S VAL=$$GET1^DIQ(405,VAL,.1,"E"),$P(RESULT(X),U,4)=$P(RESULT(X),U,4)_"~"_VAL Q
Q
;
PATSSN ;Returns patient information based on SSN from File #2
;Input - VIA("PATH")="LISTPATIENTBYSSN" [required]
; VIA("SSN")=SSN [required]
N DFN
S DFN=$O(^DPT("SSN",VIASSN,""))
I DFN="" S VIAER="Invalid SSN" D ERR(VIAER) Q
S VIAIENS=DFN_","
D GETPAT
Q
;
LADMPAT ;Returns a list of admitted patients from File #2
;Input - VIA("PATH")="LISTADMITTEDPATIENTSFORUPDATE" [required]
; VIA("MAX")=n [optional]
N VIAXREF,VIASCRN,X,VAL
S VIAXREF="ACA",VIASCRN="I $D(^DPT(Y,.105))"
D GPAT
; add Field .1 DIAGNOSIS [SHORT] from File #405 to result of .105 field in File #2.
S X=1 F S X=$O(RESULT(X)) Q:'X S VAL=$P(RESULT(X),U,9) I VAL'="" S VAL=$$GET1^DIQ(405,VAL,.1,"E"),$P(RESULT(X),U,9)=$P(RESULT(X),U,9)_"~"_VAL
Q
;
;This is the ORIGINAL implementation of LISTPATIENT
LSTPAT ;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]
;
N VIAFILE,VIAFIELDS,VIAFLAGS,TVIAIENS,TRESULT,Y,Z,I,VALUE,FLDS,CNT,VALX,VIATSDT
I VIAIENS'="" S TVIAIENS=VIAIENS S VIAIENS=""
I $G(TVIAIENS)'="" D Q
. S VIAFILE=2,VIAFIELDS=".01;.02;.03;.09;.097;.103;.109;.1041;.105;.302;",VIAFLAGS="I"
. ;S FLDS=".1-2;.02-3;.03-4;.09-5;.097-6;.103-7;.1041-9;.105-9;.109-8;.302-11"
. S FLDS="0.1-2;.02-3;.03-4;.09-5;.097-6;.103-7;.109-8;.1041-9;.105-10;.302-11"
. S TRESULT(1)="[Data]",CNT=1,VIA("MAX")=""
. F I=1:1:$L(TVIAIENS,",") S VIAIENS=$P(TVIAIENS,",",I) I VIAIENS'="" D M RESULT=TRESULT
. . S $P(VALUE,U)=VIAIENS
. . S VIAIENS=VIAIENS_","
. . K RESULT
. . D GDIQ
. . I ($G(RESULT(1))'["Data")!($G(RESULT(2))="[ERROR]") K RESULT Q
. . F Y=2:1:11 S J=$P($P(FLDS,";",Y-1),"-",2),$P(VALUE,U,J)=$P($G(RESULT(Y)),U,4) I $G(RESULT(Y))["^.105^" D
. . . S VAL=$P($G(RESULT(Y)),U,4) I VAL'="" S VAL=$$GET1^DIQ(405,VAL,.1,"E"),$P(VALUE,U,J)=$P(VALUE,U,J)_"~"_VAL
. . S CNT=CNT+1,TRESULT(CNT)=VALUE
. . K RESULT
E D ; If VIA("IENS") is not provided
. S VIATSDT=(VIASDT\1)
. D DTCHK(.RESULT,.VIASDT,.VIAEDT) I $D(RESULT) Q
. S VIAXREF="BMS"
. S VIASCRN="S X=$P($G(^DPT(Y,0)),U,9) I X?.N S X=$P($G(^DPT(Y,0)),U,16) I X'<VIATSDT,X<VIAEDT"
. D GPAT
. ; add Field .1 DIAGNOSIS [SHORT] from File #405 to result of .105 field in File #2.
. S X=1 F S X=$O(RESULT(X)) Q:'X S VAL=$P(RESULT(X),U,9) I VAL'="" S VAL=$$GET1^DIQ(405,VAL,.1,"E"),$P(RESULT(X),U,9)=$P(RESULT(X),U,9)_"~"_VAL
Q
;
GPAT ;Get patient data from File #2;ICR-10035,ICR-6607
;Data returned
; .01 Name,.02 Sex,.03 DateOfBirth,.09 SocialSecurityNumber,.097 DateEnteredIntoFile,.103 TreatingSpecialty
; .1041 AttendingPhysician,.302 ServiceConnectedPercentage,.105 CurrentAdmission, .109 ExcludeFromFacilityDir
N VIAFILE,VIAFIELDS,VIAFLAGS
S VIAFILE=2,VIAFIELDS="@;.01;.02;.03;.09;.097;.103;.1041;.105;.109;.302",VIAFLAGS="IP"
D LDIC
Q
;
ADMTPAT ;Returns a list of admitted patients from File #2 up to the Admitted IEN;ICR-10035
;Input - VIA("PATH")="LISTADMITTEDPATIENTS" [required]
; VIA("TO")=Admission IEN [required]
; VIA("MAX")=n [optional]
;Data returned
; .01 Name,.09 Social Security Number,.101 Bed Name,.102 Movement IEN,.105 Admitting Diagnosis,.1 Ward Name
N VIAFILE,VIAFIELDS,VIASCRN,VIAFLAGS
I VIATO="" S VIAER="Missing Admission IEN Parameter" D ERR(VIAER) Q
S VIAFILE=2,VIAFIELDS="@;.01;.09;.101;.102;.105;.1;",VIATO=VIATO+.01,VIAXREF="ACA"
S VIASCRN="I $D(^DPT(Y,.105)),$P(^DPT(Y,.105),U,1)<"_VIATO,VIAFLAGS="IP"
D LDIC
Q
;
WRDLOC ;Returns information for a ward from File #42;ICR-6609
;Input - VIA("PATH")="GETWARDLOCATIONS" [required]
; VIA("IENS")=Ward IEN, [required]
;Data returned
; .01 Name, .017 Specialty, .2 IsCurrentlyOutOfService
N VIAFILE,VIAFIELDS
I VIAIENS="" S VIAER="Missing Ward IEN" D ERR(VIAER) Q
S VIAFILE=42,VIAFIELDS=".01;.017;.2;",VIAFLAGS="IE"
D GDIQ
Q
;
NEWPER ;Returns a list of people from the NEW PERSON file #200 for a date range on DATE ENTERED Field (#30)
;Input - VIA("PATH")="LISTNEWPERSON" [required]
; VIA("IENS")=New Person IEN, (multiple IENs separated by comma) [optional]
; VIA("SDATE")=Start Date for search [required, if VIA(IENS) not present]
; VIA("EDATE")=End Date for search [required, if VIA(IENS) not present
;Data returned;ICR #10060
; .01 Name, 30 Date Entered
N VIAFILE,VIAFIELDS,VIAFLAGS,TVIAIENS,TRESULT
S VIAFILE=200,VIAFIELDS="@;.01;30;",VIAFLAGS="IP",VIAXREF="B"
I VIAIENS'="" S TVIAIENS=VIAIENS S VIAIENS=""
I $G(TVIAIENS)'="" S VIAFIELDS=".01;30;",VIAFLAGS="I" D Q
. S TRESULT(1)="[Data]",CNT=1
. F I=1:1:$L(TVIAIENS,",") S VIAIENS=$P(TVIAIENS,",",I) I VIAIENS'="" D M RESULT=TRESULT
. . S VIAIENS=VIAIENS_","
. . K RESULT
. . D GDIQ
. . I $G(RESULT(1))'["Data" Q
. . S CNT=CNT+1,TRESULT(CNT)=$TR(VIAIENS,",")_"^"_$P($G(RESULT(2)),U,4)
. . K RESULT
E D ; If VIA("IENS") is not provided
. D DTCHK(.RESULT,.VIASDT,.VIAEDT) I $D(RESULT) Q
. S VIASCRN="S X=$P($G(^(1)),U,7) I X>VIASDT,X<VIAEDT"
. D LDIC
Q
;
SPLTY ;Returns a list of specialties from the SPECIALTY file #42.4;ICR-2652
;Input - VIA("PATH")="LISTSPECIALTY" [required]
; VIA("IENS")= Specialty IEN, (multiple IENs separated by comma) [optional]
;Data returned
; .01 Name
N VIAFILE,VIAFIELDS,VIAFLAGS,TVIAIENS
S VIAFILE=42.4,VIAFIELDS="@;.01;",VIAFLAGS="IP"
I VIAIENS'="" S TVIAIENS=VIAIENS S VIAIENS="",VIAMAX=""
D LDIC
I $G(TVIAIENS)'="" S VIAIENS=TVIAIENS D PIENS^VIABMS1
Q
;
PATAPPT ; Returns a list of patient appointments using API SDAPI^SDAMA301;ICR-4433
;Input - VIA("PATH")="LISTPATIENTAPPOINTMENT" [required]
; VIA("IENS")=Patient IEN [required]
; VIA("CLNIEN")=Hospital Location IEN [optional]
; VIA("SDATE")=Start Date for search [optional]
; VIA("EDATE")=End Date for search [optional]
;Data returned
; .01 HospitalLocation, 20 DateAppointmentMade, 100 CurrentStatus
N VIARRAY,CNT,VIADT,VIADFNS,VIAPPT,VIACNT,CLNIEN,RCNT,QFLG,I
I VIAIENS="" S VIAER="Missing PATIENT IEN" D ERR(VIAER) Q
;I (VIASDT'="")!(VIAEDT'="") D DTCHK(.RESULT,.VIASDT,.VIAEDT) I $D(RESULT) Q ;$$SDAPI^SDAMA301 handles dates differently
S VIADFN=$TR(VIAIENS,",",";"),VIACIEN=$TR(VIACIEN,",",";")
S VIAEDT=$S(VIAEDT="":DT,1:VIAEDT)
S RESULT(1)="[Data]",CNT=1,RCNT=1,QFLG=0,MORE=""
S VIARRAY(1)=VIASDT_";"_VIAEDT
I VIACIEN'="" S VIARRAY(2)=VIACIEN
S VIARRAY(4)=VIADFN
S VIARRAY("FLDS")="1;2;4;16;22"
S VIACNT=$$SDAPI^SDAMA301(.VIARRAY)
I VIACNT<1 G PATAPPTQ
I VIACNT<1 Q
S VIADFN=$S(VIAFROM'="":$P(VIAFROM,"~")-1,1:0)
F S VIADFN=$O(^TMP($J,"SDAMA301",VIADFN)) Q:'VIADFN D Q:$G(QFLG)
. I ($P(VIAFROM,"~")>0),$P(VIAFROM,"~")'=VIADFN S VIAFROM=""
. S CLNIEN=$S(VIAFROM'="":$P(VIAFROM,"~",2)-1,1:0)
. F S CLNIEN=$O(^TMP($J,"SDAMA301",VIADFN,CLNIEN)) Q:'CLNIEN D Q:$G(QFLG)
. . I ($P(VIAFROM,"~",2)>0),$P(VIAFROM,"~",2)'=CLNIEN S VIAFROM=""
. . S VIADT=$S((VIAFROM'="")&(RCNT=1):$P(VIAFROM,"~",3),1:0)
. . F S VIADT=$O(^TMP($J,"SDAMA301",VIADFN,CLNIEN,VIADT)) Q:'VIADT D I RCNT>VIAMAX Q
. . . S VIAPPT=$G(^TMP($J,"SDAMA301",VIADFN,CLNIEN,VIADT)) ;appointment data
. . . S CNT=CNT+1,RCNT=RCNT+1,RESULT(CNT)=VIADT_"^"_CLNIEN_"^"_$P(VIAPPT,"^",16)_"^"_$P($P(VIAPPT,"^",22),";",3)_"^"_$P($P(VIAPPT,"^",4),";")
. . . I RCNT>VIAMAX D
. . . . S MORE="MORE^"_VIADFN_"~"_CLNIEN_"~"_VIADT S QFLG=1
I QFLG D
. M TARRAY=RESULT
. K RESULT
. S CNT=3,I=0,RESULT(1)="[Misc]",RESULT(2)=MORE,RESULT(3)="[Data]"
. F S I=$O(TARRAY(I)) Q:'I D
. . I TARRAY(I)["[Data" Q
. . S CNT=CNT+1,RESULT(CNT)=TARRAY(I)
PATAPPTQ K ^TMP($J,"SDAMA301")
Q
;
CANORDS ; Returns a list of cancelled orders from the ORDER file #100;ICR-5771
;Input - VIA("PATH")="LISTCANCELORDERS" [required]
; VIA("IENS")=list of Order IENs [required]
;Data returned:
;Order file IEN
;Date of 1st ORDER ACTION
;Status
;Object of order
;Hospital location
I VIAIENS="" S VIAER="Missing ORDER IEN" D ERR(VIAER) Q
N I,IEN,IENS,NMBR,PAT,ACTDT,STATUS,HLOC,DATE,REC,CNT
S RESULT(1)="[Data]"
S CNT=0
F I=1:1:$L(VIAIENS,",") D
.S IEN=$P(VIAIENS,",",I)
.D:$S(+IEN'=IEN:0,'$D(^OR(100,IEN,0)):0,1:1)
..S IENS=IEN_","
..S CNT=CNT+1
..S PAT=$$GET1^DIQ(100,IENS,.02,"I") ;really OBJECT OF ORDER
..S ACTDT=$$ACTDATE(VIAIENS)
..S STATUS=$$GET1^DIQ(100,IENS,5,"E")
..S HLOC=$$GET1^DIQ(100,IENS,6,"I")
..S REC=IEN_U_ACTDT_U_STATUS_U_PAT_U_HLOC
..S RESULT(CNT+1)=REC
Q
;
ACTDATE(IEN) ;Returns the date of the first ORDER ACTION found
N VAL,SIEN
S SIEN=$O(^OR(100,+IEN,8,0))
Q:SIEN="" "" ;in case there are no order actions
S VAL=$P(^OR(100,+IEN,8,SIEN,0),U)
Q VAL
;
LWRDLOC ; Returns a list of ward locations from the WARD LOCATION file #42;ICR-6609
;Input - VIA("PATH")="LISTWARDLOCATION" [required]
; VIA("IENS")= Ward Location IEN, (multiple IENs separated by comma) [optional]
;Data returned
; .01 Name,.017 Specialty,.2 IsCurrentlyOutOfService
N VIAFILE,VIAFIELDS,VIAFLAGS,TVIAIENS
S VIAFILE=42,VIAFIELDS="@;.01;.017;.2",VIAFLAGS="IP"
I VIAIENS'="" S TVIAIENS=VIAIENS S VIAIENS="",VIAMAX=""
D LDIC
I $G(TVIAIENS)'="" S VIAIENS=TVIAIENS D PIENS^VIABMS1
Q
;
MOVTYP ; Returns a list of facility movement type from the FACILITY MOVEMENT TYPE file #405.1;ICR-6610
;Input - VIA("PATH")="LISTFACILITYMOVEMENTTYPE" [required]
; VIA("IENS")= Facility Movement Type IEN, (multiple IENs separated by comma) [optional]
;Data returned
; .01 Name,.04 Active
N VIAFILE,VIAFIELDS,VIAFLAGS,TVIAIENS
S VIAFILE=405.1,VIAFIELDS="@;.01;.04",VIAFLAGS="IP"
I VIAIENS'="" S TVIAIENS=VIAIENS S VIAIENS="",VIAMAX=""
D LDIC
I $G(TVIAIENS)'="" S VIAIENS=TVIAIENS D PIENS^VIABMS1
Q
;
DTCHK(RESULT,VIASDT,VIAEDT) ;check/set date
I (VIASDT="")!(VIAEDT="") S VIAER="Missing Date Parameters" D ERR(VIAER) Q
S VIASDT=VIASDT-.000001,VIAEDT=$S(VIAEDT[".":VIAEDT+.000001,1:VIAEDT+.999999)
;S VIASDT=$S(VIASDT[VIASDT[".":VIASDT,1:VIASDT-.000001),VIAEDT=$S(VIAEDT[".":VIAEDT+.000001,1:VIAEDT+.999999)
Q
;
PATCHK(DFN) ;check if patient is valid in File #2
D PID^VADPT
I $G(VAERR) S VIAER="Invalid Patient IEN" D ERR(VIAER)
K VA,VAERR
Q
;
GDIQ ;Runs GETS^DIQ
N VIADATA,VIAERR,Y,VIAFLD,N,X,J,C
D GETS^DIQ(VIAFILE,VIAIENS,VIAFIELDS,VIAFLAGS,"VIADATA","VIAERR")
S N=0
D SET("[Data]")
S VIAFLD=0 F S VIAFLD=$O(VIADATA(VIAFILE,VIAIENS,VIAFLD)) Q:'VIAFLD D
. S X=VIAFILE_"^"_$E(VIAIENS,1,$L(VIAIENS)-1)_"^"_VIAFLD_"^"
. ; -- below call to $$GET1 is too slow...working w/FM team for speed
. ;IF $$GET1^DID(VIAFILE,VIAFLD,"","TYPE")="WORD-PROCESSING" D
. IF $P($G(^DD(VIAFILE,VIAFLD,0)),U,4)[";0" D
. . D SET(X_"[WORD PROCESSING]")
. . S J=0 F S J=$O(VIADATA(VIAFILE,VIAIENS,VIAFLD,J)) Q:'J D
. . . D SET(VIADATA(VIAFILE,VIAIENS,VIAFLD,J))
. . D SET("$$END$$")
. E D
. . D SET(X_$G(VIADATA(VIAFILE,VIAIENS,VIAFLD,"I"))_"^"_$G(VIADATA(VIAFILE,VIAIENS,VIAFLD,"E")))
;
IF $D(VIAERR) D
. D SET("[ERROR]")
;
M RESULT=Y
Q
;
LDIC ;Runs LIST^DIC
N VIAERR,X,Y,I,N,VAL
I $G(VIAFROM)["~" S X=VIAFROM,VIAFROM=$P(X,"~"),VIAFROM("IEN")=$P(X,"~",2)
D LIST^DIC(VIAFILE,VIAIENS,VIAFIELDS,VIAFLAGS,VIAMAX,.VIAFROM,VIAPART,VIAXREF,VIASCRN,VIAID,"^TMP(""VIARSLT"",$J)","VIAERR")
I $D(VIAOK),VIAOK=0 K ^TMP("VIARSLT",$J),VIAOK Q
K VIAOK
S N=0
IF $G(VIAFROM)]"" D
. D SET("[Misc]")
. S X="MORE"_U_VIAFROM
. I $G(VIAFROM("IEN"))'="" S X=X_"~"_VIAFROM("IEN")
. D SET(X)
;
D SET("[Data]")
S I=0 F S I=$O(^TMP("VIARSLT",$J,"DILIST",I)) Q:'I D
.S VAL=$G(^TMP("VIARSLT",$J,"DILIST",I,0))
.D SET(VAL)
;
IF $D(VIAERR) D
. D SET("[Errors]")
. D SET($G(VIAERR("DIERR",1,"TEXT",1)))
;
M RESULT=Y
K ^TMP("VIARSLT",$J)
Q
;
SET(X) ;
S N=N+1
S Y(N)=X
Q
;
ERR(X) ;Error processing
N N
S N=0
D SET("[Errors]")
D SET(X)
M RESULT=Y
Q
;
KVAR ;Clean-up
K VIAFILE,VIAFIELDS,VIAIENS,VIAEDT,VIAFLAGS,VIAID,VIAMAX,VIAPART,VIASCRN,VIASDT,VIAVAL,VIAXREF,VIAFROM
K VIAPIEN,VIACIEN,VIAMDT,VIAMTYP,VIATO,VIALEDT,VIASSN,VIAA,VIAB,VIAC,VIAD,VIAR,VIAV,VIAX,VIAOIEN,VIA3,X,Y,VIAOI
Q
;
GMVTR(IENS) ;
N FLDS,OUT,MOUT,I,J,IEN,REC
S FLDS=".01;101;100;.02;.03;.04;.06;.07;.14"
D GETS^DIQ(405,IENS,"@;"_FLDS,"IE","OUT","MOUT")
S REC=$P(IENS,",")
S $P(REC,U,2)=$G(OUT(405,IENS_",",.01,"I"))
S $P(REC,U,3)=$G(OUT(405,IENS_",",101,"I"))
S $P(REC,U,4)=$G(OUT(405,IENS_",",100,"I"))
S $P(REC,U,5)=$G(OUT(405,IENS_",",.02,"I"))
S $P(REC,U,6)=$G(OUT(405,IENS_",",.03,"I"))
S $P(REC,U,7)=$G(OUT(405,IENS_",",.04,"I"))
S $P(REC,U,8)=$G(OUT(405,IENS_",",.06,"I"))
S $P(REC,U,9)=$G(OUT(405,IENS_",",.07,"I"))
S $P(REC,U,10)=$G(OUT(405,IENS_",",.14,"I"))
Q REC
;
HNDL ;Finds PATH and linetag that needs to be executed for results
;;GETACTIVITY;GETACT
;;GETPATIENT;GETPAT
;;LISTPATIENTBYSSN;PATSSN
;;LISTADMITTEDPATIENTSFORUPDATE;LADMPAT
;;LISTADMITTEDPATIENTS;ADMTPAT
;;GETWARDLOCATIONS;WRDLOC
;;LISTHOSPITALLOCATIONS;HOSLOC^VIABMS2
;;LISTNEWPERSON;NEWPER
;;LISTSPECIALTY;SPLTY
;;LISTPATIENTAPPOINTMENT;PATAPPT
;;LISTCANCELORDERS;CANORDS
;;LISTWARDLOCATION;LWRDLOC
;;LISTFACILITYMOVEMENTTYPE;MOVTYP
;;LISTFACILITYTREATINGSPECIALTY;TRTSPTY^VIABMS1
;;LISTMASMOVEMENTTRANSACTIONTYPE;MASTYP^VIABMS1
;;LISTMEDICALCENTERDIVISION;MEDCTR^VIABMS1
;;LISTORDERABLEITEM;ORDITM^VIABMS1
;;LISTORDERSTATUS;ORDSTA^VIABMS1
;;LISTBEDSWITCH;BEDSWCH^VIABMS1
;;GETPATIENTMOVEMENT;GPATMVT^VIABMS2
;;LISTPATIENTMOVEMENT;LPATMVT^VIABMS1
;;LISTPATIENTMOVEMENTSBYADMISSION;APATMVT^VIABMS1
;;LISTSCHEDULEDADMISSION;SCHADM^VIABMS1
;;LISTROOMBED;RMBED^VIABMS1
;;LISTCLINICAPPOINTMENTS;CLNAPPT^VIABMS1
;;LISTPATIENT;LSTPAT2^VIABMS2
;;LISTORDERS;LSTORD^VIABMS4
;;LISTORDERACTIONS;ORDACT^VIABMS4
;;LISTORDERSOLD;LSTORD^VIABMS3
;;LISTORDERACTIONSOLD;ORDACT^VIABMS3
;;END
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVIABMS 19301 printed Sep 23, 2025@20:21:24 Page 2
VIABMS ;AAC/JMC,AFS/PB - VIA BMS RPCs ;10/31/17 14:34
+1 ;;1.0;VISTA INTEGRATION ADAPTER;**8,10,11,15,19**;06-FEB-2014;Build 1
+2 ;
+3 ;The routine is in support of the Bed Management System (BMS) and is linked to VIAB BMS RPC. The RPC
+4 ;determines what data is returned from what is passed in the input parameter VIA("PATH"). All BMS requests
+5 ;are handled by this one RPC.
+6 ;
+7 ; RPC VIAB BMS
+8 ; ICR 10035 PATIENT FILE
+9 ; ICR 10040 HOSPITAL LOCATION FILE [File #44;fields .01,1,42]
+10 ; ICR 10060 NEW PERSON FILE [File 200;fields .01,30] (supported)
+11 ; ICR 6609 WARD [Access to File #42;fields .01,.017,.2] (private)
+12 ; ICR 4782 CLINIC PHONE [File #44;field 99]
+13 ; ICR 2652 DBIA2652 [File #42.4;field .01] (controlled)
+14 ; ICR 4433 NAME: DBIA4433 [API SDAPI^SDAMA301] (supported)
+15 ; ICR 5771 ORDERS FILE DATA [File #100;field #5] (controlled)
+16 ; ICR 6610 FACILITY MOVEMENT File #405.1;fields .01,.04] (private)
+17 ; ICR 6607 SC PERCENTAGE [File #2;field .302] (private)
+18 ; ICR 10090 INSTITUTION FILE (supported)
+19 ; ICR 7140 ED LOG [File 230;"ADST" XREF from field 1.2]
+20 ; ICR 7141 TRACKING CODE [File 233.1;field .05]
+21 QUIT
+22 ;
EN(RESULT,VIA) ; entry point for RPC
+1 NEW VIATAG,VIAER
+2 SET VIATAG=""
+3 IF $ORDER(VIA(""))=""
SET VIAER="Missing Parameters"
DO ERR(VIAER)
QUIT
+4 IF $GET(VIA("PATH"))=""
SET VIAER="Missing PATH Parameters"
DO ERR(VIAER)
QUIT
+5 ; -- parse array to parameters
+6 DO PARSE(.VIA)
+7 DO PATH(.VIATAG)
+8 IF VIATAG'=""
DO @VIATAG
+9 DO KVAR
+10 QUIT
+11 ;
PARSE(VIA) ; -- array parsing to parameters
+1 SET VIAIENS=$GET(VIA("IENS"))
+2 SET VIAFLAGS=$GET(VIA("FLAGS"))
+3 SET VIAMAX=$GET(VIA("MAX"))
IF VIAMAX>5000
SET VIAMAX=5000
+4 ;I $G(VIAMAX)="" S VIAMAX=1000
+5 IF $GET(VIAMAX)=""
SET VIAMAX=5000
+6 SET VIAFROM=$GET(VIA("FROM"))
+7 ;search returns data up to a certain value for I.
SET VIATO=$GET(VIA("TO"))
+8 SET VIAPART=$GET(VIA("PART"))
+9 SET VIAXREF=$GET(VIA("XREF"))
+10 SET VIASCRN=$GET(VIA("SCREEN"))
+11 SET VIAID=$GET(VIA("ID"))
+12 SET VIASDT=$GET(VIA("SDATE"))
+13 SET VIAEDT=$GET(VIA("EDATE"))
+14 SET VIALEDT=$GET(VIA("LASTEDT"))
+15 SET VIAMDT=$GET(VIA("MOVDATE"))
+16 SET VIAMTYP=$GET(VIA("MOVTYPE"))
+17 SET VIAPIEN=$GET(VIA("PATIEN"))
+18 SET VIACIEN=$GET(VIA("CLNIEN"))
+19 SET VIAOIEN=$GET(VIA("ORDIEN"))
+20 SET VIASSN=$GET(VIA("SSN"))
+21 SET VIAVAL=$GET(VIA("VALUE"))
+22 QUIT
+23 ;
PATH(VIATAG) ;The PATH parameter determines the line tag executed and data returned by the RPC.
+1 NEW X,I
+2 SET X=""
+3 FOR I=1:1
SET X=$PIECE($TEXT(HNDL+I),";;",2)
if (X="END")!(X="")
QUIT
IF $$UP^XLFSTR(VIA("PATH"))=$PIECE(X,";")
SET VIATAG=$PIECE(X,";",2)
QUIT
+4 QUIT
+5 ;
GETACT ;returns activity from the ED LOG (#230) file
+1 ;Input - VIA("PATH")="GETACTIVITY" [required]
+2 ; VIA("FROM")=start date/time (exclusive) [required]
+3 ; VIA("TO")=end date/time (inclusive) [required]
+4 ;Data returned
+5 ;
+6 ;DISPOSITION TIME (#1.3)
+7 ;PATIENT ID (#.06)
+8 ;FACILITY ID (#.02)
+9 ;COMPLAINT (#1.1)
+10 ;DIAGNOSIS TIME (#1.4)
+11 ;
+12 NEW I,Y,NODE0,NODE1,VAL,DISP,DFN,INST,IEN,DISPI,TCFLGS,DISPI
+13 ;alias
if VIASDT=""
SET VIASDT=VIAFROM
+14 ;alias
if VIAEDT=""
SET VIAEDT=VIATO
+15 SET N=0
+16 DO SET("[Data]")
+17 SET I=VIASDT-.0000000001
+18 FOR
SET I=$ORDER(^EDP(230,"ADST",I))
if ((I="")!('$$BETWEEN(I,VIASDT,VIAEDT)))
QUIT
Begin DoDot:1
+19 SET IEN=""
+20 ;*19 added loop and changed conditionals
FOR
SET IEN=$ORDER(^EDP(230,"ADST",I,IEN))
if IEN=""
QUIT
Begin DoDot:2
+21 SET DISP=$$GET1^DIQ(230,IEN_",",1.2,"E")
+22 SET DISPI=$$GET1^DIQ(230,IEN_",",1.2,"I")
SET TCFLAG=$$UP^XLFSTR($$GET1^DIQ(233.1,DISPI_",",.05,"E"))
+23 ;only look at FLAGS = "VA"
+24 if (TCFLAG'="VA")
QUIT
+25 SET VAL=""
+26 SET NODE0=$GET(^EDP(230,IEN,0))
+27 SET NODE1=$GET(^EDP(230,IEN,1))
+28 ;DISPOSITION TIME (#1.3)
SET VAL=VAL_$PIECE(NODE1,U,3)
+29 ;PATIENT ID (#.06)
SET DFN=$PIECE(NODE0,U,6)
+30 SET VAL=VAL_U_DFN
+31 ;INSTITUTION (#.02)
SET INST=$PIECE(NODE0,U,2)
+32 ;station number
SET VAL=VAL_U_$$GET1^DIQ(4,INST_",",99)
+33 ;COMPLAINT (#1.1)
SET VAL=VAL_U_$PIECE(NODE1,U)
+34 ;DIAGNOSIS TIME (#1.4)
SET VAL=VAL_U_$PIECE(NODE1,U,4)
+35 DO SET(VAL)
+36 QUIT
End DoDot:2
+37 QUIT
End DoDot:1
+38 MERGE RESULT=Y
+39 QUIT
+40 ;
+41 ;If VIAA (resp. VIAB) is an exact date only match it against the date part of VIAX.
BETWEEN(VIAX,VIAA,VIAB) ;
+1 NEW LEX,REX,X1,X2
+2 SET LEX=$SELECT(VIAA[".":1,1:0)
+3 SET REX=$SELECT(VIAB[".":1,1:0)
+4 SET X1=$SELECT(LEX:VIAX,1:$PIECE(VIAX,"."))
+5 SET X2=$SELECT(REX:VIAX,1:$PIECE(VIAX,"."))
+6 QUIT ((X1'<VIAA)&(X2'>VIAB))
+7 ;
PRIMDX(VIADA) ;return primary diagnosis
+1 NEW I,PRIM,RES,IENS,DX
+2 SET I=0
SET RES=""
+3 FOR
SET I=$ORDER(^EDP(230,VIADA,4,I))
if I'>0
QUIT
Begin DoDot:1
+4 SET PRIM=$PIECE($GET(^EDP(230,VIADA,4,I,0)),U,3)
+5 IF PRIM
Begin DoDot:2
+6 SET IENS=I_","_VIADA_","
+7 SET DX=$$GET1^DIQ(230.04,IENS,.02,"E")
End DoDot:2
QUIT
End DoDot:1
+8 QUIT DX
+9 ;
GETPAT ;Returns patient information based on DFN from File #2;ICR-10035, ICR-6607
+1 ;Input - VIA("PATH")="GETPATIENT" [required]
+2 ; VIA("IENS")=Patient DFN, [required]
+3 ;Data returned
+4 ; .01 Name,.02 Sex,.03 DateOfBirth,.09 SocialSecurityNumber,.097 DateEnteredIntoFile,
+5 ; .103 TreatingSpecialty,, .1041 AttendingPhysician,.302 ServiceConnectedPercentage,.105 CurrentAdmission,.1 Diagnosis [Short] from File #405
+6 NEW VIAFILE,VIAFIELDS,VIAFLAGS,X,VAL
+7 IF VIAIENS=""
SET VIAER="Missing IENS Parameters"
DO ERR(VIAER)
QUIT
+8 SET VIAFILE=2
SET VIAFIELDS=".01;.02;.03;.09;.097;.103;.1041;.105;.109;.302"
SET VIAFLAGS="IE"
+9 DO GDIQ
+10 ; add Field .1 DIAGNOSIS [SHORT] from File #405 to result of .105 field in File #2.
+11 SET X=1
FOR
SET X=$ORDER(RESULT(X))
if 'X
QUIT
IF RESULT(X)["^.105^"
SET VAL=$PIECE(RESULT(X),U,4)
IF VAL'=""
SET VAL=$$GET1^DIQ(405,VAL,.1,"E")
SET $PIECE(RESULT(X),U,4)=$PIECE(RESULT(X),U,4)_"~"_VAL
QUIT
+12 QUIT
+13 ;
PATSSN ;Returns patient information based on SSN from File #2
+1 ;Input - VIA("PATH")="LISTPATIENTBYSSN" [required]
+2 ; VIA("SSN")=SSN [required]
+3 NEW DFN
+4 SET DFN=$ORDER(^DPT("SSN",VIASSN,""))
+5 IF DFN=""
SET VIAER="Invalid SSN"
DO ERR(VIAER)
QUIT
+6 SET VIAIENS=DFN_","
+7 DO GETPAT
+8 QUIT
+9 ;
LADMPAT ;Returns a list of admitted patients from File #2
+1 ;Input - VIA("PATH")="LISTADMITTEDPATIENTSFORUPDATE" [required]
+2 ; VIA("MAX")=n [optional]
+3 NEW VIAXREF,VIASCRN,X,VAL
+4 SET VIAXREF="ACA"
SET VIASCRN="I $D(^DPT(Y,.105))"
+5 DO GPAT
+6 ; add Field .1 DIAGNOSIS [SHORT] from File #405 to result of .105 field in File #2.
+7 SET X=1
FOR
SET X=$ORDER(RESULT(X))
if 'X
QUIT
SET VAL=$PIECE(RESULT(X),U,9)
IF VAL'=""
SET VAL=$$GET1^DIQ(405,VAL,.1,"E")
SET $PIECE(RESULT(X),U,9)=$PIECE(RESULT(X),U,9)_"~"_VAL
+8 QUIT
+9 ;
+10 ;This is the ORIGINAL implementation of LISTPATIENT
LSTPAT ;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 ;
+8 NEW VIAFILE,VIAFIELDS,VIAFLAGS,TVIAIENS,TRESULT,Y,Z,I,VALUE,FLDS,CNT,VALX,VIATSDT
+9 IF VIAIENS'=""
SET TVIAIENS=VIAIENS
SET VIAIENS=""
+10 IF $GET(TVIAIENS)'=""
Begin DoDot:1
+11 SET VIAFILE=2
SET VIAFIELDS=".01;.02;.03;.09;.097;.103;.109;.1041;.105;.302;"
SET VIAFLAGS="I"
+12 ;S FLDS=".1-2;.02-3;.03-4;.09-5;.097-6;.103-7;.1041-9;.105-9;.109-8;.302-11"
+13 SET FLDS="0.1-2;.02-3;.03-4;.09-5;.097-6;.103-7;.109-8;.1041-9;.105-10;.302-11"
+14 SET TRESULT(1)="[Data]"
SET CNT=1
SET VIA("MAX")=""
+15 FOR I=1:1:$LENGTH(TVIAIENS,",")
SET VIAIENS=$PIECE(TVIAIENS,",",I)
IF VIAIENS'=""
Begin DoDot:2
+16 SET $PIECE(VALUE,U)=VIAIENS
+17 SET VIAIENS=VIAIENS_","
+18 KILL RESULT
+19 DO GDIQ
+20 IF ($GET(RESULT(1))'["Data")!($GET(RESULT(2))="[ERROR]")
KILL RESULT
QUIT
+21 FOR Y=2:1:11
SET J=$PIECE($PIECE(FLDS,";",Y-1),"-",2)
SET $PIECE(VALUE,U,J)=$PIECE($GET(RESULT(Y)),U,4)
IF $GET(RESULT(Y))["^.105^"
Begin DoDot:3
+22 SET VAL=$PIECE($GET(RESULT(Y)),U,4)
IF VAL'=""
SET VAL=$$GET1^DIQ(405,VAL,.1,"E")
SET $PIECE(VALUE,U,J)=$PIECE(VALUE,U,J)_"~"_VAL
End DoDot:3
+23 SET CNT=CNT+1
SET TRESULT(CNT)=VALUE
+24 KILL RESULT
End DoDot:2
MERGE RESULT=TRESULT
End DoDot:1
QUIT
+25 ; If VIA("IENS") is not provided
IF '$TEST
Begin DoDot:1
+26 SET VIATSDT=(VIASDT\1)
+27 DO DTCHK(.RESULT,.VIASDT,.VIAEDT)
IF $DATA(RESULT)
QUIT
+28 SET VIAXREF="BMS"
+29 SET VIASCRN="S X=$P($G(^DPT(Y,0)),U,9) I X?.N S X=$P($G(^DPT(Y,0)),U,16) I X'<VIATSDT,X<VIAEDT"
+30 DO GPAT
+31 ; add Field .1 DIAGNOSIS [SHORT] from File #405 to result of .105 field in File #2.
+32 SET X=1
FOR
SET X=$ORDER(RESULT(X))
if 'X
QUIT
SET VAL=$PIECE(RESULT(X),U,9)
IF VAL'=""
SET VAL=$$GET1^DIQ(405,VAL,.1,"E")
SET $PIECE(RESULT(X),U,9)=$PIECE(RESULT(X),U,9)_"~"_VAL
End DoDot:1
+33 QUIT
+34 ;
GPAT ;Get patient data from File #2;ICR-10035,ICR-6607
+1 ;Data returned
+2 ; .01 Name,.02 Sex,.03 DateOfBirth,.09 SocialSecurityNumber,.097 DateEnteredIntoFile,.103 TreatingSpecialty
+3 ; .1041 AttendingPhysician,.302 ServiceConnectedPercentage,.105 CurrentAdmission, .109 ExcludeFromFacilityDir
+4 NEW VIAFILE,VIAFIELDS,VIAFLAGS
+5 SET VIAFILE=2
SET VIAFIELDS="@;.01;.02;.03;.09;.097;.103;.1041;.105;.109;.302"
SET VIAFLAGS="IP"
+6 DO LDIC
+7 QUIT
+8 ;
ADMTPAT ;Returns a list of admitted patients from File #2 up to the Admitted IEN;ICR-10035
+1 ;Input - VIA("PATH")="LISTADMITTEDPATIENTS" [required]
+2 ; VIA("TO")=Admission IEN [required]
+3 ; VIA("MAX")=n [optional]
+4 ;Data returned
+5 ; .01 Name,.09 Social Security Number,.101 Bed Name,.102 Movement IEN,.105 Admitting Diagnosis,.1 Ward Name
+6 NEW VIAFILE,VIAFIELDS,VIASCRN,VIAFLAGS
+7 IF VIATO=""
SET VIAER="Missing Admission IEN Parameter"
DO ERR(VIAER)
QUIT
+8 SET VIAFILE=2
SET VIAFIELDS="@;.01;.09;.101;.102;.105;.1;"
SET VIATO=VIATO+.01
SET VIAXREF="ACA"
+9 SET VIASCRN="I $D(^DPT(Y,.105)),$P(^DPT(Y,.105),U,1)<"_VIATO
SET VIAFLAGS="IP"
+10 DO LDIC
+11 QUIT
+12 ;
WRDLOC ;Returns information for a ward from File #42;ICR-6609
+1 ;Input - VIA("PATH")="GETWARDLOCATIONS" [required]
+2 ; VIA("IENS")=Ward IEN, [required]
+3 ;Data returned
+4 ; .01 Name, .017 Specialty, .2 IsCurrentlyOutOfService
+5 NEW VIAFILE,VIAFIELDS
+6 IF VIAIENS=""
SET VIAER="Missing Ward IEN"
DO ERR(VIAER)
QUIT
+7 SET VIAFILE=42
SET VIAFIELDS=".01;.017;.2;"
SET VIAFLAGS="IE"
+8 DO GDIQ
+9 QUIT
+10 ;
NEWPER ;Returns a list of people from the NEW PERSON file #200 for a date range on DATE ENTERED Field (#30)
+1 ;Input - VIA("PATH")="LISTNEWPERSON" [required]
+2 ; VIA("IENS")=New Person IEN, (multiple IENs separated by comma) [optional]
+3 ; VIA("SDATE")=Start Date for search [required, if VIA(IENS) not present]
+4 ; VIA("EDATE")=End Date for search [required, if VIA(IENS) not present
+5 ;Data returned;ICR #10060
+6 ; .01 Name, 30 Date Entered
+7 NEW VIAFILE,VIAFIELDS,VIAFLAGS,TVIAIENS,TRESULT
+8 SET VIAFILE=200
SET VIAFIELDS="@;.01;30;"
SET VIAFLAGS="IP"
SET VIAXREF="B"
+9 IF VIAIENS'=""
SET TVIAIENS=VIAIENS
SET VIAIENS=""
+10 IF $GET(TVIAIENS)'=""
SET VIAFIELDS=".01;30;"
SET VIAFLAGS="I"
Begin DoDot:1
+11 SET TRESULT(1)="[Data]"
SET CNT=1
+12 FOR I=1:1:$LENGTH(TVIAIENS,",")
SET VIAIENS=$PIECE(TVIAIENS,",",I)
IF VIAIENS'=""
Begin DoDot:2
+13 SET VIAIENS=VIAIENS_","
+14 KILL RESULT
+15 DO GDIQ
+16 IF $GET(RESULT(1))'["Data"
QUIT
+17 SET CNT=CNT+1
SET TRESULT(CNT)=$TRANSLATE(VIAIENS,",")_"^"_$PIECE($GET(RESULT(2)),U,4)
+18 KILL RESULT
End DoDot:2
MERGE RESULT=TRESULT
End DoDot:1
QUIT
+19 ; If VIA("IENS") is not provided
IF '$TEST
Begin DoDot:1
+20 DO DTCHK(.RESULT,.VIASDT,.VIAEDT)
IF $DATA(RESULT)
QUIT
+21 SET VIASCRN="S X=$P($G(^(1)),U,7) I X>VIASDT,X<VIAEDT"
+22 DO LDIC
End DoDot:1
+23 QUIT
+24 ;
SPLTY ;Returns a list of specialties from the SPECIALTY file #42.4;ICR-2652
+1 ;Input - VIA("PATH")="LISTSPECIALTY" [required]
+2 ; VIA("IENS")= Specialty IEN, (multiple IENs separated by comma) [optional]
+3 ;Data returned
+4 ; .01 Name
+5 NEW VIAFILE,VIAFIELDS,VIAFLAGS,TVIAIENS
+6 SET VIAFILE=42.4
SET VIAFIELDS="@;.01;"
SET VIAFLAGS="IP"
+7 IF VIAIENS'=""
SET TVIAIENS=VIAIENS
SET VIAIENS=""
SET VIAMAX=""
+8 DO LDIC
+9 IF $GET(TVIAIENS)'=""
SET VIAIENS=TVIAIENS
DO PIENS^VIABMS1
+10 QUIT
+11 ;
PATAPPT ; Returns a list of patient appointments using API SDAPI^SDAMA301;ICR-4433
+1 ;Input - VIA("PATH")="LISTPATIENTAPPOINTMENT" [required]
+2 ; VIA("IENS")=Patient IEN [required]
+3 ; VIA("CLNIEN")=Hospital Location IEN [optional]
+4 ; VIA("SDATE")=Start Date for search [optional]
+5 ; VIA("EDATE")=End Date for search [optional]
+6 ;Data returned
+7 ; .01 HospitalLocation, 20 DateAppointmentMade, 100 CurrentStatus
+8 NEW VIARRAY,CNT,VIADT,VIADFNS,VIAPPT,VIACNT,CLNIEN,RCNT,QFLG,I
+9 IF VIAIENS=""
SET VIAER="Missing PATIENT IEN"
DO ERR(VIAER)
QUIT
+10 ;I (VIASDT'="")!(VIAEDT'="") D DTCHK(.RESULT,.VIASDT,.VIAEDT) I $D(RESULT) Q ;$$SDAPI^SDAMA301 handles dates differently
+11 SET VIADFN=$TRANSLATE(VIAIENS,",",";")
SET VIACIEN=$TRANSLATE(VIACIEN,",",";")
+12 SET VIAEDT=$SELECT(VIAEDT="":DT,1:VIAEDT)
+13 SET RESULT(1)="[Data]"
SET CNT=1
SET RCNT=1
SET QFLG=0
SET MORE=""
+14 SET VIARRAY(1)=VIASDT_";"_VIAEDT
+15 IF VIACIEN'=""
SET VIARRAY(2)=VIACIEN
+16 SET VIARRAY(4)=VIADFN
+17 SET VIARRAY("FLDS")="1;2;4;16;22"
+18 SET VIACNT=$$SDAPI^SDAMA301(.VIARRAY)
+19 IF VIACNT<1
GOTO PATAPPTQ
+20 IF VIACNT<1
QUIT
+21 SET VIADFN=$SELECT(VIAFROM'="":$PIECE(VIAFROM,"~")-1,1:0)
+22 FOR
SET VIADFN=$ORDER(^TMP($JOB,"SDAMA301",VIADFN))
if 'VIADFN
QUIT
Begin DoDot:1
+23 IF ($PIECE(VIAFROM,"~")>0)
IF $PIECE(VIAFROM,"~")'=VIADFN
SET VIAFROM=""
+24 SET CLNIEN=$SELECT(VIAFROM'="":$PIECE(VIAFROM,"~",2)-1,1:0)
+25 FOR
SET CLNIEN=$ORDER(^TMP($JOB,"SDAMA301",VIADFN,CLNIEN))
if 'CLNIEN
QUIT
Begin DoDot:2
+26 IF ($PIECE(VIAFROM,"~",2)>0)
IF $PIECE(VIAFROM,"~",2)'=CLNIEN
SET VIAFROM=""
+27 SET VIADT=$SELECT((VIAFROM'="")&(RCNT=1):$PIECE(VIAFROM,"~",3),1:0)
+28 FOR
SET VIADT=$ORDER(^TMP($JOB,"SDAMA301",VIADFN,CLNIEN,VIADT))
if 'VIADT
QUIT
Begin DoDot:3
+29 ;appointment data
SET VIAPPT=$GET(^TMP($JOB,"SDAMA301",VIADFN,CLNIEN,VIADT))
+30 SET CNT=CNT+1
SET RCNT=RCNT+1
SET RESULT(CNT)=VIADT_"^"_CLNIEN_"^"_$PIECE(VIAPPT,"^",16)_"^"_$PIECE($PIECE(VIAPPT,"^",22),";",3)_"^"_$PIECE($PIECE(VIAPPT,"^",4),";")
+31 IF RCNT>VIAMAX
Begin DoDot:4
+32 SET MORE="MORE^"_VIADFN_"~"_CLNIEN_"~"_VIADT
SET QFLG=1
End DoDot:4
End DoDot:3
IF RCNT>VIAMAX
QUIT
End DoDot:2
if $GET(QFLG)
QUIT
End DoDot:1
if $GET(QFLG)
QUIT
+33 IF QFLG
Begin DoDot:1
+34 MERGE TARRAY=RESULT
+35 KILL RESULT
+36 SET CNT=3
SET I=0
SET RESULT(1)="[Misc]"
SET RESULT(2)=MORE
SET RESULT(3)="[Data]"
+37 FOR
SET I=$ORDER(TARRAY(I))
if 'I
QUIT
Begin DoDot:2
+38 IF TARRAY(I)["[Data"
QUIT
+39 SET CNT=CNT+1
SET RESULT(CNT)=TARRAY(I)
End DoDot:2
End DoDot:1
PATAPPTQ KILL ^TMP($JOB,"SDAMA301")
+1 QUIT
+2 ;
CANORDS ; Returns a list of cancelled orders from the ORDER file #100;ICR-5771
+1 ;Input - VIA("PATH")="LISTCANCELORDERS" [required]
+2 ; VIA("IENS")=list of Order IENs [required]
+3 ;Data returned:
+4 ;Order file IEN
+5 ;Date of 1st ORDER ACTION
+6 ;Status
+7 ;Object of order
+8 ;Hospital location
+9 IF VIAIENS=""
SET VIAER="Missing ORDER IEN"
DO ERR(VIAER)
QUIT
+10 NEW I,IEN,IENS,NMBR,PAT,ACTDT,STATUS,HLOC,DATE,REC,CNT
+11 SET RESULT(1)="[Data]"
+12 SET CNT=0
+13 FOR I=1:1:$LENGTH(VIAIENS,",")
Begin DoDot:1
+14 SET IEN=$PIECE(VIAIENS,",",I)
+15 if $SELECT(+IEN'=IEN
Begin DoDot:2
+16 SET IENS=IEN_","
+17 SET CNT=CNT+1
+18 ;really OBJECT OF ORDER
SET PAT=$$GET1^DIQ(100,IENS,.02,"I")
+19 SET ACTDT=$$ACTDATE(VIAIENS)
+20 SET STATUS=$$GET1^DIQ(100,IENS,5,"E")
+21 SET HLOC=$$GET1^DIQ(100,IENS,6,"I")
+22 SET REC=IEN_U_ACTDT_U_STATUS_U_PAT_U_HLOC
+23 SET RESULT(CNT+1)=REC
End DoDot:2
End DoDot:1
+24 QUIT
+25 ;
ACTDATE(IEN) ;Returns the date of the first ORDER ACTION found
+1 NEW VAL,SIEN
+2 SET SIEN=$ORDER(^OR(100,+IEN,8,0))
+3 ;in case there are no order actions
if SIEN=""
QUIT ""
+4 SET VAL=$PIECE(^OR(100,+IEN,8,SIEN,0),U)
+5 QUIT VAL
+6 ;
LWRDLOC ; Returns a list of ward locations from the WARD LOCATION file #42;ICR-6609
+1 ;Input - VIA("PATH")="LISTWARDLOCATION" [required]
+2 ; VIA("IENS")= Ward Location IEN, (multiple IENs separated by comma) [optional]
+3 ;Data returned
+4 ; .01 Name,.017 Specialty,.2 IsCurrentlyOutOfService
+5 NEW VIAFILE,VIAFIELDS,VIAFLAGS,TVIAIENS
+6 SET VIAFILE=42
SET VIAFIELDS="@;.01;.017;.2"
SET VIAFLAGS="IP"
+7 IF VIAIENS'=""
SET TVIAIENS=VIAIENS
SET VIAIENS=""
SET VIAMAX=""
+8 DO LDIC
+9 IF $GET(TVIAIENS)'=""
SET VIAIENS=TVIAIENS
DO PIENS^VIABMS1
+10 QUIT
+11 ;
MOVTYP ; Returns a list of facility movement type from the FACILITY MOVEMENT TYPE file #405.1;ICR-6610
+1 ;Input - VIA("PATH")="LISTFACILITYMOVEMENTTYPE" [required]
+2 ; VIA("IENS")= Facility Movement Type IEN, (multiple IENs separated by comma) [optional]
+3 ;Data returned
+4 ; .01 Name,.04 Active
+5 NEW VIAFILE,VIAFIELDS,VIAFLAGS,TVIAIENS
+6 SET VIAFILE=405.1
SET VIAFIELDS="@;.01;.04"
SET VIAFLAGS="IP"
+7 IF VIAIENS'=""
SET TVIAIENS=VIAIENS
SET VIAIENS=""
SET VIAMAX=""
+8 DO LDIC
+9 IF $GET(TVIAIENS)'=""
SET VIAIENS=TVIAIENS
DO PIENS^VIABMS1
+10 QUIT
+11 ;
DTCHK(RESULT,VIASDT,VIAEDT) ;check/set date
+1 IF (VIASDT="")!(VIAEDT="")
SET VIAER="Missing Date Parameters"
DO ERR(VIAER)
QUIT
+2 SET VIASDT=VIASDT-.000001
SET VIAEDT=$SELECT(VIAEDT[".":VIAEDT+.000001,1:VIAEDT+.999999)
+3 ;S VIASDT=$S(VIASDT[VIASDT[".":VIASDT,1:VIASDT-.000001),VIAEDT=$S(VIAEDT[".":VIAEDT+.000001,1:VIAEDT+.999999)
+4 QUIT
+5 ;
PATCHK(DFN) ;check if patient is valid in File #2
+1 DO PID^VADPT
+2 IF $GET(VAERR)
SET VIAER="Invalid Patient IEN"
DO ERR(VIAER)
+3 KILL VA,VAERR
+4 QUIT
+5 ;
GDIQ ;Runs GETS^DIQ
+1 NEW VIADATA,VIAERR,Y,VIAFLD,N,X,J,C
+2 DO GETS^DIQ(VIAFILE,VIAIENS,VIAFIELDS,VIAFLAGS,"VIADATA","VIAERR")
+3 SET N=0
+4 DO SET("[Data]")
+5 SET VIAFLD=0
FOR
SET VIAFLD=$ORDER(VIADATA(VIAFILE,VIAIENS,VIAFLD))
if 'VIAFLD
QUIT
Begin DoDot:1
+6 SET X=VIAFILE_"^"_$EXTRACT(VIAIENS,1,$LENGTH(VIAIENS)-1)_"^"_VIAFLD_"^"
+7 ; -- below call to $$GET1 is too slow...working w/FM team for speed
+8 ;IF $$GET1^DID(VIAFILE,VIAFLD,"","TYPE")="WORD-PROCESSING" D
+9 IF $PIECE($GET(^DD(VIAFILE,VIAFLD,0)),U,4)[";0"
Begin DoDot:2
+10 DO SET(X_"[WORD PROCESSING]")
+11 SET J=0
FOR
SET J=$ORDER(VIADATA(VIAFILE,VIAIENS,VIAFLD,J))
if 'J
QUIT
Begin DoDot:3
+12 DO SET(VIADATA(VIAFILE,VIAIENS,VIAFLD,J))
End DoDot:3
+13 DO SET("$$END$$")
End DoDot:2
+14 IF '$TEST
Begin DoDot:2
+15 DO SET(X_$GET(VIADATA(VIAFILE,VIAIENS,VIAFLD,"I"))_"^"_$GET(VIADATA(VIAFILE,VIAIENS,VIAFLD,"E")))
End DoDot:2
End DoDot:1
+16 ;
+17 IF $DATA(VIAERR)
Begin DoDot:1
+18 DO SET("[ERROR]")
End DoDot:1
+19 ;
+20 MERGE RESULT=Y
+21 QUIT
+22 ;
LDIC ;Runs LIST^DIC
+1 NEW VIAERR,X,Y,I,N,VAL
+2 IF $GET(VIAFROM)["~"
SET X=VIAFROM
SET VIAFROM=$PIECE(X,"~")
SET VIAFROM("IEN")=$PIECE(X,"~",2)
+3 DO LIST^DIC(VIAFILE,VIAIENS,VIAFIELDS,VIAFLAGS,VIAMAX,.VIAFROM,VIAPART,VIAXREF,VIASCRN,VIAID,"^TMP(""VIARSLT"",$J)","VIAERR")
+4 IF $DATA(VIAOK)
IF VIAOK=0
KILL ^TMP("VIARSLT",$JOB),VIAOK
QUIT
+5 KILL VIAOK
+6 SET N=0
+7 IF $GET(VIAFROM)]""
Begin DoDot:1
+8 DO SET("[Misc]")
+9 SET X="MORE"_U_VIAFROM
+10 IF $GET(VIAFROM("IEN"))'=""
SET X=X_"~"_VIAFROM("IEN")
+11 DO SET(X)
End DoDot:1
+12 ;
+13 DO SET("[Data]")
+14 SET I=0
FOR
SET I=$ORDER(^TMP("VIARSLT",$JOB,"DILIST",I))
if 'I
QUIT
Begin DoDot:1
+15 SET VAL=$GET(^TMP("VIARSLT",$JOB,"DILIST",I,0))
+16 DO SET(VAL)
End DoDot:1
+17 ;
+18 IF $DATA(VIAERR)
Begin DoDot:1
+19 DO SET("[Errors]")
+20 DO SET($GET(VIAERR("DIERR",1,"TEXT",1)))
End DoDot:1
+21 ;
+22 MERGE RESULT=Y
+23 KILL ^TMP("VIARSLT",$JOB)
+24 QUIT
+25 ;
SET(X) ;
+1 SET N=N+1
+2 SET Y(N)=X
+3 QUIT
+4 ;
ERR(X) ;Error processing
+1 NEW N
+2 SET N=0
+3 DO SET("[Errors]")
+4 DO SET(X)
+5 MERGE RESULT=Y
+6 QUIT
+7 ;
KVAR ;Clean-up
+1 KILL VIAFILE,VIAFIELDS,VIAIENS,VIAEDT,VIAFLAGS,VIAID,VIAMAX,VIAPART,VIASCRN,VIASDT,VIAVAL,VIAXREF,VIAFROM
+2 KILL VIAPIEN,VIACIEN,VIAMDT,VIAMTYP,VIATO,VIALEDT,VIASSN,VIAA,VIAB,VIAC,VIAD,VIAR,VIAV,VIAX,VIAOIEN,VIA3,X,Y,VIAOI
+3 QUIT
+4 ;
GMVTR(IENS) ;
+1 NEW FLDS,OUT,MOUT,I,J,IEN,REC
+2 SET FLDS=".01;101;100;.02;.03;.04;.06;.07;.14"
+3 DO GETS^DIQ(405,IENS,"@;"_FLDS,"IE","OUT","MOUT")
+4 SET REC=$PIECE(IENS,",")
+5 SET $PIECE(REC,U,2)=$GET(OUT(405,IENS_",",.01,"I"))
+6 SET $PIECE(REC,U,3)=$GET(OUT(405,IENS_",",101,"I"))
+7 SET $PIECE(REC,U,4)=$GET(OUT(405,IENS_",",100,"I"))
+8 SET $PIECE(REC,U,5)=$GET(OUT(405,IENS_",",.02,"I"))
+9 SET $PIECE(REC,U,6)=$GET(OUT(405,IENS_",",.03,"I"))
+10 SET $PIECE(REC,U,7)=$GET(OUT(405,IENS_",",.04,"I"))
+11 SET $PIECE(REC,U,8)=$GET(OUT(405,IENS_",",.06,"I"))
+12 SET $PIECE(REC,U,9)=$GET(OUT(405,IENS_",",.07,"I"))
+13 SET $PIECE(REC,U,10)=$GET(OUT(405,IENS_",",.14,"I"))
+14 QUIT REC
+15 ;
HNDL ;Finds PATH and linetag that needs to be executed for results
+1 ;;GETACTIVITY;GETACT
+2 ;;GETPATIENT;GETPAT
+3 ;;LISTPATIENTBYSSN;PATSSN
+4 ;;LISTADMITTEDPATIENTSFORUPDATE;LADMPAT
+5 ;;LISTADMITTEDPATIENTS;ADMTPAT
+6 ;;GETWARDLOCATIONS;WRDLOC
+7 ;;LISTHOSPITALLOCATIONS;HOSLOC^VIABMS2
+8 ;;LISTNEWPERSON;NEWPER
+9 ;;LISTSPECIALTY;SPLTY
+10 ;;LISTPATIENTAPPOINTMENT;PATAPPT
+11 ;;LISTCANCELORDERS;CANORDS
+12 ;;LISTWARDLOCATION;LWRDLOC
+13 ;;LISTFACILITYMOVEMENTTYPE;MOVTYP
+14 ;;LISTFACILITYTREATINGSPECIALTY;TRTSPTY^VIABMS1
+15 ;;LISTMASMOVEMENTTRANSACTIONTYPE;MASTYP^VIABMS1
+16 ;;LISTMEDICALCENTERDIVISION;MEDCTR^VIABMS1
+17 ;;LISTORDERABLEITEM;ORDITM^VIABMS1
+18 ;;LISTORDERSTATUS;ORDSTA^VIABMS1
+19 ;;LISTBEDSWITCH;BEDSWCH^VIABMS1
+20 ;;GETPATIENTMOVEMENT;GPATMVT^VIABMS2
+21 ;;LISTPATIENTMOVEMENT;LPATMVT^VIABMS1
+22 ;;LISTPATIENTMOVEMENTSBYADMISSION;APATMVT^VIABMS1
+23 ;;LISTSCHEDULEDADMISSION;SCHADM^VIABMS1
+24 ;;LISTROOMBED;RMBED^VIABMS1
+25 ;;LISTCLINICAPPOINTMENTS;CLNAPPT^VIABMS1
+26 ;;LISTPATIENT;LSTPAT2^VIABMS2
+27 ;;LISTORDERS;LSTORD^VIABMS4
+28 ;;LISTORDERACTIONS;ORDACT^VIABMS4
+29 ;;LISTORDERSOLD;LSTORD^VIABMS3
+30 ;;LISTORDERACTIONSOLD;ORDACT^VIABMS3
+31 ;;END
