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

VIABMS.m

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