- VIABMS1 ;AAC/JMC - VIA BMS RPCs ;04/15/2016
- ;;1.0;VISTA INTEGRATION ADAPTER;**8,11,13,14**;06-FEB-2014;Build 17
- ;
- ;The following RPC is in support of the Bed Management System (BMS). This RPC reads the parameter "Path"
- ;and determine from that parameter which data to return. All BMS requests are handled by this one RPC.
- ;Continuation of VIABMS
- ; RPC VIAB BMS
- ; ICR 1254 DIC(45.7, [field #1]
- ; ICR 2638 ORDER STATUS file direct access [Filed 100.01, field #.01]
- ; ICR 1359 DBIA1359 [File #45.7;field .01]
- ; ICR 433 DBIA433 [File #405.1;field .01]
- ; ICR 2438 DBIA2438 [File #40.8;field .01]
- ; ICR 2843 DBIA2843 [File #101.43;field .01] (controlled)
- ; ICR 2638 ORDER STATUS file direct access [File #100.01;field .01]
- ; ICR 6611 SCHEDULED ADMISSION [File 41.1;fields fields .01;2;3;4;5;6;8;9;11;12;13;14](private)
- ; ICR 1380 ROOM-BED [File #405.4;fields .01;.2;100](controlled)
- ; ICR 4433 NAME: DBIA4433 (API SDAPI^SDAMA301) [supported]
- ; ICR 1865 DBIA1865 [File #405;fields .01;.02;.03;.04;.06;.07;.14;100;101]
- ; ICR 6475 LIST ORDERS [File #100; fields .02;6;5;30;31;etc]
- Q
- ;
- TRTSPTY ; Returns a list of facility treating specialty from the FACILITY TREATING SPECIALTY file #45.7;ICR-1359
- ;Input - VIA("PATH")="LISTFACILITYTREATINGSPECIALTY" [required]
- ; VIA("IENS")= Facility Treating Specialty IEN, (multiple IENs separated by comma) [optional]
- ;Data returned
- ; .01 Name,1 Specialty ID
- N VIAFILE,VIAFIELDS,VIAFLAGS,TVIAIENS
- S VIAFILE=45.7,VIAFIELDS="@;.01;1",VIAFLAGS="IP"
- I VIAIENS'="" S TVIAIENS=VIAIENS S VIAIENS="",VIAMAX=""
- D LDIC^VIABMS
- I $G(TVIAIENS)'="" S VIAIENS=TVIAIENS D PIENS
- Q
- ;
- PIENS ; multiple IENs; parse IENS
- N TRESULT,IEN,I,CNT,X
- I '$D(RESULT) Q
- M TRESULT=RESULT
- K RESULT
- S RESULT(1)="[Data]",CNT=1
- F I=1:1:$L(VIAIENS,",") S IEN=$P(VIAIENS,",",I) I IEN'="" S IEN(IEN)=""
- S X=0 F S X=$O(TRESULT(X)) Q:'X S IEN=$P(TRESULT(X),U) I IEN'="",$D(IEN(IEN)) D
- . S CNT=CNT+1,RESULT(CNT)=TRESULT(X)
- Q
- ;
- MASTYP ; Returns a list of MAS movement transaction type from the MAS MOVEMENT TRANSACTION TYPE file #405.3;ICR-433
- ;Input - VIA("PATH")="LISTMASMOVEMENTTRANSACTIONTYPE" [required]
- ;Data returned
- ; .01 Name
- N VIAFILE,VIAFIELDS,VIAFLAGS
- S VIAFILE=405.3,VIAFIELDS="@;.01",VIAFLAGS="IP"
- D LDIC^VIABMS
- Q
- ;
- MEDCTR ; Returns a list of Medical Center division from the MEDICAL CENTER DIVISION file #40.8;ICR-2438
- ;Input - VIA("PATH")="LISTMEDICALCENTERDIVISION" [required]
- ; VIA("IENS")= Medical Center Division IEN, (multiple IENs separated by comma) [optional]
- ;Data returned
- ; .01 Name
- N VIAFILE,VIAFIELDS,VIAFLAGS,TVIAIENS
- S VIAFILE=40.8,VIAFIELDS="@;.01",VIAFLAGS="IP"
- I VIAIENS'="" S TVIAIENS=VIAIENS S VIAIENS="",VIAMAX=""
- D LDIC^VIABMS
- I $G(TVIAIENS)'="" S VIAIENS=TVIAIENS D PIENS
- Q
- ;
- ORDITM ; Returns a list of orderable items from the ORDERABLE ITEMS file #101.43;ICR-2843
- ;Input - VIA("PATH")="LISTORDERABLEITEM" [required]
- ;Data returned
- ; .01 Name
- N VIAFILE,VIAFIELDS,VIAFLAGS,VIAXREF
- S VIAFILE=101.43,VIAFIELDS="@;.01",VIAFLAGS="IPQ",VIAXREF="#"
- D LDIC^VIABMS
- Q
- ;
- ORDSTA ; Returns a list of Medical Center division from the ORDER STATUS file #100.01;ICR-2638
- ;Input - VIA("PATH")="LISTORDERSTATUS" [required]
- ; VIA("IENS")= Order Status IEN, (multiple IENs separated by comma) [optional]
- ;Data returned
- ; .01 Name
- N VIAFILE,VIAFIELDS,VIAFLAGS,TVIAIENS
- S VIAFILE=100.01,VIAFIELDS="@;.01",VIAFLAGS="IP"
- I VIAIENS'="" S TVIAIENS=VIAIENS S VIAIENS="",VIAMAX=""
- D LDIC^VIABMS
- I $G(TVIAIENS)'="" S VIAIENS=TVIAIENS D PIENS
- Q
- ;
- BEDSWCH ; Returns a list of bed switch from the PATIENT MOVEMENT file #405;ICR-1865
- ;Input - VIA("PATH")="LISTBEDSWITCH" [required]
- ; VIA("IENS")="Patient Movement IEN" (multiple IENs separated by a comma) [required]
- ;Data returned
- ; .06 WardLocationId,.07 RoomBedId
- N VIAFILE,VIAFIELDS,VIAFLAGS,I,VIATIEN,VIAIEN,TRESULT,X,N,I,VAL
- I VIAIENS="" S VIAER="Missing MOVEMENT IEN" D ERR^VIABMS(VIAER) Q
- S VIAFILE=405,VIAFIELDS=".06;.07",VIAFLAGS="IE"
- S TRESULT(1)="[Data]",CNT=1
- ; multiple IENs
- S VIATIEN=VIAIENS
- F I=1:1:$L(VIATIEN,",") S VIAIEN=$P(VIATIEN,",",I) I VIAIEN'="" D
- . S VIAIENS=VIAIEN_","
- . K RESULT
- . D GDIQ^VIABMS
- . I $G(RESULT(1))'["Data" Q
- . S VAL=$P($G(RESULT(2)),U,1,2)_U_$TR($P($G(RESULT(2)),U,4,5),"^",";")_U_$TR($P($G(RESULT(3)),U,4,5),"^",";")
- . S CNT=CNT+1,TRESULT(CNT)=VAL
- . K RESULT
- M RESULT=TRESULT
- ;
- Q
- N VIAFILE,VIAFIELDS,VIAFLAGS,I,VIATIEN,VIAIEN,TRESULT,X,N,I
- I VIAIENS="" S VIAER="Missing MOVEMENT IEN" D ERR^VIABMS(VIAER) Q
- S VIAFILE=405,VIAFIELDS=".06;.07",VIAFLAGS="IE"
- ; multiple IENs
- S VIATIEN=VIAIENS
- F I=1:1:$L(VIATIEN,",") S VIAIEN=$P(VIATIEN,",",I) I VIAIEN'="" D
- . S VIAIENS=VIAIEN_"," D GDIQ^VIABMS
- . I '$D(TRESULT) M TRESULT=RESULT K RESULT Q
- . S X=0,N=$O(TRESULT(""),-1) F S X=$O(RESULT(X)) Q:'X S N=N+1 S TRESULT(N)=RESULT(X)
- . K RESULT
- M RESULT=TRESULT
- Q
- ;
- GPATMVT ; Returns a patient movement records from the PATIENT MOVEMENT file #405;ICR-1865
- ;Input - VIA("PATH")="GETPATIENTMOVEMENT" [required]
- ; VIA("IENS")="Patient Movement IEN" [required, optional if no other parameter]
- ; VIA("MOVDATE")=Movement Date [optional, required if no Patient Movement IEN]
- ; VIA("MOVTYPE")=Movement Type [optional, required if no Patient Movement IEN]
- ; VIA("PATIEN")=Patient IEN [optional, required if no Patient Movement IEN]
- ;Data returned
- ; .01 MovementDate,101 EnteredDate,100 Entered By,.02 TransactionTypeId,.03 PatientIen,
- ; .04 TypeOfMovementIen,.06 WardLocationId,.07 RoomBedId,.14 CurrentAdmissionIen
- N VIAFILE,VIAFIELDS,VIAFLAGS,VIASCRN,I,VIACNT
- S VIAIENS=$P(VIAIENS,",")
- S VIAFILE=405,VIAFIELDS=".01;101;100;.02;.03;.04;.06;.07;.14"
- I VIAIENS="",VIAMDT="",VIAMTYP="",VIAPIEN="" S VIAER="Missing Input parameters" D ERR^VIABMS(VIAER) Q
- I VIAPIEN'="" D PATCHK^VIABMS(VIAPIEN) I $D(RESULT) Q
- I VIAPIEN'=""&(VIAMDT'="")&(VIAIENS="") D G GPATMVT2
- .F S VIAIENS=$O(^DGPM("ADFN"_VIAPIEN,VIAMDT,VIAIENS)) Q:VIAIENS="" D
- ..I '$G(VIACNT) S RESULT(1)="[Data]" S VIACNT=2
- ..S RESULT(VIACNT)=$$GMVTR^VIABMS(VIAIENS),VIACNT=VIACNT+1
- I VIAIENS'="" D Q
- .S RESULT(1)="[Data]"
- .S RESULT(2)=$$GMVTR^VIABMS(VIAIENS)
- GPATMVT2 ;
- S VIAFIELDS="@;"_VIAFIELDS,VIAFLAGS="IP"
- ;VIAMTYPE is actually TRANSACTION, not MOVEMENT TYPE.
- S VIASCRN="S X=$G(^(0)) I $P(X,U)=VIAMDT,$P(X,U,2)=VIAMTYP,$P(X,U,3)=VIAPIEN"
- D LDIC^VIABMS
- Q
- ;
- LPATMVT ; Returns a list of patient movement records from the PATIENT MOVEMENT file #405;ICR-1865
- ;Input - VIA("PATH")="LISTPATIENTMOVEMENT" [required]
- ; VIA("PATIEN")=Patient IEN [required, if no date range]
- ; VIA("SDATE")=Start Date for search [optional]
- ; VIA("EDATE")=End Date for search [optional]
- ; VIA("MAX")=n [optional]
- ;Data returned
- ; .01 MovementDate,101 EnteredDate,100 Entered By,.02 TransactionTypeId,.03 PatientIen,
- ; .04 TypeOfMovementIen,.06 WardLocationId,.07 RoomBedId,.14 CurrentAdmissionIen
- S VIAPIEN=$TR(VIAPIEN,",")
- I VIAPIEN="",VIASDT="",VIAEDT="" S VIAER="Missing Input Parameters" D ERR^VIABMS(VIAER) Q
- N VIADATA,START,END,STARTI,STARTJ,RES,MORED,OFFSET,I
- I VIAPIEN'="" D PATCHK^VIABMS(VIAPIEN) I $D(RESULT) Q
- S VIADATA=$NA(^TMP($J,"VIADATA"))
- K @VIADATA
- ;Parse VIAFROM to get STARTI and STARTJ
- S (STARTI,STARTJ)=0
- I VIAFROM'="" D
- .S STARTI=$P(VIAFROM,"~"),STARTJ=$P(VIAFROM,"~",2)
- S START=$S(VIASDT'="":VIASDT-.000001,1:0)
- S END=$S(VIAEDT="":9999999,VIAEDT[".":VIAEDT+.000001,1:VIAEDT+.99999999)
- S RES=$$WALK^VIABMS2(STARTI,STARTJ,VIAMAX,START,END)
- S MORED=$P(RES,U,3)
- I MORED D
- .S:$G(MORED) RESULT(1)="[Misc]"
- .S:$G(MORED) RESULT(2)="MORE^"_$P(RES,U)_"~"_$P(RES,U,2)
- .S RESULT($S($G(MORED):3,1:1))="[Data]"
- .S OFFSET=$S($G(MORED):4,1:2)
- E D
- .S RESULT(1)="[Data]"
- .S OFFSET=2
- S I=""
- F S I=$O(@VIADATA@(I)) Q:I="" S RESULT(I+OFFSET)=@VIADATA@(I)
- K @VIADATA
- Q
- ;
- MVTR(VIAIEN) ;
- N IENS,FLDS,OUT,MOUT,VAL,I,FLD
- S IENS=VIAIEN_","
- S FLDS=".01;101;100;.02;.03;.04;.06;.07;.14"
- D GETS^DIQ(405,IENS,FLDS,"I","OUT","MOUT")
- S VAL=VIAIEN
- F I=1:1:$L(FLDS,";") S $P(VAL,U,I+1)=$G(OUT(405,IENS,$P(FLDS,";",I),"I"))
- Q VAL
- ;
- ;
- APATMVT ; Returns patient movement record by admission IEN from the PATIENT MOVEMENT file #405;ICR-1865
- ;Input - VIA("PATH")="LISTPATIENTMOVEMENTSBYADMISSION" [required]
- ; VIA("PATIEN")=Movement IEN [required] Note: gets parsed as variable VIAPIEN
- ;Data returned
- ; IEN,.01 MovementDate,101 EnteredDate,100 Entered By,.02 TransactionTypeId,.03 PatientIen,
- ; .04 TypeOfMovementIen,.06 WardLocationId,.07 RoomBedId,.14 CurrentAdmissionIen
- N Y,N
- S N=0
- N I,J,CNT,END,FIRST,STARTI,STARTJ,VIADATA
- I VIAPIEN="" S VIAER="Missing Input Parameters" D ERR^VIABMS(VIAER) Q
- S VIADATA=$NA(^TMP($J,"VIADATA"))
- K @VIADATA
- N I,J,K,CNT,END,FIRST,STARTI,STARTJ,DONE,LASTJ
- S FIRST=1,DONE=0,LASTJ=""
- ;Parse VIAFROM to get STARTI and STARTJ
- S STARTI=$P(VIAFROM,"~"),STARTJ=$P(VIAFROM,"~",2)
- ;Traverse "CA" index, be sure to save last J
- S CNT=0
- S LASTJ=$G(J)
- S J=$S(FIRST:STARTJ,1:"")
- F S J=$O(^DGPM("CA",VIAPIEN,J)) Q:+J'>0!(CNT'<VIAMAX) D
- .S:J'="" LASTJ=J
- .I VIAPIEN=$P($G(^DGPM(J,0)),U,14) D
- ..S CNT=CNT+1
- ..;Store records temporarily in @VIADATA
- ..S @VIADATA@(CNT)=$$MVTR(J)
- ;[Misc] section comes first
- I CNT'<VIAMAX D
- .D SET^VIABMS("[Misc]")
- .D SET^VIABMS("MORE^"_VIAPIEN_"~"_LASTJ)
- ;Now, save [Data] section and kill temp. global
- D SET^VIABMS("[Data]")
- S K=0
- F S K=$O(@VIADATA@(K)) Q:K="" D SET^VIABMS(@VIADATA@(K))
- K @VIADATA
- M RESULT=Y
- Q
- ;
- SCHADM ; Returns a list of scheduled admissions from the SCHEDULED ADMISSION file #41.1;ICR-6611
- ;Input - VIA("PATH")="LISTSCHEDULEDADMISSION" [required]
- ; VIA("PATIEN")=Patient IEN [optional]
- ; VIA("SDATE")=Start Date for search [required]
- ; VIA("EDATE")=End Date for search [required]
- ; VIA("MAX")=n [optional]
- ;Data returned
- ; .01 PatientId,2 ReservationDateTime,3 LengthOfStayExpected,4 AdmittingDiagnosis,6 Surgery,8 WardLocation,
- ; 9 TreatingSpecialty,12 MedicalCenterDivision,13 DateTimeCancelled,14 CancelledBy,5 Provider,11 Scheduler
- N VIAFILE,VIAFIELDS,VIAFLAGS,VIASCRN,VIAER
- S VIAFILE=41.1,VIAFIELDS="@;.01;2;3;4;6;8;9;12;13;14;5;11",VIAFLAGS="IP"
- I VIAPIEN'="" D PATCHK^VIABMS(VIAPIEN) I $D(RESULT) Q
- I VIAPIEN'="" S VIASCRN="S X=$G(^DGS(41.1,Y,0)) I $P(X,U)=VIAPIEN"
- ;For the purposes of this call, VIASDT and VIEDT are treated instants in time, even if they are integers. For this reason,
- ;the call to DTCHK is not made. This also means it is necessary to explicitly test for VIASDT="" and VIAEDT="".
- I (VIAEDT="")!(VIASDT="") S VIAER="Missing date parameters." D ERR^VIABMS(VIAER) Q
- ;I (VIASDT'="")!(VIAEDT'="") D DTCHK^VIABMS(.RESULT,.VIASDT,.VIAEDT) I $D(RESULT) Q
- S VIASCRN=$S(($G(VIASCRN)'="")&(VIASDT'=""):VIASCRN_",$P(X,U,2)>=VIASDT,$P(X,U,2)<=VIAEDT",VIASDT'="":"S X=$P($G(^DGS(41.1,Y,0)),U,2) I X>=VIASDT,X<=VIAEDT",1:$G(VIASCRN))
- D LDIC^VIABMS
- Q
- ;
- RMBED ; Returns a list of room/beds from the ROOM-BED file #405.4;ICR-1380
- ;Input - VIA("PATH")="LISTROOMBED" [required]
- ; VIA("IENS")="Room Bed IEN" [required, optional if no other parameter]
- ; VIA("MAX")=n [optional]
- ; VIA("FROM")=string/value to start list [optional]
- ;Data returned
- ; .01 Name,.2 CurrentlyOutOfService,100 WardsWhichCanAssign
- N VIAFILE,VIAFIELDS,VIAFLAGS,TVIAIENS
- S VIAFILE=405.4,VIAFIELDS="@;.01;.2",VIAFLAGS="IP"
- I VIAIENS'="" S TVIAIENS=VIAIENS S VIAIENS="",VIAMAX=""
- S VIAID="S X="""" I $D(^DG(405.4,Y,""W"",0)) S VIAA="""" F S VIAA=$O(^DG(405.4,Y,""W"",VIAA)) S:VIAA>0 X=X_$S(X="""":"""",1:"","")_VIAA I VIAA="""" D EN^DDIOL(X) Q"
- D LDIC^VIABMS
- I $G(TVIAIENS)'="" S VIAIENS=TVIAIENS D PIENS
- Q
- ;
- CLNAPPT ; Returns a list of clinic appointments from the HOSPITAL LOCATION sub-file #44.001;ICR-#4433
- ;Input - VIA("PATH")="LISTCLINICAPPOINTMENTS" [required]
- ; VIA("IENS")=Clinic IEN [required]
- ; VIA("SDATE")=Start Date for search [optional]
- ; VIA("EDATE")=End Date for search [optional]
- ; VIA("MAX")=n [optional]
- ;Data returned
- ; .01 Appointment Date/Time, 2 Patients, Clinic
- N VIARRAY,VIARY,CNT,VIARRY,VIACNT,VIADT,VIADFN,VIAPPT,I,Y,J,FL,CLNIEN,MORE,TARRAY
- I VIAIENS="" S VIAER="Missing CLINIC IEN" D ERR^VIABMS(VIAER) Q
- ;I (VIASDT'="")!(VIAEDT'="") D DTCHK^VIABMS(.RESULT,.VIASDT,.VIAEDT) I $D(RESULT) Q
- S VIAEDT=$S(VIAEDT="":DT,1:VIAEDT)
- S CLNIEN=$TR(VIAIENS,",",";")
- S RESULT(1)="[Data]",CNT=1,FL=0,MORE=""
- S VIARRAY(1)=VIASDT_";"_VIAEDT
- S VIARRAY(2)=CLNIEN
- S VIARRAY("FLDS")="1;2;4"
- S VIACNT=$$SDAPI^SDAMA301(.VIARRAY)
- I VIACNT<1 D G CLAPX Q
- . N VIAERN
- . S VIAERN=$O(^TMP($J,"SDAMA301",0))
- . I VIAERN>0 S VIAER="("_VIAERN_") "_^TMP($J,"SDAMA301",VIAERN)_" - SDAPI call" D ERR^VIABMS(VIAER)
- S CLNIEN=0 F S CLNIEN=$O(^TMP($J,"SDAMA301",CLNIEN)) Q:'CLNIEN D
- . S VIADFN=0 F S VIADFN=$O(^TMP($J,"SDAMA301",CLNIEN,VIADFN)) Q:'VIADFN D
- . . S VIADT=0
- . . F S VIADT=$O(^TMP($J,"SDAMA301",CLNIEN,VIADFN,VIADT)) Q:'VIADT D
- . . . S VIAPPT=$G(^TMP($J,"SDAMA301",CLNIEN,VIADFN,VIADT)) ;appointment data
- . . . ;I (VIADT<VIASDT)!(VIADT>VIAEDT) Q
- . . . S VIARY($P($P(VIAPPT,"^",2),";"),$P(VIAPPT,"^"),$P($P(VIAPPT,"^",4),";"))=VIAPPT
- S CLNIEN=$S(VIAFROM'="":$P(VIAFROM,"~")-1,1:0)
- F S CLNIEN=$O(VIARY(CLNIEN)) Q:'CLNIEN D I CNT>VIAMAX Q
- . I ($P(VIAFROM,"~")>0),($P(VIAFROM,"~")'=CLNIEN) S VIAFROM=""
- . S VIADT=$S(VIAFROM'="":$P(VIAFROM,"~",2),1:0) ;S VIAFROM=""
- . F S VIADT=$O(VIARY(CLNIEN,VIADT)) Q:'VIADT S CNT=CNT+1,RESULT(CNT)=VIADT D S RESULT(CNT)=RESULT(CNT)_"^"_CLNIEN I CNT>VIAMAX S MORE="MORE^"_CLNIEN_"~"_VIADT,FL=1 Q
- . . S (VIADFN,I)=0 F S VIADFN=$O(VIARY(CLNIEN,VIADT,VIADFN)) Q:'VIADFN D
- . . . S RESULT(CNT)=RESULT(CNT)_$S('I:"^"_$P(VIARY(CLNIEN,VIADT,VIADFN),"^")_"^",1:"")_$S('I:"",1:"~")_VIADFN,I=1
- I FL D ; re-structure results array
- . M TARRAY=RESULT
- . K RESULT
- . S CNT=4,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)
- CLAPX K ^TMP($J,"SDAMA301")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVIABMS1 14374 printed Feb 19, 2025@00:11:46 Page 2
- VIABMS1 ;AAC/JMC - VIA BMS RPCs ;04/15/2016
- +1 ;;1.0;VISTA INTEGRATION ADAPTER;**8,11,13,14**;06-FEB-2014;Build 17
- +2 ;
- +3 ;The following RPC is in support of the Bed Management System (BMS). This RPC reads the parameter "Path"
- +4 ;and determine from that parameter which data to return. All BMS requests are handled by this one RPC.
- +5 ;Continuation of VIABMS
- +6 ; RPC VIAB BMS
- +7 ; ICR 1254 DIC(45.7, [field #1]
- +8 ; ICR 2638 ORDER STATUS file direct access [Filed 100.01, field #.01]
- +9 ; ICR 1359 DBIA1359 [File #45.7;field .01]
- +10 ; ICR 433 DBIA433 [File #405.1;field .01]
- +11 ; ICR 2438 DBIA2438 [File #40.8;field .01]
- +12 ; ICR 2843 DBIA2843 [File #101.43;field .01] (controlled)
- +13 ; ICR 2638 ORDER STATUS file direct access [File #100.01;field .01]
- +14 ; ICR 6611 SCHEDULED ADMISSION [File 41.1;fields fields .01;2;3;4;5;6;8;9;11;12;13;14](private)
- +15 ; ICR 1380 ROOM-BED [File #405.4;fields .01;.2;100](controlled)
- +16 ; ICR 4433 NAME: DBIA4433 (API SDAPI^SDAMA301) [supported]
- +17 ; ICR 1865 DBIA1865 [File #405;fields .01;.02;.03;.04;.06;.07;.14;100;101]
- +18 ; ICR 6475 LIST ORDERS [File #100; fields .02;6;5;30;31;etc]
- +19 QUIT
- +20 ;
- TRTSPTY ; Returns a list of facility treating specialty from the FACILITY TREATING SPECIALTY file #45.7;ICR-1359
- +1 ;Input - VIA("PATH")="LISTFACILITYTREATINGSPECIALTY" [required]
- +2 ; VIA("IENS")= Facility Treating Specialty IEN, (multiple IENs separated by comma) [optional]
- +3 ;Data returned
- +4 ; .01 Name,1 Specialty ID
- +5 NEW VIAFILE,VIAFIELDS,VIAFLAGS,TVIAIENS
- +6 SET VIAFILE=45.7
- SET VIAFIELDS="@;.01;1"
- SET VIAFLAGS="IP"
- +7 IF VIAIENS'=""
- SET TVIAIENS=VIAIENS
- SET VIAIENS=""
- SET VIAMAX=""
- +8 DO LDIC^VIABMS
- +9 IF $GET(TVIAIENS)'=""
- SET VIAIENS=TVIAIENS
- DO PIENS
- +10 QUIT
- +11 ;
- PIENS ; multiple IENs; parse IENS
- +1 NEW TRESULT,IEN,I,CNT,X
- +2 IF '$DATA(RESULT)
- QUIT
- +3 MERGE TRESULT=RESULT
- +4 KILL RESULT
- +5 SET RESULT(1)="[Data]"
- SET CNT=1
- +6 FOR I=1:1:$LENGTH(VIAIENS,",")
- SET IEN=$PIECE(VIAIENS,",",I)
- IF IEN'=""
- SET IEN(IEN)=""
- +7 SET X=0
- FOR
- SET X=$ORDER(TRESULT(X))
- if 'X
- QUIT
- SET IEN=$PIECE(TRESULT(X),U)
- IF IEN'=""
- IF $DATA(IEN(IEN))
- Begin DoDot:1
- +8 SET CNT=CNT+1
- SET RESULT(CNT)=TRESULT(X)
- End DoDot:1
- +9 QUIT
- +10 ;
- MASTYP ; Returns a list of MAS movement transaction type from the MAS MOVEMENT TRANSACTION TYPE file #405.3;ICR-433
- +1 ;Input - VIA("PATH")="LISTMASMOVEMENTTRANSACTIONTYPE" [required]
- +2 ;Data returned
- +3 ; .01 Name
- +4 NEW VIAFILE,VIAFIELDS,VIAFLAGS
- +5 SET VIAFILE=405.3
- SET VIAFIELDS="@;.01"
- SET VIAFLAGS="IP"
- +6 DO LDIC^VIABMS
- +7 QUIT
- +8 ;
- MEDCTR ; Returns a list of Medical Center division from the MEDICAL CENTER DIVISION file #40.8;ICR-2438
- +1 ;Input - VIA("PATH")="LISTMEDICALCENTERDIVISION" [required]
- +2 ; VIA("IENS")= Medical Center Division IEN, (multiple IENs separated by comma) [optional]
- +3 ;Data returned
- +4 ; .01 Name
- +5 NEW VIAFILE,VIAFIELDS,VIAFLAGS,TVIAIENS
- +6 SET VIAFILE=40.8
- SET VIAFIELDS="@;.01"
- SET VIAFLAGS="IP"
- +7 IF VIAIENS'=""
- SET TVIAIENS=VIAIENS
- SET VIAIENS=""
- SET VIAMAX=""
- +8 DO LDIC^VIABMS
- +9 IF $GET(TVIAIENS)'=""
- SET VIAIENS=TVIAIENS
- DO PIENS
- +10 QUIT
- +11 ;
- ORDITM ; Returns a list of orderable items from the ORDERABLE ITEMS file #101.43;ICR-2843
- +1 ;Input - VIA("PATH")="LISTORDERABLEITEM" [required]
- +2 ;Data returned
- +3 ; .01 Name
- +4 NEW VIAFILE,VIAFIELDS,VIAFLAGS,VIAXREF
- +5 SET VIAFILE=101.43
- SET VIAFIELDS="@;.01"
- SET VIAFLAGS="IPQ"
- SET VIAXREF="#"
- +6 DO LDIC^VIABMS
- +7 QUIT
- +8 ;
- ORDSTA ; Returns a list of Medical Center division from the ORDER STATUS file #100.01;ICR-2638
- +1 ;Input - VIA("PATH")="LISTORDERSTATUS" [required]
- +2 ; VIA("IENS")= Order Status IEN, (multiple IENs separated by comma) [optional]
- +3 ;Data returned
- +4 ; .01 Name
- +5 NEW VIAFILE,VIAFIELDS,VIAFLAGS,TVIAIENS
- +6 SET VIAFILE=100.01
- SET VIAFIELDS="@;.01"
- SET VIAFLAGS="IP"
- +7 IF VIAIENS'=""
- SET TVIAIENS=VIAIENS
- SET VIAIENS=""
- SET VIAMAX=""
- +8 DO LDIC^VIABMS
- +9 IF $GET(TVIAIENS)'=""
- SET VIAIENS=TVIAIENS
- DO PIENS
- +10 QUIT
- +11 ;
- BEDSWCH ; Returns a list of bed switch from the PATIENT MOVEMENT file #405;ICR-1865
- +1 ;Input - VIA("PATH")="LISTBEDSWITCH" [required]
- +2 ; VIA("IENS")="Patient Movement IEN" (multiple IENs separated by a comma) [required]
- +3 ;Data returned
- +4 ; .06 WardLocationId,.07 RoomBedId
- +5 NEW VIAFILE,VIAFIELDS,VIAFLAGS,I,VIATIEN,VIAIEN,TRESULT,X,N,I,VAL
- +6 IF VIAIENS=""
- SET VIAER="Missing MOVEMENT IEN"
- DO ERR^VIABMS(VIAER)
- QUIT
- +7 SET VIAFILE=405
- SET VIAFIELDS=".06;.07"
- SET VIAFLAGS="IE"
- +8 SET TRESULT(1)="[Data]"
- SET CNT=1
- +9 ; multiple IENs
- +10 SET VIATIEN=VIAIENS
- +11 FOR I=1:1:$LENGTH(VIATIEN,",")
- SET VIAIEN=$PIECE(VIATIEN,",",I)
- IF VIAIEN'=""
- Begin DoDot:1
- +12 SET VIAIENS=VIAIEN_","
- +13 KILL RESULT
- +14 DO GDIQ^VIABMS
- +15 IF $GET(RESULT(1))'["Data"
- QUIT
- +16 SET VAL=$PIECE($GET(RESULT(2)),U,1,2)_U_$TRANSLATE($PIECE($GET(RESULT(2)),U,4,5),"^",";")_U_$TRANSLATE($PIECE($GET(RESULT(3)),U,4,5),"^",";")
- +17 SET CNT=CNT+1
- SET TRESULT(CNT)=VAL
- +18 KILL RESULT
- End DoDot:1
- +19 MERGE RESULT=TRESULT
- +20 ;
- +21 QUIT
- +22 NEW VIAFILE,VIAFIELDS,VIAFLAGS,I,VIATIEN,VIAIEN,TRESULT,X,N,I
- +23 IF VIAIENS=""
- SET VIAER="Missing MOVEMENT IEN"
- DO ERR^VIABMS(VIAER)
- QUIT
- +24 SET VIAFILE=405
- SET VIAFIELDS=".06;.07"
- SET VIAFLAGS="IE"
- +25 ; multiple IENs
- +26 SET VIATIEN=VIAIENS
- +27 FOR I=1:1:$LENGTH(VIATIEN,",")
- SET VIAIEN=$PIECE(VIATIEN,",",I)
- IF VIAIEN'=""
- Begin DoDot:1
- +28 SET VIAIENS=VIAIEN_","
- DO GDIQ^VIABMS
- +29 IF '$DATA(TRESULT)
- MERGE TRESULT=RESULT
- KILL RESULT
- QUIT
- +30 SET X=0
- SET N=$ORDER(TRESULT(""),-1)
- FOR
- SET X=$ORDER(RESULT(X))
- if 'X
- QUIT
- SET N=N+1
- SET TRESULT(N)=RESULT(X)
- +31 KILL RESULT
- End DoDot:1
- +32 MERGE RESULT=TRESULT
- +33 QUIT
- +34 ;
- GPATMVT ; Returns a patient movement records from the PATIENT MOVEMENT file #405;ICR-1865
- +1 ;Input - VIA("PATH")="GETPATIENTMOVEMENT" [required]
- +2 ; VIA("IENS")="Patient Movement IEN" [required, optional if no other parameter]
- +3 ; VIA("MOVDATE")=Movement Date [optional, required if no Patient Movement IEN]
- +4 ; VIA("MOVTYPE")=Movement Type [optional, required if no Patient Movement IEN]
- +5 ; VIA("PATIEN")=Patient IEN [optional, required if no Patient Movement IEN]
- +6 ;Data returned
- +7 ; .01 MovementDate,101 EnteredDate,100 Entered By,.02 TransactionTypeId,.03 PatientIen,
- +8 ; .04 TypeOfMovementIen,.06 WardLocationId,.07 RoomBedId,.14 CurrentAdmissionIen
- +9 NEW VIAFILE,VIAFIELDS,VIAFLAGS,VIASCRN,I,VIACNT
- +10 SET VIAIENS=$PIECE(VIAIENS,",")
- +11 SET VIAFILE=405
- SET VIAFIELDS=".01;101;100;.02;.03;.04;.06;.07;.14"
- +12 IF VIAIENS=""
- IF VIAMDT=""
- IF VIAMTYP=""
- IF VIAPIEN=""
- SET VIAER="Missing Input parameters"
- DO ERR^VIABMS(VIAER)
- QUIT
- +13 IF VIAPIEN'=""
- DO PATCHK^VIABMS(VIAPIEN)
- IF $DATA(RESULT)
- QUIT
- +14 IF VIAPIEN'=""&(VIAMDT'="")&(VIAIENS="")
- Begin DoDot:1
- +15 FOR
- SET VIAIENS=$ORDER(^DGPM("ADFN"_VIAPIEN,VIAMDT,VIAIENS))
- if VIAIENS=""
- QUIT
- Begin DoDot:2
- +16 IF '$GET(VIACNT)
- SET RESULT(1)="[Data]"
- SET VIACNT=2
- +17 SET RESULT(VIACNT)=$$GMVTR^VIABMS(VIAIENS)
- SET VIACNT=VIACNT+1
- End DoDot:2
- End DoDot:1
- GOTO GPATMVT2
- +18 IF VIAIENS'=""
- Begin DoDot:1
- +19 SET RESULT(1)="[Data]"
- +20 SET RESULT(2)=$$GMVTR^VIABMS(VIAIENS)
- End DoDot:1
- QUIT
- GPATMVT2 ;
- +1 SET VIAFIELDS="@;"_VIAFIELDS
- SET VIAFLAGS="IP"
- +2 ;VIAMTYPE is actually TRANSACTION, not MOVEMENT TYPE.
- +3 SET VIASCRN="S X=$G(^(0)) I $P(X,U)=VIAMDT,$P(X,U,2)=VIAMTYP,$P(X,U,3)=VIAPIEN"
- +4 DO LDIC^VIABMS
- +5 QUIT
- +6 ;
- LPATMVT ; Returns a list of patient movement records from the PATIENT MOVEMENT file #405;ICR-1865
- +1 ;Input - VIA("PATH")="LISTPATIENTMOVEMENT" [required]
- +2 ; VIA("PATIEN")=Patient IEN [required, if no date range]
- +3 ; VIA("SDATE")=Start Date for search [optional]
- +4 ; VIA("EDATE")=End Date for search [optional]
- +5 ; VIA("MAX")=n [optional]
- +6 ;Data returned
- +7 ; .01 MovementDate,101 EnteredDate,100 Entered By,.02 TransactionTypeId,.03 PatientIen,
- +8 ; .04 TypeOfMovementIen,.06 WardLocationId,.07 RoomBedId,.14 CurrentAdmissionIen
- +9 SET VIAPIEN=$TRANSLATE(VIAPIEN,",")
- +10 IF VIAPIEN=""
- IF VIASDT=""
- IF VIAEDT=""
- SET VIAER="Missing Input Parameters"
- DO ERR^VIABMS(VIAER)
- QUIT
- +11 NEW VIADATA,START,END,STARTI,STARTJ,RES,MORED,OFFSET,I
- +12 IF VIAPIEN'=""
- DO PATCHK^VIABMS(VIAPIEN)
- IF $DATA(RESULT)
- QUIT
- +13 SET VIADATA=$NAME(^TMP($JOB,"VIADATA"))
- +14 KILL @VIADATA
- +15 ;Parse VIAFROM to get STARTI and STARTJ
- +16 SET (STARTI,STARTJ)=0
- +17 IF VIAFROM'=""
- Begin DoDot:1
- +18 SET STARTI=$PIECE(VIAFROM,"~")
- SET STARTJ=$PIECE(VIAFROM,"~",2)
- End DoDot:1
- +19 SET START=$SELECT(VIASDT'="":VIASDT-.000001,1:0)
- +20 SET END=$SELECT(VIAEDT="":9999999,VIAEDT[".":VIAEDT+.000001,1:VIAEDT+.99999999)
- +21 SET RES=$$WALK^VIABMS2(STARTI,STARTJ,VIAMAX,START,END)
- +22 SET MORED=$PIECE(RES,U,3)
- +23 IF MORED
- Begin DoDot:1
- +24 if $GET(MORED)
- SET RESULT(1)="[Misc]"
- +25 if $GET(MORED)
- SET RESULT(2)="MORE^"_$PIECE(RES,U)_"~"_$PIECE(RES,U,2)
- +26 SET RESULT($SELECT($GET(MORED):3,1:1))="[Data]"
- +27 SET OFFSET=$SELECT($GET(MORED):4,1:2)
- End DoDot:1
- +28 IF '$TEST
- Begin DoDot:1
- +29 SET RESULT(1)="[Data]"
- +30 SET OFFSET=2
- End DoDot:1
- +31 SET I=""
- +32 FOR
- SET I=$ORDER(@VIADATA@(I))
- if I=""
- QUIT
- SET RESULT(I+OFFSET)=@VIADATA@(I)
- +33 KILL @VIADATA
- +34 QUIT
- +35 ;
- MVTR(VIAIEN) ;
- +1 NEW IENS,FLDS,OUT,MOUT,VAL,I,FLD
- +2 SET IENS=VIAIEN_","
- +3 SET FLDS=".01;101;100;.02;.03;.04;.06;.07;.14"
- +4 DO GETS^DIQ(405,IENS,FLDS,"I","OUT","MOUT")
- +5 SET VAL=VIAIEN
- +6 FOR I=1:1:$LENGTH(FLDS,";")
- SET $PIECE(VAL,U,I+1)=$GET(OUT(405,IENS,$PIECE(FLDS,";",I),"I"))
- +7 QUIT VAL
- +8 ;
- +9 ;
- APATMVT ; Returns patient movement record by admission IEN from the PATIENT MOVEMENT file #405;ICR-1865
- +1 ;Input - VIA("PATH")="LISTPATIENTMOVEMENTSBYADMISSION" [required]
- +2 ; VIA("PATIEN")=Movement IEN [required] Note: gets parsed as variable VIAPIEN
- +3 ;Data returned
- +4 ; IEN,.01 MovementDate,101 EnteredDate,100 Entered By,.02 TransactionTypeId,.03 PatientIen,
- +5 ; .04 TypeOfMovementIen,.06 WardLocationId,.07 RoomBedId,.14 CurrentAdmissionIen
- +6 NEW Y,N
- +7 SET N=0
- +8 NEW I,J,CNT,END,FIRST,STARTI,STARTJ,VIADATA
- +9 IF VIAPIEN=""
- SET VIAER="Missing Input Parameters"
- DO ERR^VIABMS(VIAER)
- QUIT
- +10 SET VIADATA=$NAME(^TMP($JOB,"VIADATA"))
- +11 KILL @VIADATA
- +12 NEW I,J,K,CNT,END,FIRST,STARTI,STARTJ,DONE,LASTJ
- +13 SET FIRST=1
- SET DONE=0
- SET LASTJ=""
- +14 ;Parse VIAFROM to get STARTI and STARTJ
- +15 SET STARTI=$PIECE(VIAFROM,"~")
- SET STARTJ=$PIECE(VIAFROM,"~",2)
- +16 ;Traverse "CA" index, be sure to save last J
- +17 SET CNT=0
- +18 SET LASTJ=$GET(J)
- +19 SET J=$SELECT(FIRST:STARTJ,1:"")
- +20 FOR
- SET J=$ORDER(^DGPM("CA",VIAPIEN,J))
- if +J'>0!(CNT'<VIAMAX)
- QUIT
- Begin DoDot:1
- +21 if J'=""
- SET LASTJ=J
- +22 IF VIAPIEN=$PIECE($GET(^DGPM(J,0)),U,14)
- Begin DoDot:2
- +23 SET CNT=CNT+1
- +24 ;Store records temporarily in @VIADATA
- +25 SET @VIADATA@(CNT)=$$MVTR(J)
- End DoDot:2
- End DoDot:1
- +26 ;[Misc] section comes first
- +27 IF CNT'<VIAMAX
- Begin DoDot:1
- +28 DO SET^VIABMS("[Misc]")
- +29 DO SET^VIABMS("MORE^"_VIAPIEN_"~"_LASTJ)
- End DoDot:1
- +30 ;Now, save [Data] section and kill temp. global
- +31 DO SET^VIABMS("[Data]")
- +32 SET K=0
- +33 FOR
- SET K=$ORDER(@VIADATA@(K))
- if K=""
- QUIT
- DO SET^VIABMS(@VIADATA@(K))
- +34 KILL @VIADATA
- +35 MERGE RESULT=Y
- +36 QUIT
- +37 ;
- SCHADM ; Returns a list of scheduled admissions from the SCHEDULED ADMISSION file #41.1;ICR-6611
- +1 ;Input - VIA("PATH")="LISTSCHEDULEDADMISSION" [required]
- +2 ; VIA("PATIEN")=Patient IEN [optional]
- +3 ; VIA("SDATE")=Start Date for search [required]
- +4 ; VIA("EDATE")=End Date for search [required]
- +5 ; VIA("MAX")=n [optional]
- +6 ;Data returned
- +7 ; .01 PatientId,2 ReservationDateTime,3 LengthOfStayExpected,4 AdmittingDiagnosis,6 Surgery,8 WardLocation,
- +8 ; 9 TreatingSpecialty,12 MedicalCenterDivision,13 DateTimeCancelled,14 CancelledBy,5 Provider,11 Scheduler
- +9 NEW VIAFILE,VIAFIELDS,VIAFLAGS,VIASCRN,VIAER
- +10 SET VIAFILE=41.1
- SET VIAFIELDS="@;.01;2;3;4;6;8;9;12;13;14;5;11"
- SET VIAFLAGS="IP"
- +11 IF VIAPIEN'=""
- DO PATCHK^VIABMS(VIAPIEN)
- IF $DATA(RESULT)
- QUIT
- +12 IF VIAPIEN'=""
- SET VIASCRN="S X=$G(^DGS(41.1,Y,0)) I $P(X,U)=VIAPIEN"
- +13 ;For the purposes of this call, VIASDT and VIEDT are treated instants in time, even if they are integers. For this reason,
- +14 ;the call to DTCHK is not made. This also means it is necessary to explicitly test for VIASDT="" and VIAEDT="".
- +15 IF (VIAEDT="")!(VIASDT="")
- SET VIAER="Missing date parameters."
- DO ERR^VIABMS(VIAER)
- QUIT
- +16 ;I (VIASDT'="")!(VIAEDT'="") D DTCHK^VIABMS(.RESULT,.VIASDT,.VIAEDT) I $D(RESULT) Q
- +17 SET VIASCRN=$SELECT(($GET(VIASCRN)'="")&(VIASDT'=""):VIASCRN_",$P(X,U,2)>=VIASDT,$P(X,U,2)<=VIAEDT",VIASDT'="":"S X=$P($G(^DGS(41.1,Y,0)),U,2) I X>=VIASDT,X<=VIAEDT",1:$GET(VIASCRN))
- +18 DO LDIC^VIABMS
- +19 QUIT
- +20 ;
- RMBED ; Returns a list of room/beds from the ROOM-BED file #405.4;ICR-1380
- +1 ;Input - VIA("PATH")="LISTROOMBED" [required]
- +2 ; VIA("IENS")="Room Bed IEN" [required, optional if no other parameter]
- +3 ; VIA("MAX")=n [optional]
- +4 ; VIA("FROM")=string/value to start list [optional]
- +5 ;Data returned
- +6 ; .01 Name,.2 CurrentlyOutOfService,100 WardsWhichCanAssign
- +7 NEW VIAFILE,VIAFIELDS,VIAFLAGS,TVIAIENS
- +8 SET VIAFILE=405.4
- SET VIAFIELDS="@;.01;.2"
- SET VIAFLAGS="IP"
- +9 IF VIAIENS'=""
- SET TVIAIENS=VIAIENS
- SET VIAIENS=""
- SET VIAMAX=""
- +10 SET VIAID="S X="""" I $D(^DG(405.4,Y,""W"",0)) S VIAA="""" F S VIAA=$O(^DG(405.4,Y,""W"",VIAA)) S:VIAA>0 X=X_$S(X="""":"""",1:"","")_VIAA I VIAA="""" D EN^DDIOL(X) Q"
- +11 DO LDIC^VIABMS
- +12 IF $GET(TVIAIENS)'=""
- SET VIAIENS=TVIAIENS
- DO PIENS
- +13 QUIT
- +14 ;
- CLNAPPT ; Returns a list of clinic appointments from the HOSPITAL LOCATION sub-file #44.001;ICR-#4433
- +1 ;Input - VIA("PATH")="LISTCLINICAPPOINTMENTS" [required]
- +2 ; VIA("IENS")=Clinic IEN [required]
- +3 ; VIA("SDATE")=Start Date for search [optional]
- +4 ; VIA("EDATE")=End Date for search [optional]
- +5 ; VIA("MAX")=n [optional]
- +6 ;Data returned
- +7 ; .01 Appointment Date/Time, 2 Patients, Clinic
- +8 NEW VIARRAY,VIARY,CNT,VIARRY,VIACNT,VIADT,VIADFN,VIAPPT,I,Y,J,FL,CLNIEN,MORE,TARRAY
- +9 IF VIAIENS=""
- SET VIAER="Missing CLINIC IEN"
- DO ERR^VIABMS(VIAER)
- QUIT
- +10 ;I (VIASDT'="")!(VIAEDT'="") D DTCHK^VIABMS(.RESULT,.VIASDT,.VIAEDT) I $D(RESULT) Q
- +11 SET VIAEDT=$SELECT(VIAEDT="":DT,1:VIAEDT)
- +12 SET CLNIEN=$TRANSLATE(VIAIENS,",",";")
- +13 SET RESULT(1)="[Data]"
- SET CNT=1
- SET FL=0
- SET MORE=""
- +14 SET VIARRAY(1)=VIASDT_";"_VIAEDT
- +15 SET VIARRAY(2)=CLNIEN
- +16 SET VIARRAY("FLDS")="1;2;4"
- +17 SET VIACNT=$$SDAPI^SDAMA301(.VIARRAY)
- +18 IF VIACNT<1
- Begin DoDot:1
- +19 NEW VIAERN
- +20 SET VIAERN=$ORDER(^TMP($JOB,"SDAMA301",0))
- +21 IF VIAERN>0
- SET VIAER="("_VIAERN_") "_^TMP($JOB,"SDAMA301",VIAERN)_" - SDAPI call"
- DO ERR^VIABMS(VIAER)
- End DoDot:1
- GOTO CLAPX
- QUIT
- +22 SET CLNIEN=0
- FOR
- SET CLNIEN=$ORDER(^TMP($JOB,"SDAMA301",CLNIEN))
- if 'CLNIEN
- QUIT
- Begin DoDot:1
- +23 SET VIADFN=0
- FOR
- SET VIADFN=$ORDER(^TMP($JOB,"SDAMA301",CLNIEN,VIADFN))
- if 'VIADFN
- QUIT
- Begin DoDot:2
- +24 SET VIADT=0
- +25 FOR
- SET VIADT=$ORDER(^TMP($JOB,"SDAMA301",CLNIEN,VIADFN,VIADT))
- if 'VIADT
- QUIT
- Begin DoDot:3
- +26 ;appointment data
- SET VIAPPT=$GET(^TMP($JOB,"SDAMA301",CLNIEN,VIADFN,VIADT))
- +27 ;I (VIADT<VIASDT)!(VIADT>VIAEDT) Q
- +28 SET VIARY($PIECE($PIECE(VIAPPT,"^",2),";"),$PIECE(VIAPPT,"^"),$PIECE($PIECE(VIAPPT,"^",4),";"))=VIAPPT
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +29 SET CLNIEN=$SELECT(VIAFROM'="":$PIECE(VIAFROM,"~")-1,1:0)
- +30 FOR
- SET CLNIEN=$ORDER(VIARY(CLNIEN))
- if 'CLNIEN
- QUIT
- Begin DoDot:1
- +31 IF ($PIECE(VIAFROM,"~")>0)
- IF ($PIECE(VIAFROM,"~")'=CLNIEN)
- SET VIAFROM=""
- +32 ;S VIAFROM=""
- SET VIADT=$SELECT(VIAFROM'="":$PIECE(VIAFROM,"~",2),1:0)
- +33 FOR
- SET VIADT=$ORDER(VIARY(CLNIEN,VIADT))
- if 'VIADT
- QUIT
- SET CNT=CNT+1
- SET RESULT(CNT)=VIADT
- Begin DoDot:2
- +34 SET (VIADFN,I)=0
- FOR
- SET VIADFN=$ORDER(VIARY(CLNIEN,VIADT,VIADFN))
- if 'VIADFN
- QUIT
- Begin DoDot:3
- +35 SET RESULT(CNT)=RESULT(CNT)_$SELECT('I:"^"_$PIECE(VIARY(CLNIEN,VIADT,VIADFN),"^")_"^",1:"")_$SELECT('I:"",1:"~")_VIADFN
- SET I=1
- End DoDot:3
- End DoDot:2
- SET RESULT(CNT)=RESULT(CNT)_"^"_CLNIEN
- IF CNT>VIAMAX
- SET MORE="MORE^"_CLNIEN_"~"_VIADT
- SET FL=1
- QUIT
- End DoDot:1
- IF CNT>VIAMAX
- QUIT
- +36 ; re-structure results array
- IF FL
- Begin DoDot:1
- +37 MERGE TARRAY=RESULT
- +38 KILL RESULT
- +39 SET CNT=4
- SET I=0
- SET RESULT(1)="[Misc]"
- SET RESULT(2)=MORE
- SET RESULT(3)="[Data]"
- +40 FOR
- SET I=$ORDER(TARRAY(I))
- if 'I
- QUIT
- Begin DoDot:2
- +41 IF TARRAY(I)["Data"
- QUIT
- +42 SET CNT=CNT+1
- SET RESULT(CNT)=TARRAY(I)
- End DoDot:2
- End DoDot:1
- CLAPX KILL ^TMP($JOB,"SDAMA301")
- +1 QUIT