GMVRPCHL ;HIOFO/FT-RPC FOR HOSPITAL LOCATION SELECTION ;12/7/05 10:32
;;5.0;GEN. MED. REC. - VITALS;**3,22**;Oct 31, 2002;Build 22
;
; This routine uses the following IAs:
; #1378 - DGPM references (controlled)
; #2965 - FILE 405.1 references (controlled)
; #10039 - FILE 42 references (supported)
; #10040 - FILE 44 references (supported)
; #10061 - ^VADPT calls (supported)
; #10103 - ^XLFDT calls (supported)
;
; This routine supports the following IAs:
; #4461 - GMV LOCATION SELECT RPC is called at RPC (private)
;
RPC(RESULTS,OPTION,DATA) ; [Procedure] Main RPC call tag
; RPC: [GMV LOCATION SELECT]
;
; Input parameters
; 1. RESULTS [Reference/Required] RPC Return array
; 2. OPTION [Literal/Required] RPC Option to execute
; 3. DATA [Literal/Required] Other data as required for call
;
S RESULTS=$NA(^TMP("GMVHLOC",$J)) K @RESULTS
D:$T(@OPTION)]"" @OPTION
S:'$D(@RESULTS) @RESULTS@(0)="-1^No results returned"
D CLEAN^DILF,KVAR^VADPT
Q
NAME ; Return list of clinics and wards by name
; DATA=pieceA^pieceB^pieceC
; where pieceA - file number (required)
; pieceB - value to begin search with (required)
; pieceC - field(s) to do the look-up on (optional, defaults to .01 field)
;
; RESULTS(0)=piece1^piece2
; RESULTS(n)=piece3
; where piece1 - -1 if error OR number of entries found
; piece2 - error message if piece1=-1
; piece3 - field values requested.
; n - sequential number starting with 1
;
N GMVSCRN,GMVFLD,X
S DATA=$G(DATA)
I +DATA'>0 D Q
.S @RESULTS@(0)="-1^Not a valid file number"
.Q
S GMVSCRN=$S(+DATA=44:"I $P(^(0),U,3)'=""Z""",1:"")
I $P(DATA,"^",3)="" S GMVFLD="@;.01"
E S GMVFLD="@;"_$P(DATA,"^",3)
S GMVFLD=$P(GMVFLD,";",1,5) ; Limit lookup to 4 display fields
D FIND^DIC(+DATA,"",GMVFLD,"P",$P(DATA,"^",2),"","",GMVSCRN)
I $D(^TMP("DIERR",$J)) D Q
.S @RESULTS@(0)="-1^"_$G(^TMP("DIERR",$J,1,"TEXT",1))
.Q
I ^TMP("DILIST",$J,0)<1 D Q
.S @RESULTS@(0)="-1^No entries found matching '"_$P(DATA,U,2)_"'."
.Q
;I ^TMP("DILIST",$J,0)>60 D Q
;.S @RESULTS@(0)="-1^Too many matches found, please be more specific."
;.Q
F X=0:0 S X=$O(^TMP("DILIST",$J,X)) Q:'X D
.S @RESULTS@(X)=+DATA_";"_^TMP("DILIST",$J,X,0)
.Q
S @RESULTS@(0)=+$O(@RESULTS@(""),-1)
Q
APPT ; Get patient appointments using SDA^VADPT
; DATA=GMVDFN^GMVFROM^GMVTO^GMVFLAG
; GMVDFN - DFN (required)
; GMVFROM - Start date of search (optional)
; GMVTO - End date of search (optional)
; GMVFLAG - kind of appt flag (optional)
; RESULTS(0)=piece1^piece2
; RESULTS(n)=piece3^piece4^piece5^piece6^piece7^piece8^piece9^piece10
;
; where piece1 - -1 if an error OR the number of records returned
; piece2 - an error message if piece1 = -1
; piece3 - appointment date/time (FM internal)
; piece4 - appointment date/time (external)
; piece5 - clinic (internal)
; piece6 - clinic (external)
; piece7 - status (internal)
; piece8 - status (external)
; piece9 - appointment type (external)
; piece10 - appointment type (external)
; n - a sequential number starting with 1
;
N GMVARRAY,GMVCNT,GMVE,GMVI,GMVLOOP,GMVDFN,GMVFROM,GMVTO,GMVFLAG
N DFN,VAERR,VASD
S DATA=$G(DATA)
S GMVDFN=$P(DATA,U,1),GMVFROM=$P(DATA,U,2),GMVTO=$P(DATA,U,3),GMVFLAG=$P(DATA,U,4)
S GMVDFN=+$G(GMVDFN)
I '$G(GMVDFN) S @RESULTS@(0)="-1^Patient ID is missing" Q
I $G(GMVFROM)="" S GMVFROM=$$FMADD^XLFDT(DT,-365)
I $G(GMVTO)="" S GMVTO=DT_".235959"
S:GMVFLAG="" VASD("W")="123456789"
S DFN=GMVDFN,VASD("T")=GMVTO,VASD("F")=GMVFROM
D SDA^VADPT
I $G(VAERR)=1 S @RESULTS@(0)="-1^DFN or ^DPT(DFN,0) is not defined" Q
S @RESULTS@(0)=0
I '$D(^UTILITY("VASD",$J)) Q
S (GMVCNT,GMVLOOP)=0
F S GMVLOOP=$O(^UTILITY("VASD",$J,GMVLOOP)) Q:'GMVLOOP D
.S GMVE=$G(^UTILITY("VASD",$J,GMVLOOP,"E"))
.S GMVI=$G(^UTILITY("VASD",$J,GMVLOOP,"I"))
.Q:'$P(GMVI,U,1)
.S GMVCNT=GMVCNT+1
.S GMVARRAY(9999999.999999-$P(GMVI,U,1))=$P(GMVI,U,1)_U_$P(GMVE,U,1)_U_$P(GMVI,U,2)_U_$P(GMVE,U,2)_U_$P(GMVI,U,3)_U_$P(GMVE,U,3)_U_$P(GMVI,U,4)_U_$P(GMVE,U,4)
.Q
S $P(@RESULTS@(0),U,1)=GMVCNT
K ^UTILITY("VASD",$J)
S (GMVCNT,GMVLOOP)=0
F S GMVLOOP=$O(GMVARRAY(GMVLOOP)) Q:'GMVLOOP D
.S GMVCNT=GMVCNT+1
.S @RESULTS@(GMVCNT)=$G(GMVARRAY(GMVLOOP))
.Q
Q
ADMIT ; return a list of admissions
; DATA=DFN
; RESULTS(0)=piece1
; RESULTS(n)=piece2^piece3^piece4^piece5^piece6
; where piece1 - number of records returned
; piece2 - movement date/time (external)
; piece3 - location ien (FILE 44)
; piece4 - location name (FILE 44, Field .01)
; piece5 - type of move
; PIECE6 - movement ien
; n - a sequential number starting with 1
;
N DFN,TIM,MOV,X0,MTIM,XTYP,XLOC,HLOC,ILST
S DFN=DATA,ILST=0,TIM=""
I '$G(DFN) Q
F S TIM=$O(^DGPM("ATID1",DFN,TIM)) Q:TIM'>0 D
.S MOV=0
.F S MOV=$O(^DGPM("ATID1",DFN,TIM,MOV)) Q:MOV'>0 D
..S X0=$G(^DGPM(MOV,0)) I X0']"" Q
..S MTIM=$P(X0,U),MTIM=$$FMTE^XLFDT(MTIM,"1P")
..S XTYP=$P($G(^DG(405.1,+$P(X0,U,4),0)),U,1)
..S XLOC=$P($G(^DIC(42,+$P(X0,U,6),0)),U,1),HLOC=+$G(^(44))
..S ILST=ILST+1,@RESULTS@(ILST)=MTIM_U_HLOC_U_XLOC_U_XTYP_U_MOV
..Q
.Q
S @RESULTS@(0)=ILST
Q
CLINIC ; Return list of active clinics
; DATA = GMVFROM^GMVMAX^GMVDIR
; Where:
; GMVFROM - Value to begin the search (optional). Default is null (i.e., start
; with the first entry in the B x-ref).
; GMVMAX - Maximum number of entries to return. (optional) Default is 100.
; GMVDIR - Direction of search (optional). 1 means forward and -1 means backwards.
; Default is 1.
; Output
; RESULT(n)=piece1^piece2
;
; where n is a sequential number starting with zero
; piece1 - 44;ien (44, a semi-colon and the entry number)
; piece2 - location name (FILE 44, Field .01)
;
; ex:
; RESULTS(0)=n
; RESULTS(1)=44;123^TEST CLINIC
;
; If no entries are found, then RESULTS(0)="-1^NO ENTRIES FOUND"
;
N GMVACTIV,GMVCNT,GMVDIR,GMVFROM,GMVIEN,GMVLAST,GMVLOCS,GMVLOOP,GMVMAX,GMVNAME,GMVNODE,GMVX
S GMVFROM=$P(DATA,U,1),GMVMAX=+$P(DATA,U,2),GMVDIR=$P(DATA,U,3)
S:'GMVMAX GMVMAX=100
S GMVDIR=$S(GMVDIR=-1:-1,1:1)
I GMVFROM]"" D ;get entry before or after GMVFROM
.S:GMVDIR=1 GMVLAST=$O(^SC("B",GMVFROM),-1)
.S:GMVDIR=-1 GMVLAST=$O(^SC("B",GMVFROM))
.S GMVFROM=$G(GMVLAST)
.Q
S GMVCNT=0,GMVNAME=GMVFROM
F S GMVNAME=$O(^SC("B",GMVNAME),GMVDIR) Q:GMVNAME=""!(GMVCNT=GMVMAX) D
.S GMVIEN=0
.F S GMVIEN=$O(^SC("B",GMVNAME,GMVIEN)) Q:'GMVIEN!(GMVCNT=GMVMAX) D
..S GMVNODE=$G(^SC(GMVIEN,0))
..Q:$P(GMVNODE,U,1)="" ;no name
..Q:$P(GMVNODE,U,3)'="C"
..D Q ;clinics
...Q:+$G(^SC(GMVIEN,"OOS")) ;out of service
...S GMVACTIV=$G(^SC(GMVIEN,"I"))
...I GMVACTIV Q:DT>+GMVACTIV&($P(GMVACTIV,U,2)=""!(DT<$P(GMVACTIV,U,2)))
...S GMVCNT=GMVCNT+1
...S @RESULTS@(GMVCNT)="44;"_GMVIEN_U_$P(^SC(GMVIEN,0),U)
...Q
..Q
.Q
I GMVCNT=0 S @RESULTS@(0)="-1^NO ENTRIES FOUND"
I GMVCNT>0 S @RESULTS@(0)=GMVCNT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMVRPCHL 7287 printed Nov 22, 2024@17:09:56 Page 2
GMVRPCHL ;HIOFO/FT-RPC FOR HOSPITAL LOCATION SELECTION ;12/7/05 10:32
+1 ;;5.0;GEN. MED. REC. - VITALS;**3,22**;Oct 31, 2002;Build 22
+2 ;
+3 ; This routine uses the following IAs:
+4 ; #1378 - DGPM references (controlled)
+5 ; #2965 - FILE 405.1 references (controlled)
+6 ; #10039 - FILE 42 references (supported)
+7 ; #10040 - FILE 44 references (supported)
+8 ; #10061 - ^VADPT calls (supported)
+9 ; #10103 - ^XLFDT calls (supported)
+10 ;
+11 ; This routine supports the following IAs:
+12 ; #4461 - GMV LOCATION SELECT RPC is called at RPC (private)
+13 ;
RPC(RESULTS,OPTION,DATA) ; [Procedure] Main RPC call tag
+1 ; RPC: [GMV LOCATION SELECT]
+2 ;
+3 ; Input parameters
+4 ; 1. RESULTS [Reference/Required] RPC Return array
+5 ; 2. OPTION [Literal/Required] RPC Option to execute
+6 ; 3. DATA [Literal/Required] Other data as required for call
+7 ;
+8 SET RESULTS=$NAME(^TMP("GMVHLOC",$JOB))
KILL @RESULTS
+9 if $TEXT(@OPTION)]""
DO @OPTION
+10 if '$DATA(@RESULTS)
SET @RESULTS@(0)="-1^No results returned"
+11 DO CLEAN^DILF
DO KVAR^VADPT
+12 QUIT
NAME ; Return list of clinics and wards by name
+1 ; DATA=pieceA^pieceB^pieceC
+2 ; where pieceA - file number (required)
+3 ; pieceB - value to begin search with (required)
+4 ; pieceC - field(s) to do the look-up on (optional, defaults to .01 field)
+5 ;
+6 ; RESULTS(0)=piece1^piece2
+7 ; RESULTS(n)=piece3
+8 ; where piece1 - -1 if error OR number of entries found
+9 ; piece2 - error message if piece1=-1
+10 ; piece3 - field values requested.
+11 ; n - sequential number starting with 1
+12 ;
+13 NEW GMVSCRN,GMVFLD,X
+14 SET DATA=$GET(DATA)
+15 IF +DATA'>0
Begin DoDot:1
+16 SET @RESULTS@(0)="-1^Not a valid file number"
+17 QUIT
End DoDot:1
QUIT
+18 SET GMVSCRN=$SELECT(+DATA=44:"I $P(^(0),U,3)'=""Z""",1:"")
+19 IF $PIECE(DATA,"^",3)=""
SET GMVFLD="@;.01"
+20 IF '$TEST
SET GMVFLD="@;"_$PIECE(DATA,"^",3)
+21 ; Limit lookup to 4 display fields
SET GMVFLD=$PIECE(GMVFLD,";",1,5)
+22 DO FIND^DIC(+DATA,"",GMVFLD,"P",$PIECE(DATA,"^",2),"","",GMVSCRN)
+23 IF $DATA(^TMP("DIERR",$JOB))
Begin DoDot:1
+24 SET @RESULTS@(0)="-1^"_$GET(^TMP("DIERR",$JOB,1,"TEXT",1))
+25 QUIT
End DoDot:1
QUIT
+26 IF ^TMP("DILIST",$JOB,0)<1
Begin DoDot:1
+27 SET @RESULTS@(0)="-1^No entries found matching '"_$PIECE(DATA,U,2)_"'."
+28 QUIT
End DoDot:1
QUIT
+29 ;I ^TMP("DILIST",$J,0)>60 D Q
+30 ;.S @RESULTS@(0)="-1^Too many matches found, please be more specific."
+31 ;.Q
+32 FOR X=0:0
SET X=$ORDER(^TMP("DILIST",$JOB,X))
if 'X
QUIT
Begin DoDot:1
+33 SET @RESULTS@(X)=+DATA_";"_^TMP("DILIST",$JOB,X,0)
+34 QUIT
End DoDot:1
+35 SET @RESULTS@(0)=+$ORDER(@RESULTS@(""),-1)
+36 QUIT
APPT ; Get patient appointments using SDA^VADPT
+1 ; DATA=GMVDFN^GMVFROM^GMVTO^GMVFLAG
+2 ; GMVDFN - DFN (required)
+3 ; GMVFROM - Start date of search (optional)
+4 ; GMVTO - End date of search (optional)
+5 ; GMVFLAG - kind of appt flag (optional)
+6 ; RESULTS(0)=piece1^piece2
+7 ; RESULTS(n)=piece3^piece4^piece5^piece6^piece7^piece8^piece9^piece10
+8 ;
+9 ; where piece1 - -1 if an error OR the number of records returned
+10 ; piece2 - an error message if piece1 = -1
+11 ; piece3 - appointment date/time (FM internal)
+12 ; piece4 - appointment date/time (external)
+13 ; piece5 - clinic (internal)
+14 ; piece6 - clinic (external)
+15 ; piece7 - status (internal)
+16 ; piece8 - status (external)
+17 ; piece9 - appointment type (external)
+18 ; piece10 - appointment type (external)
+19 ; n - a sequential number starting with 1
+20 ;
+21 NEW GMVARRAY,GMVCNT,GMVE,GMVI,GMVLOOP,GMVDFN,GMVFROM,GMVTO,GMVFLAG
+22 NEW DFN,VAERR,VASD
+23 SET DATA=$GET(DATA)
+24 SET GMVDFN=$PIECE(DATA,U,1)
SET GMVFROM=$PIECE(DATA,U,2)
SET GMVTO=$PIECE(DATA,U,3)
SET GMVFLAG=$PIECE(DATA,U,4)
+25 SET GMVDFN=+$GET(GMVDFN)
+26 IF '$GET(GMVDFN)
SET @RESULTS@(0)="-1^Patient ID is missing"
QUIT
+27 IF $GET(GMVFROM)=""
SET GMVFROM=$$FMADD^XLFDT(DT,-365)
+28 IF $GET(GMVTO)=""
SET GMVTO=DT_".235959"
+29 if GMVFLAG=""
SET VASD("W")="123456789"
+30 SET DFN=GMVDFN
SET VASD("T")=GMVTO
SET VASD("F")=GMVFROM
+31 DO SDA^VADPT
+32 IF $GET(VAERR)=1
SET @RESULTS@(0)="-1^DFN or ^DPT(DFN,0) is not defined"
QUIT
+33 SET @RESULTS@(0)=0
+34 IF '$DATA(^UTILITY("VASD",$JOB))
QUIT
+35 SET (GMVCNT,GMVLOOP)=0
+36 FOR
SET GMVLOOP=$ORDER(^UTILITY("VASD",$JOB,GMVLOOP))
if 'GMVLOOP
QUIT
Begin DoDot:1
+37 SET GMVE=$GET(^UTILITY("VASD",$JOB,GMVLOOP,"E"))
+38 SET GMVI=$GET(^UTILITY("VASD",$JOB,GMVLOOP,"I"))
+39 if '$PIECE(GMVI,U,1)
QUIT
+40 SET GMVCNT=GMVCNT+1
+41 SET GMVARRAY(9999999.999999-$PIECE(GMVI,U,1))=$PIECE(GMVI,U,1)_U_$PIECE(GMVE,U,1)_U_$PIECE(GMVI,U,2)_U_$PIECE(GMVE,U,2)_U_$PIECE(GMVI,U,3)_U_$PIECE(GMVE,U,3)_U_$PIECE(GMVI,U,4)_U_$PIECE(GMVE,U,4)
+42 QUIT
End DoDot:1
+43 SET $PIECE(@RESULTS@(0),U,1)=GMVCNT
+44 KILL ^UTILITY("VASD",$JOB)
+45 SET (GMVCNT,GMVLOOP)=0
+46 FOR
SET GMVLOOP=$ORDER(GMVARRAY(GMVLOOP))
if 'GMVLOOP
QUIT
Begin DoDot:1
+47 SET GMVCNT=GMVCNT+1
+48 SET @RESULTS@(GMVCNT)=$GET(GMVARRAY(GMVLOOP))
+49 QUIT
End DoDot:1
+50 QUIT
ADMIT ; return a list of admissions
+1 ; DATA=DFN
+2 ; RESULTS(0)=piece1
+3 ; RESULTS(n)=piece2^piece3^piece4^piece5^piece6
+4 ; where piece1 - number of records returned
+5 ; piece2 - movement date/time (external)
+6 ; piece3 - location ien (FILE 44)
+7 ; piece4 - location name (FILE 44, Field .01)
+8 ; piece5 - type of move
+9 ; PIECE6 - movement ien
+10 ; n - a sequential number starting with 1
+11 ;
+12 NEW DFN,TIM,MOV,X0,MTIM,XTYP,XLOC,HLOC,ILST
+13 SET DFN=DATA
SET ILST=0
SET TIM=""
+14 IF '$GET(DFN)
QUIT
+15 FOR
SET TIM=$ORDER(^DGPM("ATID1",DFN,TIM))
if TIM'>0
QUIT
Begin DoDot:1
+16 SET MOV=0
+17 FOR
SET MOV=$ORDER(^DGPM("ATID1",DFN,TIM,MOV))
if MOV'>0
QUIT
Begin DoDot:2
+18 SET X0=$GET(^DGPM(MOV,0))
IF X0']""
QUIT
+19 SET MTIM=$PIECE(X0,U)
SET MTIM=$$FMTE^XLFDT(MTIM,"1P")
+20 SET XTYP=$PIECE($GET(^DG(405.1,+$PIECE(X0,U,4),0)),U,1)
+21 SET XLOC=$PIECE($GET(^DIC(42,+$PIECE(X0,U,6),0)),U,1)
SET HLOC=+$GET(^(44))
+22 SET ILST=ILST+1
SET @RESULTS@(ILST)=MTIM_U_HLOC_U_XLOC_U_XTYP_U_MOV
+23 QUIT
End DoDot:2
+24 QUIT
End DoDot:1
+25 SET @RESULTS@(0)=ILST
+26 QUIT
CLINIC ; Return list of active clinics
+1 ; DATA = GMVFROM^GMVMAX^GMVDIR
+2 ; Where:
+3 ; GMVFROM - Value to begin the search (optional). Default is null (i.e., start
+4 ; with the first entry in the B x-ref).
+5 ; GMVMAX - Maximum number of entries to return. (optional) Default is 100.
+6 ; GMVDIR - Direction of search (optional). 1 means forward and -1 means backwards.
+7 ; Default is 1.
+8 ; Output
+9 ; RESULT(n)=piece1^piece2
+10 ;
+11 ; where n is a sequential number starting with zero
+12 ; piece1 - 44;ien (44, a semi-colon and the entry number)
+13 ; piece2 - location name (FILE 44, Field .01)
+14 ;
+15 ; ex:
+16 ; RESULTS(0)=n
+17 ; RESULTS(1)=44;123^TEST CLINIC
+18 ;
+19 ; If no entries are found, then RESULTS(0)="-1^NO ENTRIES FOUND"
+20 ;
+21 NEW GMVACTIV,GMVCNT,GMVDIR,GMVFROM,GMVIEN,GMVLAST,GMVLOCS,GMVLOOP,GMVMAX,GMVNAME,GMVNODE,GMVX
+22 SET GMVFROM=$PIECE(DATA,U,1)
SET GMVMAX=+$PIECE(DATA,U,2)
SET GMVDIR=$PIECE(DATA,U,3)
+23 if 'GMVMAX
SET GMVMAX=100
+24 SET GMVDIR=$SELECT(GMVDIR=-1:-1,1:1)
+25 ;get entry before or after GMVFROM
IF GMVFROM]""
Begin DoDot:1
+26 if GMVDIR=1
SET GMVLAST=$ORDER(^SC("B",GMVFROM),-1)
+27 if GMVDIR=-1
SET GMVLAST=$ORDER(^SC("B",GMVFROM))
+28 SET GMVFROM=$GET(GMVLAST)
+29 QUIT
End DoDot:1
+30 SET GMVCNT=0
SET GMVNAME=GMVFROM
+31 FOR
SET GMVNAME=$ORDER(^SC("B",GMVNAME),GMVDIR)
if GMVNAME=""!(GMVCNT=GMVMAX)
QUIT
Begin DoDot:1
+32 SET GMVIEN=0
+33 FOR
SET GMVIEN=$ORDER(^SC("B",GMVNAME,GMVIEN))
if 'GMVIEN!(GMVCNT=GMVMAX)
QUIT
Begin DoDot:2
+34 SET GMVNODE=$GET(^SC(GMVIEN,0))
+35 ;no name
if $PIECE(GMVNODE,U,1)=""
QUIT
+36 if $PIECE(GMVNODE,U,3)'="C"
QUIT
+37 ;clinics
Begin DoDot:3
+38 ;out of service
if +$GET(^SC(GMVIEN,"OOS"))
QUIT
+39 SET GMVACTIV=$GET(^SC(GMVIEN,"I"))
+40 IF GMVACTIV
if DT>+GMVACTIV&($PIECE(GMVACTIV,U,2)=""!(DT<$PIECE(GMVACTIV,U,2)))
QUIT
+41 SET GMVCNT=GMVCNT+1
+42 SET @RESULTS@(GMVCNT)="44;"_GMVIEN_U_$PIECE(^SC(GMVIEN,0),U)
+43 QUIT
End DoDot:3
QUIT
+44 QUIT
End DoDot:2
+45 QUIT
End DoDot:1
+46 IF GMVCNT=0
SET @RESULTS@(0)="-1^NO ENTRIES FOUND"
+47 IF GMVCNT>0
SET @RESULTS@(0)=GMVCNT
+48 QUIT