- RAMAG02A ;HCIOFO/SG - ORDERS/EXAMS API (REQUEST UTILITIES) ; 2/6/09 11:45am
- ;;5.0;Radiology/Nuclear Medicine;**90**;Mar 16, 1998;Build 20
- ;
- Q
- ;
- ;+++++ CREATES AN ORDER IN THE RAD/NUC MED ORDERS FILE (#75.1)
- ;
- ; Input variables:
- ; RACAT, RADFN, RADTE, RAIMGTYI, RAMDIV, RAMISC, RAMLC, RAPROC,
- ; RAREASON, REQLOC, REQPHYS
- ;
- ; Return values:
- ; <0 Error descriptor (see $$ERROR^RAERR)
- ; >0 IEN of the order in the file #75.1
- ;
- ; NOTE: This is an internal entry point. Do not call it from
- ; routines other than the ^RAMAG02.
- ;
- ORD() ;
- N IENS,RABUF,RAFDA,RAIENS,RALOCK,RAMSG,RAOIFN,RARC,TMP
- S RARC=0
- ;
- ;=== Create the new order
- S IENS="+1,"
- S RAFDA(75.1,IENS,.01)=RADFN ; NAME
- S RAFDA(75.1,IENS,2)=+RAPROC ; PROCEDURE
- S RAFDA(75.1,IENS,21)=RADTE ; DATE DESIRED
- D UPDATE^DIE(,"RAFDA","RAIENS","RAMSG")
- Q:$G(DIERR) $$DBS^RAERR("RAMSG",-9,75.1,IENS)
- S RAOIFN=RAIENS(1)
- ;
- ;=== Store remaining fields of the order
- D
- . ;--- Setup the error processing
- . N $ESTACK,$ETRAP D SETDEFEH^RAERR("RARC")
- . ;
- . ;--- Lock the record
- . K TMP S TMP(75.1,RAOIFN_",")=""
- . S RARC=$$LOCKFM^RALOCK(.TMP)
- . I RARC S RARC=$$LOCKERR^RAERR(RARC,"order") Q
- . M RALOCK=TMP
- . ;
- . ;--- Prepare required fields
- . S IENS=RAOIFN_","
- . S RAFDA(75.1,IENS,1.1)=RAREASON ; REASON FOR STUDY
- . S RAFDA(75.1,IENS,3)="`"_RAIMGTYI ; TYPE OF IMAGING
- . D ZSET(IENS,4,RACAT) ; CATEGORY OF EXAM
- . S RAFDA(75.1,IENS,14)="`"_REQPHYS ; REQUESTING PHYSICIAN
- . S RAFDA(75.1,IENS,20)="`"_RAMLC ; IMAGING LOCATION
- . S RAFDA(75.1,IENS,22)="`"_REQLOC ; REQUESTING LOCATION
- . ;
- . ;--- Prepare miscellaneous/optional fields
- . D ZSET(IENS,6,$G(RAMISC("REQURG"))) ; REQUEST URGENCY
- . D ZSET(IENS,13,$G(RAMISC("PREGNANT"))) ; PREGNANT
- . D ZSET(IENS,19,$G(RAMISC("TRANSPMODE"))) ; MODE OF TRANSPORT
- . D ZSET(IENS,24,$G(RAMISC("ISOLPROC"))) ; ISOLATION PROCEDURES
- . D ZSET(IENS,26,$G(RAMISC("REQNATURE"))) ; NATURE OF (NEW) ORDER...
- . ;
- . ;--- PRE-OP SCHEDULED DATE/TIME
- . S TMP=$G(RAMISC("PREOPDT"))
- . S:TMP>0 RAFDA(75.1,IENS,12)=$$FMTE^XLFDT(TMP)
- . ;
- . ;--- CLINICAL HISTORY FOR EXAM
- . S TMP=$NA(RAMISC("CLINHIST"))
- . S:$D(@TMP)>1 RAFDA(75.1,IENS,400)=TMP
- . ;
- . ;--- Update the record
- . D FILE^DIE("ET","RAFDA","RAMSG")
- . I $G(DIERR) S RARC=$$DBS^RAERR("RAMSG",-9,75.1,IENS) Q
- . ;
- . ;--- Store procedure modifiers
- . S RARC=$$PROCMOD(RAOIFN,RAPROC) Q:RARC<0
- . ;
- . ;--- Update status of the order
- . S RARC=$$UPDORDST^RAMAGU02(RAOIFN,5) Q:RARC<0
- ;
- ;=== Error handling and cleanup
- D:RARC<0
- . ;--- Delete incomplete record
- . N DA,DIK S DA=RAOIFN,DIK="^RAO(75.1," D ^DIK
- ;--- Unlock the record
- D UNLOCKFM^RALOCK(.RALOCK)
- ;---
- Q $S(RARC<0:RARC,1:RAOIFN)
- ;
- ;+++++ STORES PROCEDURE MODIFIERS
- ;
- ; RAOIFN IEN of the order in the file #75.1
- ;
- ; RAPROC Radiology procedure and modifiers
- ; ^01: Procedure IEN in file #71
- ; ^02: Optional procedure modifiers (IENs in
- ; ... the PROCEDURE MODIFIERS file (#71.2))
- ; ^nn:
- ;
- ; Return values:
- ; <0 Error descriptor (see $$ERROR^RAERR)
- ; 0 Success
- ;
- ; NOTE: This is an internal entry point. Do not call it from
- ; outside of this routine.
- ;
- PROCMOD(RAOIFN,RAPROC) ;
- N I,IENS,LP,PMCNT,RAFDA,RAMSG,RC,TMP
- S (PMCNT,RC)=0
- ;--- Prepare the data
- S LP=$L(RAPROC,U)
- F I=2:1:LP S TMP=$P(RAPROC,U,I) D:TMP'=""
- . S PMCNT=PMCNT+1,IENS="+"_PMCNT_","_(+RAOIFN)_","
- . S RAFDA(75.1125,IENS,.01)="`"_TMP
- ;--- Store procedure modifiers
- D:PMCNT>0
- . D UPDATE^DIE("E","RAFDA",,"RAMSG")
- . S:$G(DIERR) RC=$$DBS^RAERR("RAMSG",-9,75.1125)
- ;---
- Q RC
- ;
- ;+++++ VALIDATES ORDER PARAMETERS AND INITIALIZES RELATED VARIABLES
- ;
- ; Input variables:
- ; RACAT, RADFN, RADTE, RAMISC, RAMLC, RAPROC, RAREASON, REQLOC,
- ; REQPHYS
- ;
- ; Output variables:
- ; RAIMGTYI, RAMDIV, VA, VADM
- ;
- ; Return values:
- ; <0 Error descriptor (see $$ERROR^RAERR)
- ; 0 Success
- ;
- ; NOTE: This is an internal entry point. Do not call it from
- ; routines other than the ^RAMAG02.
- ;
- VALIDATE() ;
- N ERRCNT,I,IENS,L,RABUF,RAMSG,RC,TMP,X
- S ERRCNT=0
- ;=== Check required variables
- S X="RACAT,RADFN,RADTE,RAMLC,RAPROC,RAREASON,REQLOC,REQPHYS"
- S RC=$$CHKREQ^RAUTL22(X) Q:RC<0 RC
- ;
- ;=== Patient IEN (DFN)
- S RC=$$VADEM^RAMAGU07(RADFN)
- I RC'<0 S:$G(VADM(1))="" RC=$$IPVE^RAERR("RADFN")
- S:RC<0 ERRCNT=ERRCNT+1,RADFN=0
- ;
- ;=== Requesting physician
- I REQPHYS>0 D I X
- . N RACRE,Y S Y=REQPHYS S X=$$PROV^RABWORD()
- E D
- . D IPVE^RAERR("REQPHYS")
- . S ERRCNT=ERRCNT+1,REQPHYS=0
- ;
- ;=== Requesting location
- S RC=0 D
- . S TMP=$$GET1^DIQ(44,REQLOC_",",.01,,,"RAMSG")
- . I $G(DIERR) S RC=$$DBS^RAERR("RAMSG",-9,44,REQLOC_",") Q
- . ;--- Missing .01 field
- . I TMP="" S RC=$$IPVE^RAERR("REQLOC") Q
- S:RC<0 ERRCNT=ERRCNT+1,REQLOC=0
- K RAMSG
- ;
- ;=== Desired date
- I ($$ISEXCTDT^RAUTL22(RADTE)'>0)!($$FMTE^XLFDT(RADTE)=RADTE) D
- . D IPVE^RAERR("RADTE")
- . S ERRCNT=ERRCNT+1,RADTE=""
- E S RADTE=RADTE\1 ; Strip the time
- ;
- ;=== Imaging location IEN
- S RC=0 D
- . S IENS=RAMLC_",",(RAIMGTYI,RAMDIV)=0
- . D GETS^DIQ(79.1,IENS,"6;25","I","RABUF","RAMSG")
- . I $G(DIERR) S RC=$$DBS^RAERR("RAMSG",-9,79.1,IENS) Q
- . ;--- Check required fields
- . S RAIMGTYI=+$G(RABUF(79.1,IENS,6,"I")) ; Imaging type IEN
- . S RAMDIV=+$G(RABUF(79.1,IENS,25,"I")) ; Division IEN
- . I (RAIMGTYI'>0)!(RAMDIV'>0) D Q
- . . S RC=$$IPVE^RAERR("RAMLC")
- S:RC<0 ERRCNT=ERRCNT+1,RAMLC=0
- K RABUF,RAMSG
- ;
- ;=== Radiology procedure and modifiers
- S RC=0 D
- . I RAPROC'>0 S RC=$$IPVE^RAERR("RAPROC") Q
- . ;=== Additional checks only if related parameters are valid
- . Q:(RADTE'>0)!(RAIMGTYI'>0)
- . S RC=$$CHKPROC^RAMAGU03(RAPROC,RAIMGTYI,RADTE)
- S:RC<0 ERRCNT=ERRCNT+1,RAPROC=""
- ;
- ;=== Miscellaneous parameters
- S:$G(RAMISC("ISOLPROC"))="" RAMISC("ISOLPROC")="n"
- S:$G(RAMISC("REQNATURE"))="" RAMISC("REQNATURE")="s"
- S:$G(RAMISC("REQURG"))="" RAMISC("REQURG")="9"
- ;--- MODE OF TRANSPORT (Default value: WHEEL CHAIR for
- ;--- inpatient exam category, AMBULATORY otherwise)
- D:$G(RAMISC("TRANSPMODE"))=""
- . S RAMISC("TRANSPMODE")=$S(RACAT="I":"w",1:"a")
- ;--- PRE-OP SCHEDULED DATE/TIME
- S TMP=$G(RAMISC("PREOPDT"))
- D:TMP'=""
- . I ($$ISEXCTDT^RAUTL22(TMP)'>0)!($$FMTE^XLFDT(TMP)=TMP) D Q
- . . D IPVE^RAERR($NA(RAMISC("PREOPDT"))) S ERRCNT=ERRCNT+1
- . S RAMISC("PREOPDT")=+$E(TMP,1,12) ; Strip the seconds
- ;--- PREGNANT
- I $G(RAMISC("PREGNANT"))="" D
- . S:$P($G(VADM(5)),U)="F" RAMISC("PREGNANT")="u"
- E I $P($G(VADM(5)),U)="M" D
- . D ERROR^RAERR(-27) S ERRCNT=ERRCNT+1
- ;
- ;===
- Q $S(ERRCNT>0:$$ERROR^RAERR(-11),1:0)
- ;
- ;+++++ STORES THE EXTERNAL FIELD VALUE INTO THE RAFDA
- ZSET(IENS,FIELD,VALUE) ;
- Q:VALUE=""
- N RAMSG,TMP
- S TMP=$$EXTERNAL^DILFD(75.1,FIELD,,VALUE,"RAMSG")
- S RAFDA(75.1,IENS,FIELD)=$S(TMP'="":TMP,1:VALUE)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAMAG02A 7096 printed Feb 19, 2025@00:03:03 Page 2
- 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
- +2 ;
- +3 QUIT
- +4 ;
- +5 ;+++++ CREATES AN ORDER IN THE RAD/NUC MED ORDERS FILE (#75.1)
- +6 ;
- +7 ; Input variables:
- +8 ; RACAT, RADFN, RADTE, RAIMGTYI, RAMDIV, RAMISC, RAMLC, RAPROC,
- +9 ; RAREASON, REQLOC, REQPHYS
- +10 ;
- +11 ; Return values:
- +12 ; <0 Error descriptor (see $$ERROR^RAERR)
- +13 ; >0 IEN of the order in the file #75.1
- +14 ;
- +15 ; NOTE: This is an internal entry point. Do not call it from
- +16 ; routines other than the ^RAMAG02.
- +17 ;
- ORD() ;
- +1 NEW IENS,RABUF,RAFDA,RAIENS,RALOCK,RAMSG,RAOIFN,RARC,TMP
- +2 SET RARC=0
- +3 ;
- +4 ;=== Create the new order
- +5 SET IENS="+1,"
- +6 ; NAME
- SET RAFDA(75.1,IENS,.01)=RADFN
- +7 ; PROCEDURE
- SET RAFDA(75.1,IENS,2)=+RAPROC
- +8 ; DATE DESIRED
- SET RAFDA(75.1,IENS,21)=RADTE
- +9 DO UPDATE^DIE(,"RAFDA","RAIENS","RAMSG")
- +10 if $GET(DIERR)
- QUIT $$DBS^RAERR("RAMSG",-9,75.1,IENS)
- +11 SET RAOIFN=RAIENS(1)
- +12 ;
- +13 ;=== Store remaining fields of the order
- +14 Begin DoDot:1
- +15 ;--- Setup the error processing
- +16 NEW $ESTACK,$ETRAP
- DO SETDEFEH^RAERR("RARC")
- +17 ;
- +18 ;--- Lock the record
- +19 KILL TMP
- SET TMP(75.1,RAOIFN_",")=""
- +20 SET RARC=$$LOCKFM^RALOCK(.TMP)
- +21 IF RARC
- SET RARC=$$LOCKERR^RAERR(RARC,"order")
- QUIT
- +22 MERGE RALOCK=TMP
- +23 ;
- +24 ;--- Prepare required fields
- +25 SET IENS=RAOIFN_","
- +26 ; REASON FOR STUDY
- SET RAFDA(75.1,IENS,1.1)=RAREASON
- +27 ; TYPE OF IMAGING
- SET RAFDA(75.1,IENS,3)="`"_RAIMGTYI
- +28 ; CATEGORY OF EXAM
- DO ZSET(IENS,4,RACAT)
- +29 ; REQUESTING PHYSICIAN
- SET RAFDA(75.1,IENS,14)="`"_REQPHYS
- +30 ; IMAGING LOCATION
- SET RAFDA(75.1,IENS,20)="`"_RAMLC
- +31 ; REQUESTING LOCATION
- SET RAFDA(75.1,IENS,22)="`"_REQLOC
- +32 ;
- +33 ;--- Prepare miscellaneous/optional fields
- +34 ; REQUEST URGENCY
- DO ZSET(IENS,6,$GET(RAMISC("REQURG")))
- +35 ; PREGNANT
- DO ZSET(IENS,13,$GET(RAMISC("PREGNANT")))
- +36 ; MODE OF TRANSPORT
- DO ZSET(IENS,19,$GET(RAMISC("TRANSPMODE")))
- +37 ; ISOLATION PROCEDURES
- DO ZSET(IENS,24,$GET(RAMISC("ISOLPROC")))
- +38 ; NATURE OF (NEW) ORDER...
- DO ZSET(IENS,26,$GET(RAMISC("REQNATURE")))
- +39 ;
- +40 ;--- PRE-OP SCHEDULED DATE/TIME
- +41 SET TMP=$GET(RAMISC("PREOPDT"))
- +42 if TMP>0
- SET RAFDA(75.1,IENS,12)=$$FMTE^XLFDT(TMP)
- +43 ;
- +44 ;--- CLINICAL HISTORY FOR EXAM
- +45 SET TMP=$NAME(RAMISC("CLINHIST"))
- +46 if $DATA(@TMP)>1
- SET RAFDA(75.1,IENS,400)=TMP
- +47 ;
- +48 ;--- Update the record
- +49 DO FILE^DIE("ET","RAFDA","RAMSG")
- +50 IF $GET(DIERR)
- SET RARC=$$DBS^RAERR("RAMSG",-9,75.1,IENS)
- QUIT
- +51 ;
- +52 ;--- Store procedure modifiers
- +53 SET RARC=$$PROCMOD(RAOIFN,RAPROC)
- if RARC<0
- QUIT
- +54 ;
- +55 ;--- Update status of the order
- +56 SET RARC=$$UPDORDST^RAMAGU02(RAOIFN,5)
- if RARC<0
- QUIT
- End DoDot:1
- +57 ;
- +58 ;=== Error handling and cleanup
- +59 if RARC<0
- Begin DoDot:1
- +60 ;--- Delete incomplete record
- +61 NEW DA,DIK
- SET DA=RAOIFN
- SET DIK="^RAO(75.1,"
- DO ^DIK
- End DoDot:1
- +62 ;--- Unlock the record
- +63 DO UNLOCKFM^RALOCK(.RALOCK)
- +64 ;---
- +65 QUIT $SELECT(RARC<0:RARC,1:RAOIFN)
- +66 ;
- +67 ;+++++ STORES PROCEDURE MODIFIERS
- +68 ;
- +69 ; RAOIFN IEN of the order in the file #75.1
- +70 ;
- +71 ; RAPROC Radiology procedure and modifiers
- +72 ; ^01: Procedure IEN in file #71
- +73 ; ^02: Optional procedure modifiers (IENs in
- +74 ; ... the PROCEDURE MODIFIERS file (#71.2))
- +75 ; ^nn:
- +76 ;
- +77 ; Return values:
- +78 ; <0 Error descriptor (see $$ERROR^RAERR)
- +79 ; 0 Success
- +80 ;
- +81 ; NOTE: This is an internal entry point. Do not call it from
- +82 ; outside of this routine.
- +83 ;
- PROCMOD(RAOIFN,RAPROC) ;
- +1 NEW I,IENS,LP,PMCNT,RAFDA,RAMSG,RC,TMP
- +2 SET (PMCNT,RC)=0
- +3 ;--- Prepare the data
- +4 SET LP=$LENGTH(RAPROC,U)
- +5 FOR I=2:1:LP
- SET TMP=$PIECE(RAPROC,U,I)
- if TMP'=""
- Begin DoDot:1
- +6 SET PMCNT=PMCNT+1
- SET IENS="+"_PMCNT_","_(+RAOIFN)_","
- +7 SET RAFDA(75.1125,IENS,.01)="`"_TMP
- End DoDot:1
- +8 ;--- Store procedure modifiers
- +9 if PMCNT>0
- Begin DoDot:1
- +10 DO UPDATE^DIE("E","RAFDA",,"RAMSG")
- +11 if $GET(DIERR)
- SET RC=$$DBS^RAERR("RAMSG",-9,75.1125)
- End DoDot:1
- +12 ;---
- +13 QUIT RC
- +14 ;
- +15 ;+++++ VALIDATES ORDER PARAMETERS AND INITIALIZES RELATED VARIABLES
- +16 ;
- +17 ; Input variables:
- +18 ; RACAT, RADFN, RADTE, RAMISC, RAMLC, RAPROC, RAREASON, REQLOC,
- +19 ; REQPHYS
- +20 ;
- +21 ; Output variables:
- +22 ; RAIMGTYI, RAMDIV, VA, VADM
- +23 ;
- +24 ; Return values:
- +25 ; <0 Error descriptor (see $$ERROR^RAERR)
- +26 ; 0 Success
- +27 ;
- +28 ; NOTE: This is an internal entry point. Do not call it from
- +29 ; routines other than the ^RAMAG02.
- +30 ;
- VALIDATE() ;
- +1 NEW ERRCNT,I,IENS,L,RABUF,RAMSG,RC,TMP,X
- +2 SET ERRCNT=0
- +3 ;=== Check required variables
- +4 SET X="RACAT,RADFN,RADTE,RAMLC,RAPROC,RAREASON,REQLOC,REQPHYS"
- +5 SET RC=$$CHKREQ^RAUTL22(X)
- if RC<0
- QUIT RC
- +6 ;
- +7 ;=== Patient IEN (DFN)
- +8 SET RC=$$VADEM^RAMAGU07(RADFN)
- +9 IF RC'<0
- if $GET(VADM(1))=""
- SET RC=$$IPVE^RAERR("RADFN")
- +10 if RC<0
- SET ERRCNT=ERRCNT+1
- SET RADFN=0
- +11 ;
- +12 ;=== Requesting physician
- +13 IF REQPHYS>0
- Begin DoDot:1
- +14 NEW RACRE,Y
- SET Y=REQPHYS
- SET X=$$PROV^RABWORD()
- End DoDot:1
- IF X
- +15 IF '$TEST
- Begin DoDot:1
- +16 DO IPVE^RAERR("REQPHYS")
- +17 SET ERRCNT=ERRCNT+1
- SET REQPHYS=0
- End DoDot:1
- +18 ;
- +19 ;=== Requesting location
- +20 SET RC=0
- Begin DoDot:1
- +21 SET TMP=$$GET1^DIQ(44,REQLOC_",",.01,,,"RAMSG")
- +22 IF $GET(DIERR)
- SET RC=$$DBS^RAERR("RAMSG",-9,44,REQLOC_",")
- QUIT
- +23 ;--- Missing .01 field
- +24 IF TMP=""
- SET RC=$$IPVE^RAERR("REQLOC")
- QUIT
- End DoDot:1
- +25 if RC<0
- SET ERRCNT=ERRCNT+1
- SET REQLOC=0
- +26 KILL RAMSG
- +27 ;
- +28 ;=== Desired date
- +29 IF ($$ISEXCTDT^RAUTL22(RADTE)'>0)!($$FMTE^XLFDT(RADTE)=RADTE)
- Begin DoDot:1
- +30 DO IPVE^RAERR("RADTE")
- +31 SET ERRCNT=ERRCNT+1
- SET RADTE=""
- End DoDot:1
- +32 ; Strip the time
- IF '$TEST
- SET RADTE=RADTE\1
- +33 ;
- +34 ;=== Imaging location IEN
- +35 SET RC=0
- Begin DoDot:1
- +36 SET IENS=RAMLC_","
- SET (RAIMGTYI,RAMDIV)=0
- +37 DO GETS^DIQ(79.1,IENS,"6;25","I","RABUF","RAMSG")
- +38 IF $GET(DIERR)
- SET RC=$$DBS^RAERR("RAMSG",-9,79.1,IENS)
- QUIT
- +39 ;--- Check required fields
- +40 ; Imaging type IEN
- SET RAIMGTYI=+$GET(RABUF(79.1,IENS,6,"I"))
- +41 ; Division IEN
- SET RAMDIV=+$GET(RABUF(79.1,IENS,25,"I"))
- +42 IF (RAIMGTYI'>0)!(RAMDIV'>0)
- Begin DoDot:2
- +43 SET RC=$$IPVE^RAERR("RAMLC")
- End DoDot:2
- QUIT
- End DoDot:1
- +44 if RC<0
- SET ERRCNT=ERRCNT+1
- SET RAMLC=0
- +45 KILL RABUF,RAMSG
- +46 ;
- +47 ;=== Radiology procedure and modifiers
- +48 SET RC=0
- Begin DoDot:1
- +49 IF RAPROC'>0
- SET RC=$$IPVE^RAERR("RAPROC")
- QUIT
- +50 ;=== Additional checks only if related parameters are valid
- +51 if (RADTE'>0)!(RAIMGTYI'>0)
- QUIT
- +52 SET RC=$$CHKPROC^RAMAGU03(RAPROC,RAIMGTYI,RADTE)
- End DoDot:1
- +53 if RC<0
- SET ERRCNT=ERRCNT+1
- SET RAPROC=""
- +54 ;
- +55 ;=== Miscellaneous parameters
- +56 if $GET(RAMISC("ISOLPROC"))=""
- SET RAMISC("ISOLPROC")="n"
- +57 if $GET(RAMISC("REQNATURE"))=""
- SET RAMISC("REQNATURE")="s"
- +58 if $GET(RAMISC("REQURG"))=""
- SET RAMISC("REQURG")="9"
- +59 ;--- MODE OF TRANSPORT (Default value: WHEEL CHAIR for
- +60 ;--- inpatient exam category, AMBULATORY otherwise)
- +61 if $GET(RAMISC("TRANSPMODE"))=""
- Begin DoDot:1
- +62 SET RAMISC("TRANSPMODE")=$SELECT(RACAT="I":"w",1:"a")
- End DoDot:1
- +63 ;--- PRE-OP SCHEDULED DATE/TIME
- +64 SET TMP=$GET(RAMISC("PREOPDT"))
- +65 if TMP'=""
- Begin DoDot:1
- +66 IF ($$ISEXCTDT^RAUTL22(TMP)'>0)!($$FMTE^XLFDT(TMP)=TMP)
- Begin DoDot:2
- +67 DO IPVE^RAERR($NAME(RAMISC("PREOPDT")))
- SET ERRCNT=ERRCNT+1
- End DoDot:2
- QUIT
- +68 ; Strip the seconds
- SET RAMISC("PREOPDT")=+$EXTRACT(TMP,1,12)
- End DoDot:1
- +69 ;--- PREGNANT
- +70 IF $GET(RAMISC("PREGNANT"))=""
- Begin DoDot:1
- +71 if $PIECE($GET(VADM(5)),U)="F"
- SET RAMISC("PREGNANT")="u"
- End DoDot:1
- +72 IF '$TEST
- IF $PIECE($GET(VADM(5)),U)="M"
- Begin DoDot:1
- +73 DO ERROR^RAERR(-27)
- SET ERRCNT=ERRCNT+1
- End DoDot:1
- +74 ;
- +75 ;===
- +76 QUIT $SELECT(ERRCNT>0:$$ERROR^RAERR(-11),1:0)
- +77 ;
- +78 ;+++++ STORES THE EXTERNAL FIELD VALUE INTO THE RAFDA
- ZSET(IENS,FIELD,VALUE) ;
- +1 if VALUE=""
- QUIT
- +2 NEW RAMSG,TMP
- +3 SET TMP=$$EXTERNAL^DILFD(75.1,FIELD,,VALUE,"RAMSG")
- +4 SET RAFDA(75.1,IENS,FIELD)=$SELECT(TMP'="":TMP,1:VALUE)
- +5 QUIT