VPSMR54 ;WOIFO/BT - Get the last MRAR data for a patient (Medication Level) ;01/29/15 15:30
;;1.0;VA POINT OF SERVICE (KIOSKS);**3**;Jan 29, 2015;Build 64
;;Per VHA Directive 2004-038, this routine should not be modified.
;
;
MEDS(VPSMRAR,DFN,LASTMRAR) ; -- retrieve Medication level fields and store them in VPSMRAR
; INPUT
; DFN : Patient IEN
; LASTMRAR : The last MRAR Transaction IEN for the patient
; OUTPUT
; VPSMRAR: local array contains all field names/values for the last mrar
;
N REC,INVAL,EXVAL,MEDNO,FLD,SUBS
N FIL S FIL=853.54
N MEDIEN S MEDIEN=0
;
F S MEDIEN=$O(^VPS(853.5,DFN,"MRAR",LASTMRAR,"MEDS",MEDIEN)) Q:'MEDIEN D
. S SUBS=MEDIEN_","_LASTMRAR_","_DFN_","
. K REC D GETS^DIQ(FIL,SUBS,"*","IE","REC")
. S MEDNO=REC(FIL,SUBS,.01,"I")
. S FLD=""
. F S FLD=$O(REC(FIL,SUBS,FLD)) Q:'FLD D
. . K ATTR D FIELD^DID(FIL,FLD,"","LABEL;TYPE","ATTR")
. . S INVAL=REC(FIL,SUBS,FLD,"I")
. . S EXVAL=REC(FIL,SUBS,FLD,"E")
. . I ATTR("TYPE")="WORD-PROCESSING" S EXVAL=$$WP^VPSMRAR9(.REC,FIL,SUBS,FLD),INVAL=""
. . D ADD^VPSMRAR9(.VPSMRAR,ATTR("LABEL"),","_MEDNO,INVAL,EXVAL)
. ;
. D MEDIND(.VPSMRAR,DFN,LASTMRAR,MEDIEN,MEDNO)
;
QUIT
;
MEDIND(VPSMRAR,DFN,LASTMRAR,MEDIEN,MEDNO) ; -- retrieve Medication Indicator level fields and store them in VPSMRAR
; INPUT
; DFN : Patient IEN
; LASTMRAR : The last MRAR Transaction IEN for the patient
; MEDIEN : Medication IEN
; MEDNO : Medication Entry #
; OUTPUT
; VPSMRAR : local array contains all field names/values for the last mrar
;
N REC,INVAL,EXVAL,ATTR,SUBS
N FIL S FIL("MCHG")=853.5454,FIL("MCNFR")=853.5455,FIL("MDISCR")=853.5452
N FLD S FLD=".01"
;
F IND="MCHG","MCNFR","MDISCR" D
. K ATTR D FIELD^DID(FIL(IND),FLD,"","LABEL;TYPE","ATTR")
. N INDIEN S INDIEN=0
. F S INDIEN=$O(^VPS(853.5,DFN,"MRAR",LASTMRAR,"MEDS",MEDIEN,IND,INDIEN)) Q:'INDIEN D
. . S SUBS=INDIEN_","_MEDIEN_","_LASTMRAR_","_DFN_","
. . K REC D GETS^DIQ(FIL(IND),SUBS,"*","IE","REC")
. . S INVAL=REC(FIL(IND),SUBS,FLD,"I")
. . S EXVAL=REC(FIL(IND),SUBS,FLD,"E")
. . D ADD^VPSMRAR9(.VPSMRAR,ATTR("LABEL"),","_MEDNO_","_INVAL,INVAL,EXVAL)
;
QUIT
;
ADDMEDS(VPSMRAR,DFN,LASTMRAR) ; -- retrieve Additional Medication level fields and store them in VPSMRAR
; INPUT
; DFN : Patient IEN
; LASTMRAR : The last MRAR Transaction IEN for the patient
; OUTPUT
; VPSMRAR: local array contains all field names/values for the last mrar
;
N REC,INVAL,EXVAL,MEDNO,FLD,SUBS
N FIL S FIL=853.55
N MEDIEN S MEDIEN=0
;
F S MEDIEN=$O(^VPS(853.5,DFN,"MRAR",LASTMRAR,"MEDSADD",MEDIEN)) Q:'MEDIEN D
. S SUBS=MEDIEN_","_LASTMRAR_","_DFN_","
. K REC D GETS^DIQ(FIL,SUBS,"*","IE","REC")
. S MEDNO=REC(FIL,SUBS,.01,"I")
. S FLD=""
. F S FLD=$O(REC(FIL,SUBS,FLD)) Q:'FLD D
. . K ATTR D FIELD^DID(FIL,FLD,"","LABEL;TYPE","ATTR")
. . S INVAL=REC(FIL,SUBS,FLD,"I")
. . S EXVAL=REC(FIL,SUBS,FLD,"E")
. . I ATTR("TYPE")="WORD-PROCESSING" S EXVAL=$$WP^VPSMRAR9(.REC,FIL,SUBS,FLD),INVAL=""
. . D ADD^VPSMRAR9(.VPSMRAR,ATTR("LABEL"),","_MEDNO,INVAL,EXVAL)
;
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVPSMR54 3158 printed Dec 13, 2024@02:43:04 Page 2
VPSMR54 ;WOIFO/BT - Get the last MRAR data for a patient (Medication Level) ;01/29/15 15:30
+1 ;;1.0;VA POINT OF SERVICE (KIOSKS);**3**;Jan 29, 2015;Build 64
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ;
MEDS(VPSMRAR,DFN,LASTMRAR) ; -- retrieve Medication level fields and store them in VPSMRAR
+1 ; INPUT
+2 ; DFN : Patient IEN
+3 ; LASTMRAR : The last MRAR Transaction IEN for the patient
+4 ; OUTPUT
+5 ; VPSMRAR: local array contains all field names/values for the last mrar
+6 ;
+7 NEW REC,INVAL,EXVAL,MEDNO,FLD,SUBS
+8 NEW FIL
SET FIL=853.54
+9 NEW MEDIEN
SET MEDIEN=0
+10 ;
+11 FOR
SET MEDIEN=$ORDER(^VPS(853.5,DFN,"MRAR",LASTMRAR,"MEDS",MEDIEN))
if 'MEDIEN
QUIT
Begin DoDot:1
+12 SET SUBS=MEDIEN_","_LASTMRAR_","_DFN_","
+13 KILL REC
DO GETS^DIQ(FIL,SUBS,"*","IE","REC")
+14 SET MEDNO=REC(FIL,SUBS,.01,"I")
+15 SET FLD=""
+16 FOR
SET FLD=$ORDER(REC(FIL,SUBS,FLD))
if 'FLD
QUIT
Begin DoDot:2
+17 KILL ATTR
DO FIELD^DID(FIL,FLD,"","LABEL;TYPE","ATTR")
+18 SET INVAL=REC(FIL,SUBS,FLD,"I")
+19 SET EXVAL=REC(FIL,SUBS,FLD,"E")
+20 IF ATTR("TYPE")="WORD-PROCESSING"
SET EXVAL=$$WP^VPSMRAR9(.REC,FIL,SUBS,FLD)
SET INVAL=""
+21 DO ADD^VPSMRAR9(.VPSMRAR,ATTR("LABEL"),","_MEDNO,INVAL,EXVAL)
End DoDot:2
+22 ;
+23 DO MEDIND(.VPSMRAR,DFN,LASTMRAR,MEDIEN,MEDNO)
End DoDot:1
+24 ;
+25 QUIT
+26 ;
MEDIND(VPSMRAR,DFN,LASTMRAR,MEDIEN,MEDNO) ; -- retrieve Medication Indicator level fields and store them in VPSMRAR
+1 ; INPUT
+2 ; DFN : Patient IEN
+3 ; LASTMRAR : The last MRAR Transaction IEN for the patient
+4 ; MEDIEN : Medication IEN
+5 ; MEDNO : Medication Entry #
+6 ; OUTPUT
+7 ; VPSMRAR : local array contains all field names/values for the last mrar
+8 ;
+9 NEW REC,INVAL,EXVAL,ATTR,SUBS
+10 NEW FIL
SET FIL("MCHG")=853.5454
SET FIL("MCNFR")=853.5455
SET FIL("MDISCR")=853.5452
+11 NEW FLD
SET FLD=".01"
+12 ;
+13 FOR IND="MCHG","MCNFR","MDISCR"
Begin DoDot:1
+14 KILL ATTR
DO FIELD^DID(FIL(IND),FLD,"","LABEL;TYPE","ATTR")
+15 NEW INDIEN
SET INDIEN=0
+16 FOR
SET INDIEN=$ORDER(^VPS(853.5,DFN,"MRAR",LASTMRAR,"MEDS",MEDIEN,IND,INDIEN))
if 'INDIEN
QUIT
Begin DoDot:2
+17 SET SUBS=INDIEN_","_MEDIEN_","_LASTMRAR_","_DFN_","
+18 KILL REC
DO GETS^DIQ(FIL(IND),SUBS,"*","IE","REC")
+19 SET INVAL=REC(FIL(IND),SUBS,FLD,"I")
+20 SET EXVAL=REC(FIL(IND),SUBS,FLD,"E")
+21 DO ADD^VPSMRAR9(.VPSMRAR,ATTR("LABEL"),","_MEDNO_","_INVAL,INVAL,EXVAL)
End DoDot:2
End DoDot:1
+22 ;
+23 QUIT
+24 ;
ADDMEDS(VPSMRAR,DFN,LASTMRAR) ; -- retrieve Additional Medication level fields and store them in VPSMRAR
+1 ; INPUT
+2 ; DFN : Patient IEN
+3 ; LASTMRAR : The last MRAR Transaction IEN for the patient
+4 ; OUTPUT
+5 ; VPSMRAR: local array contains all field names/values for the last mrar
+6 ;
+7 NEW REC,INVAL,EXVAL,MEDNO,FLD,SUBS
+8 NEW FIL
SET FIL=853.55
+9 NEW MEDIEN
SET MEDIEN=0
+10 ;
+11 FOR
SET MEDIEN=$ORDER(^VPS(853.5,DFN,"MRAR",LASTMRAR,"MEDSADD",MEDIEN))
if 'MEDIEN
QUIT
Begin DoDot:1
+12 SET SUBS=MEDIEN_","_LASTMRAR_","_DFN_","
+13 KILL REC
DO GETS^DIQ(FIL,SUBS,"*","IE","REC")
+14 SET MEDNO=REC(FIL,SUBS,.01,"I")
+15 SET FLD=""
+16 FOR
SET FLD=$ORDER(REC(FIL,SUBS,FLD))
if 'FLD
QUIT
Begin DoDot:2
+17 KILL ATTR
DO FIELD^DID(FIL,FLD,"","LABEL;TYPE","ATTR")
+18 SET INVAL=REC(FIL,SUBS,FLD,"I")
+19 SET EXVAL=REC(FIL,SUBS,FLD,"E")
+20 IF ATTR("TYPE")="WORD-PROCESSING"
SET EXVAL=$$WP^VPSMRAR9(.REC,FIL,SUBS,FLD)
SET INVAL=""
+21 DO ADD^VPSMRAR9(.VPSMRAR,ATTR("LABEL"),","_MEDNO,INVAL,EXVAL)
End DoDot:2
End DoDot:1
+22 ;
+23 QUIT
