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

RAMAG02A.m

Go to the documentation of this file.
  1. RAMAG02A ;HCIOFO/SG - ORDERS/EXAMS API (REQUEST UTILITIES) ; 2/6/09 11:45am
  1. ;;5.0;Radiology/Nuclear Medicine;**90**;Mar 16, 1998;Build 20
  1. ;
  1. Q
  1. ;
  1. ;+++++ CREATES AN ORDER IN THE RAD/NUC MED ORDERS FILE (#75.1)
  1. ;
  1. ; Input variables:
  1. ; RACAT, RADFN, RADTE, RAIMGTYI, RAMDIV, RAMISC, RAMLC, RAPROC,
  1. ; RAREASON, REQLOC, REQPHYS
  1. ;
  1. ; Return values:
  1. ; <0 Error descriptor (see $$ERROR^RAERR)
  1. ; >0 IEN of the order in the file #75.1
  1. ;
  1. ; NOTE: This is an internal entry point. Do not call it from
  1. ; routines other than the ^RAMAG02.
  1. ;
  1. ORD() ;
  1. N IENS,RABUF,RAFDA,RAIENS,RALOCK,RAMSG,RAOIFN,RARC,TMP
  1. S RARC=0
  1. ;
  1. ;=== Create the new order
  1. S IENS="+1,"
  1. S RAFDA(75.1,IENS,.01)=RADFN ; NAME
  1. S RAFDA(75.1,IENS,2)=+RAPROC ; PROCEDURE
  1. S RAFDA(75.1,IENS,21)=RADTE ; DATE DESIRED
  1. D UPDATE^DIE(,"RAFDA","RAIENS","RAMSG")
  1. Q:$G(DIERR) $$DBS^RAERR("RAMSG",-9,75.1,IENS)
  1. S RAOIFN=RAIENS(1)
  1. ;
  1. ;=== Store remaining fields of the order
  1. D
  1. . ;--- Setup the error processing
  1. . N $ESTACK,$ETRAP D SETDEFEH^RAERR("RARC")
  1. . ;
  1. . ;--- Lock the record
  1. . K TMP S TMP(75.1,RAOIFN_",")=""
  1. . S RARC=$$LOCKFM^RALOCK(.TMP)
  1. . I RARC S RARC=$$LOCKERR^RAERR(RARC,"order") Q
  1. . M RALOCK=TMP
  1. . ;
  1. . ;--- Prepare required fields
  1. . S IENS=RAOIFN_","
  1. . S RAFDA(75.1,IENS,1.1)=RAREASON ; REASON FOR STUDY
  1. . S RAFDA(75.1,IENS,3)="`"_RAIMGTYI ; TYPE OF IMAGING
  1. . D ZSET(IENS,4,RACAT) ; CATEGORY OF EXAM
  1. . S RAFDA(75.1,IENS,14)="`"_REQPHYS ; REQUESTING PHYSICIAN
  1. . S RAFDA(75.1,IENS,20)="`"_RAMLC ; IMAGING LOCATION
  1. . S RAFDA(75.1,IENS,22)="`"_REQLOC ; REQUESTING LOCATION
  1. . ;
  1. . ;--- Prepare miscellaneous/optional fields
  1. . D ZSET(IENS,6,$G(RAMISC("REQURG"))) ; REQUEST URGENCY
  1. . D ZSET(IENS,13,$G(RAMISC("PREGNANT"))) ; PREGNANT
  1. . D ZSET(IENS,19,$G(RAMISC("TRANSPMODE"))) ; MODE OF TRANSPORT
  1. . D ZSET(IENS,24,$G(RAMISC("ISOLPROC"))) ; ISOLATION PROCEDURES
  1. . D ZSET(IENS,26,$G(RAMISC("REQNATURE"))) ; NATURE OF (NEW) ORDER...
  1. . ;
  1. . ;--- PRE-OP SCHEDULED DATE/TIME
  1. . S TMP=$G(RAMISC("PREOPDT"))
  1. . S:TMP>0 RAFDA(75.1,IENS,12)=$$FMTE^XLFDT(TMP)
  1. . ;
  1. . ;--- CLINICAL HISTORY FOR EXAM
  1. . S TMP=$NA(RAMISC("CLINHIST"))
  1. . S:$D(@TMP)>1 RAFDA(75.1,IENS,400)=TMP
  1. . ;
  1. . ;--- Update the record
  1. . D FILE^DIE("ET","RAFDA","RAMSG")
  1. . I $G(DIERR) S RARC=$$DBS^RAERR("RAMSG",-9,75.1,IENS) Q
  1. . ;
  1. . ;--- Store procedure modifiers
  1. . S RARC=$$PROCMOD(RAOIFN,RAPROC) Q:RARC<0
  1. . ;
  1. . ;--- Update status of the order
  1. . S RARC=$$UPDORDST^RAMAGU02(RAOIFN,5) Q:RARC<0
  1. ;
  1. ;=== Error handling and cleanup
  1. D:RARC<0
  1. . ;--- Delete incomplete record
  1. . N DA,DIK S DA=RAOIFN,DIK="^RAO(75.1," D ^DIK
  1. ;--- Unlock the record
  1. D UNLOCKFM^RALOCK(.RALOCK)
  1. ;---
  1. Q $S(RARC<0:RARC,1:RAOIFN)
  1. ;
  1. ;+++++ STORES PROCEDURE MODIFIERS
  1. ;
  1. ; RAOIFN IEN of the order in the file #75.1
  1. ;
  1. ; RAPROC Radiology procedure and modifiers
  1. ; ^01: Procedure IEN in file #71
  1. ; ^02: Optional procedure modifiers (IENs in
  1. ; ... the PROCEDURE MODIFIERS file (#71.2))
  1. ; ^nn:
  1. ;
  1. ; Return values:
  1. ; <0 Error descriptor (see $$ERROR^RAERR)
  1. ; 0 Success
  1. ;
  1. ; NOTE: This is an internal entry point. Do not call it from
  1. ; outside of this routine.
  1. ;
  1. PROCMOD(RAOIFN,RAPROC) ;
  1. N I,IENS,LP,PMCNT,RAFDA,RAMSG,RC,TMP
  1. S (PMCNT,RC)=0
  1. ;--- Prepare the data
  1. S LP=$L(RAPROC,U)
  1. F I=2:1:LP S TMP=$P(RAPROC,U,I) D:TMP'=""
  1. . S PMCNT=PMCNT+1,IENS="+"_PMCNT_","_(+RAOIFN)_","
  1. . S RAFDA(75.1125,IENS,.01)="`"_TMP
  1. ;--- Store procedure modifiers
  1. D:PMCNT>0
  1. . D UPDATE^DIE("E","RAFDA",,"RAMSG")
  1. . S:$G(DIERR) RC=$$DBS^RAERR("RAMSG",-9,75.1125)
  1. ;---
  1. Q RC
  1. ;
  1. ;+++++ VALIDATES ORDER PARAMETERS AND INITIALIZES RELATED VARIABLES
  1. ;
  1. ; Input variables:
  1. ; RACAT, RADFN, RADTE, RAMISC, RAMLC, RAPROC, RAREASON, REQLOC,
  1. ; REQPHYS
  1. ;
  1. ; Output variables:
  1. ; RAIMGTYI, RAMDIV, VA, VADM
  1. ;
  1. ; Return values:
  1. ; <0 Error descriptor (see $$ERROR^RAERR)
  1. ; 0 Success
  1. ;
  1. ; NOTE: This is an internal entry point. Do not call it from
  1. ; routines other than the ^RAMAG02.
  1. ;
  1. VALIDATE() ;
  1. N ERRCNT,I,IENS,L,RABUF,RAMSG,RC,TMP,X
  1. S ERRCNT=0
  1. ;=== Check required variables
  1. S X="RACAT,RADFN,RADTE,RAMLC,RAPROC,RAREASON,REQLOC,REQPHYS"
  1. S RC=$$CHKREQ^RAUTL22(X) Q:RC<0 RC
  1. ;
  1. ;=== Patient IEN (DFN)
  1. S RC=$$VADEM^RAMAGU07(RADFN)
  1. I RC'<0 S:$G(VADM(1))="" RC=$$IPVE^RAERR("RADFN")
  1. S:RC<0 ERRCNT=ERRCNT+1,RADFN=0
  1. ;
  1. ;=== Requesting physician
  1. I REQPHYS>0 D I X
  1. . N RACRE,Y S Y=REQPHYS S X=$$PROV^RABWORD()
  1. E D
  1. . D IPVE^RAERR("REQPHYS")
  1. . S ERRCNT=ERRCNT+1,REQPHYS=0
  1. ;
  1. ;=== Requesting location
  1. S RC=0 D
  1. . S TMP=$$GET1^DIQ(44,REQLOC_",",.01,,,"RAMSG")
  1. . I $G(DIERR) S RC=$$DBS^RAERR("RAMSG",-9,44,REQLOC_",") Q
  1. . ;--- Missing .01 field
  1. . I TMP="" S RC=$$IPVE^RAERR("REQLOC") Q
  1. S:RC<0 ERRCNT=ERRCNT+1,REQLOC=0
  1. K RAMSG
  1. ;
  1. ;=== Desired date
  1. I ($$ISEXCTDT^RAUTL22(RADTE)'>0)!($$FMTE^XLFDT(RADTE)=RADTE) D
  1. . D IPVE^RAERR("RADTE")
  1. . S ERRCNT=ERRCNT+1,RADTE=""
  1. E S RADTE=RADTE\1 ; Strip the time
  1. ;
  1. ;=== Imaging location IEN
  1. S RC=0 D
  1. . S IENS=RAMLC_",",(RAIMGTYI,RAMDIV)=0
  1. . D GETS^DIQ(79.1,IENS,"6;25","I","RABUF","RAMSG")
  1. . I $G(DIERR) S RC=$$DBS^RAERR("RAMSG",-9,79.1,IENS) Q
  1. . ;--- Check required fields
  1. . S RAIMGTYI=+$G(RABUF(79.1,IENS,6,"I")) ; Imaging type IEN
  1. . S RAMDIV=+$G(RABUF(79.1,IENS,25,"I")) ; Division IEN
  1. . I (RAIMGTYI'>0)!(RAMDIV'>0) D Q
  1. . . S RC=$$IPVE^RAERR("RAMLC")
  1. S:RC<0 ERRCNT=ERRCNT+1,RAMLC=0
  1. K RABUF,RAMSG
  1. ;
  1. ;=== Radiology procedure and modifiers
  1. S RC=0 D
  1. . I RAPROC'>0 S RC=$$IPVE^RAERR("RAPROC") Q
  1. . ;=== Additional checks only if related parameters are valid
  1. . Q:(RADTE'>0)!(RAIMGTYI'>0)
  1. . S RC=$$CHKPROC^RAMAGU03(RAPROC,RAIMGTYI,RADTE)
  1. S:RC<0 ERRCNT=ERRCNT+1,RAPROC=""
  1. ;
  1. ;=== Miscellaneous parameters
  1. S:$G(RAMISC("ISOLPROC"))="" RAMISC("ISOLPROC")="n"
  1. S:$G(RAMISC("REQNATURE"))="" RAMISC("REQNATURE")="s"
  1. S:$G(RAMISC("REQURG"))="" RAMISC("REQURG")="9"
  1. ;--- MODE OF TRANSPORT (Default value: WHEEL CHAIR for
  1. ;--- inpatient exam category, AMBULATORY otherwise)
  1. D:$G(RAMISC("TRANSPMODE"))=""
  1. . S RAMISC("TRANSPMODE")=$S(RACAT="I":"w",1:"a")
  1. ;--- PRE-OP SCHEDULED DATE/TIME
  1. S TMP=$G(RAMISC("PREOPDT"))
  1. D:TMP'=""
  1. . I ($$ISEXCTDT^RAUTL22(TMP)'>0)!($$FMTE^XLFDT(TMP)=TMP) D Q
  1. . . D IPVE^RAERR($NA(RAMISC("PREOPDT"))) S ERRCNT=ERRCNT+1
  1. . S RAMISC("PREOPDT")=+$E(TMP,1,12) ; Strip the seconds
  1. ;--- PREGNANT
  1. I $G(RAMISC("PREGNANT"))="" D
  1. . S:$P($G(VADM(5)),U)="F" RAMISC("PREGNANT")="u"
  1. E I $P($G(VADM(5)),U)="M" D
  1. . D ERROR^RAERR(-27) S ERRCNT=ERRCNT+1
  1. ;
  1. ;===
  1. Q $S(ERRCNT>0:$$ERROR^RAERR(-11),1:0)
  1. ;
  1. ;+++++ STORES THE EXTERNAL FIELD VALUE INTO THE RAFDA
  1. ZSET(IENS,FIELD,VALUE) ;
  1. Q:VALUE=""
  1. N RAMSG,TMP
  1. S TMP=$$EXTERNAL^DILFD(75.1,FIELD,,VALUE,"RAMSG")
  1. S RAFDA(75.1,IENS,FIELD)=$S(TMP'="":TMP,1:VALUE)
  1. Q