- 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 Feb 19, 2025@00:03:20 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