- 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 Jan 18, 2025@03:46:22 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