VPSMRAR4 ;DALOI/KML,WOIFO/BT - 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
;
SUB54(PTIEN,DTIEN,FLD,DIEFLAG,DATA,REQFLDS) ; file the MEDICATIONS multiple (853.54)
; INPUTS
; PTIEN : Patient DFN for 853.5 entry
; 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 : composite string assigned to a subscript in the local array passed in by Vecna for the specific field
; 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=""
;
S RESULT=$$CHKMED(.REQFLDS,DATA)
Q:RESULT'="" RESULT
;
; -- Add Medication sub entry if it doesn't exist
N MEDID S MEDID=$P($P(DATA,U,2),",",2) ;MEDICATIONS Entry #
I '$D(^VPS(853.5,PTIEN,"MRAR",DTIEN,"MEDS","B",MEDID)) D ; MEDS sub-entry does not exist yet so create stub entry
. N ADDOK S ADDOK=$$ADDMRAR^VPSMRAR0(853.54,DTIEN_","_PTIEN,MEDID,DIEFLAG)
. I 'ADDOK S RESULT=$$RESULT^VPSMRAR0(DATA,99,"Data was not filed into MRAR PDO. Failed to add Medications entry")
Q:RESULT'="" RESULT
;
; -- Get Medication IEN
N MEDIEN S MEDIEN=$O(^VPS(853.5,PTIEN,"MRAR",DTIEN,"MEDS","B",MEDID,""))
Q:MEDIEN="" $$RESULT^VPSMRAR0(DATA,99,"Data was not filed into MRAR PDO")
;
; -- Store 853.54 field entries
N WP S WP=FLD=23!(FLD=24)!(FLD=25)
N IENS S IENS=MEDIEN_","_DTIEN_","_PTIEN_","
S RESULT=$$FILE^VPSMRAR0(853.54,WP,IENS,FLD,DIEFLAG,DATA)
;
Q RESULT
;
SUB54X(SUBFIL,SUBS,PTIEN,DTIEN,DATA,REQFLDS,DIEFLAG) ; file the MED CHANGED/CONFIRMED/DISCREPANCY INDICATORS
; INPUTS
; SUBFIL : Sub File# : 853.5454, 853.5455, or 853.5452
; SUBS : Subscript associated with the Sub File : MCHG, MCNFR, MDISCR
; PTIEN : D0 - Patient DFN for 853.5 entry1
; DTIEN : D1 - transaction date/time ien for 853.51 sub-entry
; DATA : Field Name^IENS^Field Value
; REQFLDS : Array of required fields by fieldname and entry number
; DIEFLAG : Filing Type (I = Internal, E = External)
;
; 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 Medication fields
S RESULT=$$CHKALM(.REQFLDS,DATA)
Q:RESULT'="" RESULT
;
; -- Add Medication changed/confirmed/discrepancy sub entry if it doesn't exist
N MEDID S MEDID=$P($P(DATA,U,2),",",2)
N MIEN S MIEN=$O(^VPS(853.5,PTIEN,"MRAR",DTIEN,"MEDS","B",MEDID,0))
I 'MIEN S RESULT=$$RESULT^VPSMRAR0(DATA,99,"Corrupted Medication entry")
Q:RESULT'="" RESULT
;
N MEDCHGID S MEDCHGID=$P($P(DATA,U,2),",",3)
;I $P(DATA,U,3)'=MEDCHGID S RESULT=$$RESULT^VPSMRAR0(DATA,99,"Value does not match third index")
;Q:RESULT'="" RESULT
N EXIST S EXIST=$D(^VPS(853.5,PTIEN,"MRAR",DTIEN,"MEDS",MIEN,SUBS,"B",MEDCHGID))
I EXIST S RESULT=$$RESULT^VPSMRAR0(DATA,99,"Duplicate Medication Changed/Confirmed/Discrepancy entry")
Q:RESULT'="" RESULT
;
N OK S OK=$$ADDMRAR^VPSMRAR0(SUBFIL,MIEN_","_DTIEN_","_PTIEN,MEDCHGID,"")
I 'OK S RESULT=$$RESULT^VPSMRAR0(DATA,99,"Unable to file Medication Changed/Confirmed/Discrepancy entry")
I OK S RESULT=$$RESULT^VPSMRAR0(DATA,1,"") ; data for specific field was filed successfully into PDO record
;
Q RESULT
;
CHKMED(REQFLDS,DATA) ;Check required Medication fields
; INPUTS
; 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=""
; -- Medication Entry # is required field
N MEDID S MEDID=$P($P(DATA,U,2),",",2) ;MEDICATIONS Entry #
I 'MEDID S RESULT=$$RESULT^VPSMRAR0(DATA,99,"Medication Entry # is required")
Q:RESULT'="" RESULT
;
; -- Medication ID and Name must exist
N REQEXIST S REQEXIST=$D(REQFLDS("MED ID",MEDID))&$D(REQFLDS("MEDICATION NAME",MEDID))
I 'REQEXIST S RESULT=$$RESULT^VPSMRAR0(DATA,99,"Med ID and Medication Name are required")
Q RESULT
;
CHKALM(REQFLDS,DATA) ;Check required Med Changed/confirmed/discrepancy fields
; INPUTS
; 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=""
; -- Allergy Entry # is required field
N MEDID S MEDID=$P($P(DATA,U,2),",",2)
I 'MEDID S RESULT=$$RESULT^VPSMRAR0(DATA,99,"Medication Entry # is required")
Q:RESULT'="" RESULT
;
N MEDCHGID S MEDCHGID=$P($P(DATA,U,2),",",3)
I 'MEDCHGID S RESULT=$$RESULT^VPSMRAR0(DATA,99,"Medication Changed/Confirmed/Discrepancy is required")
Q:RESULT'="" RESULT
;
I '$D(^VPS(853.7,MEDCHGID)) S RESULT=$$RESULT^VPSMRAR0(DATA,99,"Invalid Medication Changed/Confirmed/Discrepancy")
Q RESULT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVPSMRAR4 5408 printed Oct 16, 2024@18:43:44 Page 2
VPSMRAR4 ;DALOI/KML,WOIFO/BT - 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 ;
SUB54(PTIEN,DTIEN,FLD,DIEFLAG,DATA,REQFLDS) ; file the MEDICATIONS multiple (853.54)
+1 ; INPUTS
+2 ; PTIEN : Patient DFN for 853.5 entry
+3 ; DTIEN : transaction date/time ien for 853.51 sub-entry
+4 ; FLD : Field # where the data will be filed
+5 ; DIEFLAG : Filing Type (I = Internal, E = External)
+6 ; DATA : composite string assigned to a subscript in the local array passed in by Vecna for the specific field
+7 ; REQFLDS : Array of required fields by fieldname and entry number
+8 ;
+9 ; OUTPUT
+10 ; success : RESULT = Field Name^IENS^Field Value^1
+11 ; failed : RESULT = Field Name^IENS^Field Value^99^error text describing why data did not get filed
+12 ;
+13 NEW RESULT
SET RESULT=""
+14 ;
+15 SET RESULT=$$CHKMED(.REQFLDS,DATA)
+16 if RESULT'=""
QUIT RESULT
+17 ;
+18 ; -- Add Medication sub entry if it doesn't exist
+19 ;MEDICATIONS Entry #
NEW MEDID
SET MEDID=$PIECE($PIECE(DATA,U,2),",",2)
+20 ; MEDS sub-entry does not exist yet so create stub entry
IF '$DATA(^VPS(853.5,PTIEN,"MRAR",DTIEN,"MEDS","B",MEDID))
Begin DoDot:1
+21 NEW ADDOK
SET ADDOK=$$ADDMRAR^VPSMRAR0(853.54,DTIEN_","_PTIEN,MEDID,DIEFLAG)
+22 IF 'ADDOK
SET RESULT=$$RESULT^VPSMRAR0(DATA,99,"Data was not filed into MRAR PDO. Failed to add Medications entry")
End DoDot:1
+23 if RESULT'=""
QUIT RESULT
+24 ;
+25 ; -- Get Medication IEN
+26 NEW MEDIEN
SET MEDIEN=$ORDER(^VPS(853.5,PTIEN,"MRAR",DTIEN,"MEDS","B",MEDID,""))
+27 if MEDIEN=""
QUIT $$RESULT^VPSMRAR0(DATA,99,"Data was not filed into MRAR PDO")
+28 ;
+29 ; -- Store 853.54 field entries
+30 NEW WP
SET WP=FLD=23!(FLD=24)!(FLD=25)
+31 NEW IENS
SET IENS=MEDIEN_","_DTIEN_","_PTIEN_","
+32 SET RESULT=$$FILE^VPSMRAR0(853.54,WP,IENS,FLD,DIEFLAG,DATA)
+33 ;
+34 QUIT RESULT
+35 ;
SUB54X(SUBFIL,SUBS,PTIEN,DTIEN,DATA,REQFLDS,DIEFLAG) ; file the MED CHANGED/CONFIRMED/DISCREPANCY INDICATORS
+1 ; INPUTS
+2 ; SUBFIL : Sub File# : 853.5454, 853.5455, or 853.5452
+3 ; SUBS : Subscript associated with the Sub File : MCHG, MCNFR, MDISCR
+4 ; PTIEN : D0 - Patient DFN for 853.5 entry1
+5 ; DTIEN : D1 - transaction date/time ien for 853.51 sub-entry
+6 ; DATA : Field Name^IENS^Field Value
+7 ; REQFLDS : Array of required fields by fieldname and entry number
+8 ; DIEFLAG : Filing Type (I = Internal, E = External)
+9 ;
+10 ; OUTPUT
+11 ; success : RESULT = Field Name^IENS^Field Value^1
+12 ; failed : RESULT = Field Name^IENS^Field Value^99^error text describing why data did not get filed
+13 ;
+14 NEW RESULT
SET RESULT=""
+15 ;
+16 ; -- Check required Medication fields
+17 SET RESULT=$$CHKALM(.REQFLDS,DATA)
+18 if RESULT'=""
QUIT RESULT
+19 ;
+20 ; -- Add Medication changed/confirmed/discrepancy sub entry if it doesn't exist
+21 NEW MEDID
SET MEDID=$PIECE($PIECE(DATA,U,2),",",2)
+22 NEW MIEN
SET MIEN=$ORDER(^VPS(853.5,PTIEN,"MRAR",DTIEN,"MEDS","B",MEDID,0))
+23 IF 'MIEN
SET RESULT=$$RESULT^VPSMRAR0(DATA,99,"Corrupted Medication entry")
+24 if RESULT'=""
QUIT RESULT
+25 ;
+26 NEW MEDCHGID
SET MEDCHGID=$PIECE($PIECE(DATA,U,2),",",3)
+27 ;I $P(DATA,U,3)'=MEDCHGID S RESULT=$$RESULT^VPSMRAR0(DATA,99,"Value does not match third index")
+28 ;Q:RESULT'="" RESULT
+29 NEW EXIST
SET EXIST=$DATA(^VPS(853.5,PTIEN,"MRAR",DTIEN,"MEDS",MIEN,SUBS,"B",MEDCHGID))
+30 IF EXIST
SET RESULT=$$RESULT^VPSMRAR0(DATA,99,"Duplicate Medication Changed/Confirmed/Discrepancy entry")
+31 if RESULT'=""
QUIT RESULT
+32 ;
+33 NEW OK
SET OK=$$ADDMRAR^VPSMRAR0(SUBFIL,MIEN_","_DTIEN_","_PTIEN,MEDCHGID,"")
+34 IF 'OK
SET RESULT=$$RESULT^VPSMRAR0(DATA,99,"Unable to file Medication Changed/Confirmed/Discrepancy entry")
+35 ; data for specific field was filed successfully into PDO record
IF OK
SET RESULT=$$RESULT^VPSMRAR0(DATA,1,"")
+36 ;
+37 QUIT RESULT
+38 ;
CHKMED(REQFLDS,DATA) ;Check required Medication fields
+1 ; INPUTS
+2 ; REQFLDS : Array of required fields by fieldname and entry number
+3 ; DATA : Field Name^IENS^Field Value
+4 ;
+5 ; OUTPUT
+6 ; success : RESULT = Field Name^IENS^Field Value^1
+7 ; failed : RESULT = Field Name^IENS^Field Value^99^error text describing why data did not get filed
+8 ;
+9 NEW RESULT
SET RESULT=""
+10 ; -- Medication Entry # is required field
+11 ;MEDICATIONS Entry #
NEW MEDID
SET MEDID=$PIECE($PIECE(DATA,U,2),",",2)
+12 IF 'MEDID
SET RESULT=$$RESULT^VPSMRAR0(DATA,99,"Medication Entry # is required")
+13 if RESULT'=""
QUIT RESULT
+14 ;
+15 ; -- Medication ID and Name must exist
+16 NEW REQEXIST
SET REQEXIST=$DATA(REQFLDS("MED ID",MEDID))&$DATA(REQFLDS("MEDICATION NAME",MEDID))
+17 IF 'REQEXIST
SET RESULT=$$RESULT^VPSMRAR0(DATA,99,"Med ID and Medication Name are required")
+18 QUIT RESULT
+19 ;
CHKALM(REQFLDS,DATA) ;Check required Med Changed/confirmed/discrepancy fields
+1 ; INPUTS
+2 ; REQFLDS : Array of required fields by fieldname and entry number
+3 ; DATA : Field Name^IENS^Field Value
+4 ;
+5 ; OUTPUT
+6 ; success : RESULT = Field Name^IENS^Field Value^1
+7 ; failed : RESULT = Field Name^IENS^Field Value^99^error text describing why data did not get filed
+8 ;
+9 NEW RESULT
SET RESULT=""
+10 ; -- Allergy Entry # is required field
+11 NEW MEDID
SET MEDID=$PIECE($PIECE(DATA,U,2),",",2)
+12 IF 'MEDID
SET RESULT=$$RESULT^VPSMRAR0(DATA,99,"Medication Entry # is required")
+13 if RESULT'=""
QUIT RESULT
+14 ;
+15 NEW MEDCHGID
SET MEDCHGID=$PIECE($PIECE(DATA,U,2),",",3)
+16 IF 'MEDCHGID
SET RESULT=$$RESULT^VPSMRAR0(DATA,99,"Medication Changed/Confirmed/Discrepancy is required")
+17 if RESULT'=""
QUIT RESULT
+18 ;
+19 IF '$DATA(^VPS(853.7,MEDCHGID))
SET RESULT=$$RESULT^VPSMRAR0(DATA,99,"Invalid Medication Changed/Confirmed/Discrepancy")
+20 QUIT RESULT
