RAMAG02A ;HCIOFO/SG - ORDERS/EXAMS API (REQUEST UTILITIES) ; 06 Oct 2013 11:10 AM
;;5.0;Radiology/Nuclear Medicine;**90,1005**;Mar 16, 1998;Build 13
;
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
;
;IHS/BJI/DAY - Patch 1005 - Gender Fix
;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
;
I $G(RAMISC("PREGNANT"))="",$P($G(VADM(5)),U)'="M" S RAMISC("PREGNANT")="u"
I $G(RAMISC("PREGNANT"))["y",$P($G(VADM(5)),U)="M" D ERROR^RAERR(-27) S ERRCNT=ERRCNT+1
I $G(RAMISC("PREGNANT"))["Y",$P($G(VADM(5)),U)="M" 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
RAMAG02A ;HCIOFO/SG - ORDERS/EXAMS API (REQUEST UTILITIES) ; 06 Oct 2013 11:10 AM
+1 ;;5.0;Radiology/Nuclear Medicine;**90,1005**;Mar 16, 1998;Build 13
+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 ;
+71 ;IHS/BJI/DAY - Patch 1005 - Gender Fix
+72 ;I $G(RAMISC("PREGNANT"))="" D
+73 ;. S:$P($G(VADM(5)),U)="F" RAMISC("PREGNANT")="u"
+74 ;E I $P($G(VADM(5)),U)="M" D
+75 ;. D ERROR^RAERR(-27) S ERRCNT=ERRCNT+1
+76 ;
+77 IF $GET(RAMISC("PREGNANT"))=""
IF $PIECE($GET(VADM(5)),U)'="M"
SET RAMISC("PREGNANT")="u"
+78 IF $GET(RAMISC("PREGNANT"))["y"
IF $PIECE($GET(VADM(5)),U)="M"
DO ERROR^RAERR(-27)
SET ERRCNT=ERRCNT+1
+79 IF $GET(RAMISC("PREGNANT"))["Y"
IF $PIECE($GET(VADM(5)),U)="M"
DO ERROR^RAERR(-27)
SET ERRCNT=ERRCNT+1
+80 ;
+81 ;===
+82 QUIT $SELECT(ERRCNT>0:$$ERROR^RAERR(-11),1:0)
+83 ;
+84 ;+++++ 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
