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

RAMAGU07.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. Q
  1. ;
  1. ;***** RETURNS SERVICE, WARD, AND BEDSECTION FOR INPATIENT
  1. ;
  1. ; RADFN Patient IEN (in file #2)
  1. ;
  1. ; [.RASERV] Service is returned via this parameter:
  1. ; ^01: IEN in the SERVICE/SECTION file (#49)
  1. ; ^02: Service name (value of the .01 field)
  1. ;
  1. ; [.RABED] Bedsection is returned via this parameter:
  1. ; ^01: IEN in the SPECIALTY file (#42.4)
  1. ; ^02: Bedsection name (value of the .01 field)
  1. ;
  1. ; [.RAWARD] Ward is returned via this parameter:
  1. ; ^01: IEN in the WARD LOCATION file (#42)
  1. ; ^02: Ward name (value of the .01 field)
  1. ;
  1. ; [RADTE] Date/time to check for inpatient status (FileMan).
  1. ; By default ($G(RADATE)'>0), current date/time is
  1. ; assumed.
  1. ;
  1. ; Return values:
  1. ; <0 Error descriptor (see $$ERROR^RAERR)
  1. ; 0 Success
  1. ;
  1. RAINP(RADFN,RASERV,RABED,RAWARD,RADTE) ;
  1. N IENS,RABUF,RAMSG,RC,TMP,VAIP
  1. S (RABED,RASERV,RAWARD)=""
  1. ;
  1. ;=== Get inpatient data
  1. S:$G(RADTE)>0 VAIP("D")=+RADTE
  1. S RC=$$VAIN5(.RADFN) Q:RC<0 RC
  1. ;
  1. ;=== Ward
  1. S:$G(VAIP(5))>0 RAWARD=$P(VAIP(5),U,1,2)
  1. ;
  1. ;=== Service and Bedsection
  1. S IENS=+$G(VAIP(8))_"," ; Treating specialty
  1. I IENS>0 D
  1. . D GETS^DIQ(45.7,IENS,"1;2","EI","RABUF","RAMSG")
  1. . I $G(DIERR) S RC=$$DBS^RAERR("RAMSG",-9,45.7,IENS) Q
  1. . ;--- Bedsection
  1. . S TMP=+$G(RABUF(45.7,IENS,1,"I"))
  1. . S:TMP>0 RABED=TMP_U_$G(RABUF(45.7,IENS,1,"E"))
  1. . ;--- Service
  1. . S TMP=+$G(RABUF(45.7,IENS,2,"I"))
  1. . S:TMP>0 RASERV=TMP_U_$G(RABUF(45.7,IENS,2,"E"))
  1. E I RAWARD>0 D
  1. . ;--- Get name of the service
  1. . S IENS=(+RAWARD)_","
  1. . S TMP=$$GET1^DIQ(42,IENS,.03,,,"RAMSG")
  1. . I $G(DIERR) S RC=$$DBS^RAERR("RAMSG",-9,42,IENS) Q
  1. . ;--- Try to find the name in the SERVICE/SECTION file
  1. . D FIND^DIC(49,,"@;.01","X",TMP,2,"B",,,"RABUF","RAMSG")
  1. . I $G(DIERR) S RC=$$DBS^RAERR("RAMSG",-9,49) Q
  1. . ;--- Process the search results
  1. . Q:+$G(RABUF("DILIST",0))'=1
  1. . S TMP=+$G(RABUF("DILIST",2,1))
  1. . S:TMP>0 RASERV=TMP_U_$G(RABUF("DILIST","ID",1,.01))
  1. ;
  1. ;===
  1. Q $S(RC<0:RC,1:0)
  1. ;
  1. ;***** CALLS THE DEM^VADPT
  1. ;
  1. ; DFN Patient IEN (in file #2)
  1. ;
  1. ; [VALIDATE] Make sure that required fields are not empty
  1. ; [VAPTYP] See the DEM^VADPT description
  1. ; [VAHOW] See the DEM^VADPT description
  1. ;
  1. ; Output variables (see the DEM^VADPT description):
  1. ; VA, VADM
  1. ;
  1. ; Return values:
  1. ; <0 Error descriptor (see $$ERROR^RAERR)
  1. ; 0 Success
  1. ;
  1. VADEM(DFN,VALIDATE,VAPTYP,VAHOW) ;
  1. N A,I,J,K,K1,NC,NF,NQ,T,VAC,VAERR,VAN,VAROOT,VAS,VAV,VAW,VAX,VAZ,X,Y,Z
  1. Q:$G(DFN)'>0 $$IPVE^RAERR("DFN")
  1. D DEM^VADPT
  1. Q:$G(VAERR) $$IPVE^RAERR("DFN")
  1. ;--- Make sure that required fields are not empty
  1. D:$G(VALIDATE)
  1. . S:$G(VADM(1))="" VADM(1)="Unknown ("_DFN_")"
  1. . S:$G(VA("BID"))="" VA("BID")="UNKN"
  1. ;--- Success
  1. Q 0
  1. ;
  1. ;***** CALLS THE IN5^VADPT
  1. ;
  1. ; DFN Patient IEN (in file #2)
  1. ;
  1. ; [VAHOW] See the IN5^VADPT description
  1. ;
  1. ; Input variables (see the IN5^VADPT description):
  1. ; VAIP
  1. ;
  1. ; Output variables (see the IN5^VADPT description:
  1. ; VAIP
  1. ;
  1. ; Return values:
  1. ; <0 Error descriptor (see $$ERROR^RAERR)
  1. ; 0 Success
  1. ;
  1. VAIN5(DFN,VAHOW) ;
  1. 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
  1. Q:$G(DFN)'>0 $$IPVE^RAERR("DFN")
  1. D IN5^VADPT
  1. Q:$G(VAERR) $$IPVE^RAERR("DFN")
  1. ;--- Success
  1. Q 0