RAMAGU07 ;HCIOFO/SG - ORDERS/EXAMS API (PATIENT UTILITIES) ; 1/25/08 2:35pm
;;5.0;Radiology/Nuclear Medicine;**90**;Mar 16, 1998;Build 20
;
Q
;
;***** RETURNS SERVICE, WARD, AND BEDSECTION FOR INPATIENT
;
; RADFN Patient IEN (in file #2)
;
; [.RASERV] Service is returned via this parameter:
; ^01: IEN in the SERVICE/SECTION file (#49)
; ^02: Service name (value of the .01 field)
;
; [.RABED] Bedsection is returned via this parameter:
; ^01: IEN in the SPECIALTY file (#42.4)
; ^02: Bedsection name (value of the .01 field)
;
; [.RAWARD] Ward is returned via this parameter:
; ^01: IEN in the WARD LOCATION file (#42)
; ^02: Ward name (value of the .01 field)
;
; [RADTE] Date/time to check for inpatient status (FileMan).
; By default ($G(RADATE)'>0), current date/time is
; assumed.
;
; Return values:
; <0 Error descriptor (see $$ERROR^RAERR)
; 0 Success
;
RAINP(RADFN,RASERV,RABED,RAWARD,RADTE) ;
N IENS,RABUF,RAMSG,RC,TMP,VAIP
S (RABED,RASERV,RAWARD)=""
;
;=== Get inpatient data
S:$G(RADTE)>0 VAIP("D")=+RADTE
S RC=$$VAIN5(.RADFN) Q:RC<0 RC
;
;=== Ward
S:$G(VAIP(5))>0 RAWARD=$P(VAIP(5),U,1,2)
;
;=== Service and Bedsection
S IENS=+$G(VAIP(8))_"," ; Treating specialty
I IENS>0 D
. D GETS^DIQ(45.7,IENS,"1;2","EI","RABUF","RAMSG")
. I $G(DIERR) S RC=$$DBS^RAERR("RAMSG",-9,45.7,IENS) Q
. ;--- Bedsection
. S TMP=+$G(RABUF(45.7,IENS,1,"I"))
. S:TMP>0 RABED=TMP_U_$G(RABUF(45.7,IENS,1,"E"))
. ;--- Service
. S TMP=+$G(RABUF(45.7,IENS,2,"I"))
. S:TMP>0 RASERV=TMP_U_$G(RABUF(45.7,IENS,2,"E"))
E I RAWARD>0 D
. ;--- Get name of the service
. S IENS=(+RAWARD)_","
. S TMP=$$GET1^DIQ(42,IENS,.03,,,"RAMSG")
. I $G(DIERR) S RC=$$DBS^RAERR("RAMSG",-9,42,IENS) Q
. ;--- Try to find the name in the SERVICE/SECTION file
. D FIND^DIC(49,,"@;.01","X",TMP,2,"B",,,"RABUF","RAMSG")
. I $G(DIERR) S RC=$$DBS^RAERR("RAMSG",-9,49) Q
. ;--- Process the search results
. Q:+$G(RABUF("DILIST",0))'=1
. S TMP=+$G(RABUF("DILIST",2,1))
. S:TMP>0 RASERV=TMP_U_$G(RABUF("DILIST","ID",1,.01))
;
;===
Q $S(RC<0:RC,1:0)
;
;***** CALLS THE DEM^VADPT
;
; DFN Patient IEN (in file #2)
;
; [VALIDATE] Make sure that required fields are not empty
; [VAPTYP] See the DEM^VADPT description
; [VAHOW] See the DEM^VADPT description
;
; Output variables (see the DEM^VADPT description):
; VA, VADM
;
; Return values:
; <0 Error descriptor (see $$ERROR^RAERR)
; 0 Success
;
VADEM(DFN,VALIDATE,VAPTYP,VAHOW) ;
N A,I,J,K,K1,NC,NF,NQ,T,VAC,VAERR,VAN,VAROOT,VAS,VAV,VAW,VAX,VAZ,X,Y,Z
Q:$G(DFN)'>0 $$IPVE^RAERR("DFN")
D DEM^VADPT
Q:$G(VAERR) $$IPVE^RAERR("DFN")
;--- Make sure that required fields are not empty
D:$G(VALIDATE)
. S:$G(VADM(1))="" VADM(1)="Unknown ("_DFN_")"
. S:$G(VA("BID"))="" VA("BID")="UNKN"
;--- Success
Q 0
;
;***** CALLS THE IN5^VADPT
;
; DFN Patient IEN (in file #2)
;
; [VAHOW] See the IN5^VADPT description
;
; Input variables (see the IN5^VADPT description):
; VAIP
;
; Output variables (see the IN5^VADPT description:
; VAIP
;
; Return values:
; <0 Error descriptor (see $$ERROR^RAERR)
; 0 Success
;
VAIN5(DFN,VAHOW) ;
N A,I,J,K,K1,NC,NF,NQ,T,VAAP,VAC,VACA,VACA0,VADT,VADX,VAERR,VAID,VAMT,VAMV,VAMV0,VAMVT,VAN,VANOW,VAPP,VARM,VAROOT,VAS,VATS,VAV,VAW,VAWD,VAX,VAZ,X,Y
Q:$G(DFN)'>0 $$IPVE^RAERR("DFN")
D IN5^VADPT
Q:$G(VAERR) $$IPVE^RAERR("DFN")
;--- Success
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAMAGU07 3737 printed Dec 13, 2024@02:37:04 Page 2
RAMAGU07 ;HCIOFO/SG - ORDERS/EXAMS API (PATIENT UTILITIES) ; 1/25/08 2:35pm
+1 ;;5.0;Radiology/Nuclear Medicine;**90**;Mar 16, 1998;Build 20
+2 ;
+3 QUIT
+4 ;
+5 ;***** RETURNS SERVICE, WARD, AND BEDSECTION FOR INPATIENT
+6 ;
+7 ; RADFN Patient IEN (in file #2)
+8 ;
+9 ; [.RASERV] Service is returned via this parameter:
+10 ; ^01: IEN in the SERVICE/SECTION file (#49)
+11 ; ^02: Service name (value of the .01 field)
+12 ;
+13 ; [.RABED] Bedsection is returned via this parameter:
+14 ; ^01: IEN in the SPECIALTY file (#42.4)
+15 ; ^02: Bedsection name (value of the .01 field)
+16 ;
+17 ; [.RAWARD] Ward is returned via this parameter:
+18 ; ^01: IEN in the WARD LOCATION file (#42)
+19 ; ^02: Ward name (value of the .01 field)
+20 ;
+21 ; [RADTE] Date/time to check for inpatient status (FileMan).
+22 ; By default ($G(RADATE)'>0), current date/time is
+23 ; assumed.
+24 ;
+25 ; Return values:
+26 ; <0 Error descriptor (see $$ERROR^RAERR)
+27 ; 0 Success
+28 ;
RAINP(RADFN,RASERV,RABED,RAWARD,RADTE) ;
+1 NEW IENS,RABUF,RAMSG,RC,TMP,VAIP
+2 SET (RABED,RASERV,RAWARD)=""
+3 ;
+4 ;=== Get inpatient data
+5 if $GET(RADTE)>0
SET VAIP("D")=+RADTE
+6 SET RC=$$VAIN5(.RADFN)
if RC<0
QUIT RC
+7 ;
+8 ;=== Ward
+9 if $GET(VAIP(5))>0
SET RAWARD=$PIECE(VAIP(5),U,1,2)
+10 ;
+11 ;=== Service and Bedsection
+12 ; Treating specialty
SET IENS=+$GET(VAIP(8))_","
+13 IF IENS>0
Begin DoDot:1
+14 DO GETS^DIQ(45.7,IENS,"1;2","EI","RABUF","RAMSG")
+15 IF $GET(DIERR)
SET RC=$$DBS^RAERR("RAMSG",-9,45.7,IENS)
QUIT
+16 ;--- Bedsection
+17 SET TMP=+$GET(RABUF(45.7,IENS,1,"I"))
+18 if TMP>0
SET RABED=TMP_U_$GET(RABUF(45.7,IENS,1,"E"))
+19 ;--- Service
+20 SET TMP=+$GET(RABUF(45.7,IENS,2,"I"))
+21 if TMP>0
SET RASERV=TMP_U_$GET(RABUF(45.7,IENS,2,"E"))
End DoDot:1
+22 IF '$TEST
IF RAWARD>0
Begin DoDot:1
+23 ;--- Get name of the service
+24 SET IENS=(+RAWARD)_","
+25 SET TMP=$$GET1^DIQ(42,IENS,.03,,,"RAMSG")
+26 IF $GET(DIERR)
SET RC=$$DBS^RAERR("RAMSG",-9,42,IENS)
QUIT
+27 ;--- Try to find the name in the SERVICE/SECTION file
+28 DO FIND^DIC(49,,"@;.01","X",TMP,2,"B",,,"RABUF","RAMSG")
+29 IF $GET(DIERR)
SET RC=$$DBS^RAERR("RAMSG",-9,49)
QUIT
+30 ;--- Process the search results
+31 if +$GET(RABUF("DILIST",0))'=1
QUIT
+32 SET TMP=+$GET(RABUF("DILIST",2,1))
+33 if TMP>0
SET RASERV=TMP_U_$GET(RABUF("DILIST","ID",1,.01))
End DoDot:1
+34 ;
+35 ;===
+36 QUIT $SELECT(RC<0:RC,1:0)
+37 ;
+38 ;***** CALLS THE DEM^VADPT
+39 ;
+40 ; DFN Patient IEN (in file #2)
+41 ;
+42 ; [VALIDATE] Make sure that required fields are not empty
+43 ; [VAPTYP] See the DEM^VADPT description
+44 ; [VAHOW] See the DEM^VADPT description
+45 ;
+46 ; Output variables (see the DEM^VADPT description):
+47 ; VA, VADM
+48 ;
+49 ; Return values:
+50 ; <0 Error descriptor (see $$ERROR^RAERR)
+51 ; 0 Success
+52 ;
VADEM(DFN,VALIDATE,VAPTYP,VAHOW) ;
+1 NEW A,I,J,K,K1,NC,NF,NQ,T,VAC,VAERR,VAN,VAROOT,VAS,VAV,VAW,VAX,VAZ,X,Y,Z
+2 if $GET(DFN)'>0
QUIT $$IPVE^RAERR("DFN")
+3 DO DEM^VADPT
+4 if $GET(VAERR)
QUIT $$IPVE^RAERR("DFN")
+5 ;--- Make sure that required fields are not empty
+6 if $GET(VALIDATE)
Begin DoDot:1
+7 if $GET(VADM(1))=""
SET VADM(1)="Unknown ("_DFN_")"
+8 if $GET(VA("BID"))=""
SET VA("BID")="UNKN"
End DoDot:1
+9 ;--- Success
+10 QUIT 0
+11 ;
+12 ;***** CALLS THE IN5^VADPT
+13 ;
+14 ; DFN Patient IEN (in file #2)
+15 ;
+16 ; [VAHOW] See the IN5^VADPT description
+17 ;
+18 ; Input variables (see the IN5^VADPT description):
+19 ; VAIP
+20 ;
+21 ; Output variables (see the IN5^VADPT description:
+22 ; VAIP
+23 ;
+24 ; Return values:
+25 ; <0 Error descriptor (see $$ERROR^RAERR)
+26 ; 0 Success
+27 ;
VAIN5(DFN,VAHOW) ;
+1 NEW A,I,J,K,K1,NC,NF,NQ,T,VAAP,VAC,VACA,VACA0,VADT,VADX,VAERR,VAID,VAMT,VAMV,VAMV0,VAMVT,VAN,VANOW,VAPP,VARM,VAROOT,VAS,VATS,VAV,VAW,VAWD,VAX,VAZ,X,Y
+2 if $GET(DFN)'>0
QUIT $$IPVE^RAERR("DFN")
+3 DO IN5^VADPT
+4 if $GET(VAERR)
QUIT $$IPVE^RAERR("DFN")
+5 ;--- Success
+6 QUIT 0
