VPSMRAR3 ;DALOI/KML,WOIFO/BT - Cont. Update of VPS MRAR PDO file ;1/15/15 15:30
;;1.0;VA POINT OF SERVICE (KIOSKS);**3**;Jan 15, 2015;Build 64
;;Per VHA Directive 2004-038, this routine should not be modified.
;
Q
;
SUB53(PTIEN,INTERFC,DTIEN,FLD,DIEFLAG,DATA,REQFLDS) ; file the ADDITIONAL ALLERGIES multiple (853.53)
; INPUTS
; PTIEN : Patient DFN for 853.5 entry
; INTERFC : value of 'S' indicates that the entries in VPSMRAR coming from Staff-facing interface module.
; : value of 'P' indicates that the entries in VPSMRAR coming from Patient-facing interface module.
; DTIEN : transaction date/time ien for 853.51 sub-entry
; FLD : Field # where the data will be filed
; DIEFLAG : Filing Type (I = Internal, E = External)
; DATA : Field Name^IENS^Field Value
; REQFLDS : Array of required fields by fieldname and entry number
;
; OUTPUT
; success : RESULT = Field Name^IENS^Field Value^1
; failed : RESULT = Field Name^IENS^Field Value^99^error text describing why data did not get filed
;
N RESULT S RESULT=""
;
; -- Check required Additional Allergy fields
S RESULT=$$CHKADALR(INTERFC,.REQFLDS,DATA)
Q:RESULT'="" RESULT
;
; -- Add Allergy additional sub entry if it doesn't exist
N ALLERID S ALLERID=$P($P(DATA,U,2),",",2) ;Additional Allergy Entry #
I '$D(^VPS(853.5,PTIEN,"MRAR",DTIEN,"ALLERGYADD","B",ALLERID)) D ; allergy sub-entry does not exist yet so create stub entry
. N ADDOK S ADDOK=$$ADDMRAR^VPSMRAR0(853.53,DTIEN_","_PTIEN,ALLERID,DIEFLAG)
. I 'ADDOK S RESULT=$$RESULT^VPSMRAR0(DATA,99,"Data was not filed into MRAR PDO. Failed to add Allergy entry")
Q:RESULT'="" RESULT
;
; -- Get Allergy additional IEN
N ALLERIEN S ALLERIEN=$O(^VPS(853.5,PTIEN,"MRAR",DTIEN,"ALLERGYADD","B",ALLERID,""))
Q:ALLERIEN="" $$RESULT^VPSMRAR0(DATA,99,"Data was not filed into MRAR PDO")
;
; -- Store 853.53 field entries
N WP S WP=FLD="1"!(FLD=1.5)
N IENS S IENS=ALLERIEN_","_DTIEN_","_PTIEN_","
S RESULT=$$FILE^VPSMRAR0(853.53,WP,IENS,FLD,DIEFLAG,DATA)
;
Q RESULT
;
CHKADALR(INTERFC,REQFLDS,DATA) ;Check required Additional Allergy fields
; INPUTS
; INTERFC : value of 'S' indicates that the entries in VPSMRAR coming from Staff-facing interface module.
; : value of 'P' indicates that the entries in VPSMRAR coming from Patient-facing interface module.
; REQFLDS : Array of required fields by fieldname and entry number
; DATA : Field Name^IENS^Field Value
;
; OUTPUT
; success : RESULT = Field Name^IENS^Field Value^1
; failed : RESULT = Field Name^IENS^Field Value^99^error text describing why data did not get filed
;
N RESULT S RESULT=""
; -- Get Additional Allergy Entry #
N ALLERID S ALLERID=$P($P(DATA,U,2),",",2) ;Additional Allergy Entry #
I 'ALLERID S RESULT="99^Additional Allergy Entry # is required"
Q:RESULT'="" RESULT
;
; -- Additional Allergy Name must exist
I INTERFC="P",'$D(REQFLDS("ADD ALLERGY-VET",ALLERID)) S RESULT=$$RESULT^VPSMRAR0(DATA,99,"Additional Allergy Name (Patient Interface) is required")
I INTERFC="S",'$D(REQFLDS("ADD ALLERGY-PROVIDER",ALLERID)) S RESULT=$$RESULT^VPSMRAR0(DATA,99,"Additional Allergy Name (Staff Interface) is required")
Q RESULT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVPSMRAR3 3283 printed Dec 13, 2024@02:43:07 Page 2
VPSMRAR3 ;DALOI/KML,WOIFO/BT - Cont. Update of VPS MRAR PDO file ;1/15/15 15:30
+1 ;;1.0;VA POINT OF SERVICE (KIOSKS);**3**;Jan 15, 2015;Build 64
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
SUB53(PTIEN,INTERFC,DTIEN,FLD,DIEFLAG,DATA,REQFLDS) ; file the ADDITIONAL ALLERGIES multiple (853.53)
+1 ; INPUTS
+2 ; PTIEN : Patient DFN for 853.5 entry
+3 ; INTERFC : value of 'S' indicates that the entries in VPSMRAR coming from Staff-facing interface module.
+4 ; : value of 'P' indicates that the entries in VPSMRAR coming from Patient-facing interface module.
+5 ; DTIEN : transaction date/time ien for 853.51 sub-entry
+6 ; FLD : Field # where the data will be filed
+7 ; DIEFLAG : Filing Type (I = Internal, E = External)
+8 ; DATA : Field Name^IENS^Field Value
+9 ; REQFLDS : Array of required fields by fieldname and entry number
+10 ;
+11 ; OUTPUT
+12 ; success : RESULT = Field Name^IENS^Field Value^1
+13 ; failed : RESULT = Field Name^IENS^Field Value^99^error text describing why data did not get filed
+14 ;
+15 NEW RESULT
SET RESULT=""
+16 ;
+17 ; -- Check required Additional Allergy fields
+18 SET RESULT=$$CHKADALR(INTERFC,.REQFLDS,DATA)
+19 if RESULT'=""
QUIT RESULT
+20 ;
+21 ; -- Add Allergy additional sub entry if it doesn't exist
+22 ;Additional Allergy Entry #
NEW ALLERID
SET ALLERID=$PIECE($PIECE(DATA,U,2),",",2)
+23 ; allergy sub-entry does not exist yet so create stub entry
IF '$DATA(^VPS(853.5,PTIEN,"MRAR",DTIEN,"ALLERGYADD","B",ALLERID))
Begin DoDot:1
+24 NEW ADDOK
SET ADDOK=$$ADDMRAR^VPSMRAR0(853.53,DTIEN_","_PTIEN,ALLERID,DIEFLAG)
+25 IF 'ADDOK
SET RESULT=$$RESULT^VPSMRAR0(DATA,99,"Data was not filed into MRAR PDO. Failed to add Allergy entry")
End DoDot:1
+26 if RESULT'=""
QUIT RESULT
+27 ;
+28 ; -- Get Allergy additional IEN
+29 NEW ALLERIEN
SET ALLERIEN=$ORDER(^VPS(853.5,PTIEN,"MRAR",DTIEN,"ALLERGYADD","B",ALLERID,""))
+30 if ALLERIEN=""
QUIT $$RESULT^VPSMRAR0(DATA,99,"Data was not filed into MRAR PDO")
+31 ;
+32 ; -- Store 853.53 field entries
+33 NEW WP
SET WP=FLD="1"!(FLD=1.5)
+34 NEW IENS
SET IENS=ALLERIEN_","_DTIEN_","_PTIEN_","
+35 SET RESULT=$$FILE^VPSMRAR0(853.53,WP,IENS,FLD,DIEFLAG,DATA)
+36 ;
+37 QUIT RESULT
+38 ;
CHKADALR(INTERFC,REQFLDS,DATA) ;Check required Additional Allergy fields
+1 ; INPUTS
+2 ; INTERFC : value of 'S' indicates that the entries in VPSMRAR coming from Staff-facing interface module.
+3 ; : value of 'P' indicates that the entries in VPSMRAR coming from Patient-facing interface module.
+4 ; REQFLDS : Array of required fields by fieldname and entry number
+5 ; DATA : Field Name^IENS^Field Value
+6 ;
+7 ; OUTPUT
+8 ; success : RESULT = Field Name^IENS^Field Value^1
+9 ; failed : RESULT = Field Name^IENS^Field Value^99^error text describing why data did not get filed
+10 ;
+11 NEW RESULT
SET RESULT=""
+12 ; -- Get Additional Allergy Entry #
+13 ;Additional Allergy Entry #
NEW ALLERID
SET ALLERID=$PIECE($PIECE(DATA,U,2),",",2)
+14 IF 'ALLERID
SET RESULT="99^Additional Allergy Entry # is required"
+15 if RESULT'=""
QUIT RESULT
+16 ;
+17 ; -- Additional Allergy Name must exist
+18 IF INTERFC="P"
IF '$DATA(REQFLDS("ADD ALLERGY-VET",ALLERID))
SET RESULT=$$RESULT^VPSMRAR0(DATA,99,"Additional Allergy Name (Patient Interface) is required")
+19 IF INTERFC="S"
IF '$DATA(REQFLDS("ADD ALLERGY-PROVIDER",ALLERID))
SET RESULT=$$RESULT^VPSMRAR0(DATA,99,"Additional Allergy Name (Staff Interface) is required")
+20 QUIT RESULT
