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

VIABMS1.m

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