- 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 Feb 19, 2025@00:09:31 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