VPSMR52.m

VPSMR52 ;WOIFO/BT - Get the last MRAR data for a patient (Allergy 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.

 ;

 ; 

ALLERGY(VPSMRAR,DFN,LASTMRAR) ; -- retrieve Allergy 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,ALRNO,FLD,SUBS

 N FIL S FIL=853.52

 N ALRIEN S ALRIEN=0

 ;

 F  S ALRIEN=$O(^VPS(853.5,DFN,"MRAR",LASTMRAR,"ALLERGY",ALRIEN)) Q:'ALRIEN  D

 . S SUBS=ALRIEN_","_LASTMRAR_","_DFN_","

 . K REC D GETS^DIQ(FIL,SUBS,"*","IE","REC")

 . S ALRNO=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 FIL=853.52,FLD=.02 S EXVAL=$$GET1^DIQ(120.8,INVAL_",",.02,"E")

 . . I ATTR("TYPE")="WORD-PROCESSING" S EXVAL=$$WP^VPSMRAR9(.REC,FIL,SUBS,FLD),INVAL=""

 . . D ADD^VPSMRAR9(.VPSMRAR,ATTR("LABEL"),","_ALRNO,INVAL,EXVAL)

 . ;

 . D ALLIND(.VPSMRAR,VPSDFN,LASTMRAR,ALRIEN,ALRNO)

 . D ALREACT(.VPSMRAR,VPSDFN,LASTMRAR,ALRIEN,ALRNO)

 ;

 QUIT

 ;

ALLIND(VPSMRAR,DFN,LASTMRAR,ALRIEN,ALRNO) ; -- retrieve Allergy Indicator level fields and store them in VPSMRAR

 ; INPUT

 ;   DFN      : Patient IEN

 ;   LASTMRAR : The last MRAR Transaction IEN for the patient

 ;   ALRIEN   : Allergy IEN

 ;   ALRNO    : Allergy Entry #

 ; OUTPUT

 ;   VPSMRAR  : local array contains all field names/values for the last mrar

 ;

 N REC,INVAL,EXVAL,ATTR,SUBS

 N FIL S FIL("ACHG")=853.525,FIL("ACNFR")=853.526,FIL("ADISCR")=853.527

 N FLD S FLD=".01"

 ;

 F IND="ACHG","ACNFR","ADISCR" 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,"ALLERGY",ALRIEN,IND,INDIEN)) Q:'INDIEN  D

 . . S SUBS=INDIEN_","_ALRIEN_","_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"),","_ALRNO_","_INVAL,INVAL,EXVAL)

 ;

 QUIT

 ;

ALREACT(VPSMRAR,VPSDFN,LASTMRAR,ALRIEN,ALRNO) ; -- retrieve Allergy Reaction level fields and store them in VPSMRAR

 ; INPUT

 ;   DFN      : Patient IEN

 ;   LASTMRAR : The last MRAR Transaction IEN for the patient

 ;   ALRIEN   : Allergy IEN

 ; OUTPUT

 ;   VPSMRAR  : local array contains all field names/values for the last mrar

 ;

 N REC,INVAL,EXVAL,ATTR,FLD,SUBS,REACTNO

 N FIL S FIL=853.57

 N REACTIEN S REACTIEN=0

 ;

 F  S REACTIEN=$O(^VPS(853.5,DFN,"MRAR",LASTMRAR,"ALLERGY",ALRIEN,"REACTIONS",REACTIEN)) Q:'REACTIEN  D

 . S SUBS=REACTIEN_","_ALRIEN_","_LASTMRAR_","_DFN_","

 . K REC D GETS^DIQ(FIL,SUBS,"*","IE","REC")

 . S REACTNO=REC(FIL,SUBS,".01","I")

 . S FLD=0

 . 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"),","_ALRNO_","_REACTNO,INVAL,EXVAL)

 ;

 QUIT

 ;

ADDALLER(VPSMRAR,DFN,LASTMRAR) ; -- retrieve Additional Allergy 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,ALRNO,FLD,SUBS

 N FIL S FIL=853.53

 N ALRIEN S ALRIEN=0

 ;

 F  S ALRIEN=$O(^VPS(853.5,DFN,"MRAR",LASTMRAR,"ALLERGYADD",ALRIEN)) Q:'ALRIEN  D

 . S SUBS=ALRIEN_","_LASTMRAR_","_DFN_","

 . K REC D GETS^DIQ(FIL,SUBS,"*","IE","REC")

 . S ALRNO=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"),","_ALRNO,INVAL,EXVAL)

 ;

 QUIT

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---VPSMR52   4326     printed  Feb 19, 2025@00:09:30                                                                                                                                                                                                     Page 2

VPSMR52   ;WOIFO/BT - Get the last MRAR data for a patient (Allergy 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       ; 

ALLERGY(VPSMRAR,DFN,LASTMRAR) ; -- retrieve Allergy 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,ALRNO,FLD,SUBS

 +8        NEW FIL

           SET FIL=853.52

 +9        NEW ALRIEN

           SET ALRIEN=0

 +10      ;

 +11       FOR 

               SET ALRIEN=$ORDER(^VPS(853.5,DFN,"MRAR",LASTMRAR,"ALLERGY",ALRIEN))

               if 'ALRIEN

                   QUIT 

               Begin DoDot:1

 +12               SET SUBS=ALRIEN_","_LASTMRAR_","_DFN_","

 +13               KILL REC

                   DO GETS^DIQ(FIL,SUBS,"*","IE","REC")

 +14               SET ALRNO=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 FIL=853.52

                               IF FLD=.02

                                   SET EXVAL=$$GET1^DIQ(120.8,INVAL_",",.02,"E")

 +21                       IF ATTR("TYPE")="WORD-PROCESSING"

                               SET EXVAL=$$WP^VPSMRAR9(.REC,FIL,SUBS,FLD)

                               SET INVAL=""

 +22                       DO ADD^VPSMRAR9(.VPSMRAR,ATTR("LABEL"),","_ALRNO,INVAL,EXVAL)

                       End DoDot:2

 +23      ;

 +24               DO ALLIND(.VPSMRAR,VPSDFN,LASTMRAR,ALRIEN,ALRNO)

 +25               DO ALREACT(.VPSMRAR,VPSDFN,LASTMRAR,ALRIEN,ALRNO)

               End DoDot:1

 +26      ;

 +27       QUIT 

 +28      ;

ALLIND(VPSMRAR,DFN,LASTMRAR,ALRIEN,ALRNO) ; -- retrieve Allergy 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       ;   ALRIEN   : Allergy IEN

 +5       ;   ALRNO    : Allergy 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("ACHG")=853.525

           SET FIL("ACNFR")=853.526

           SET FIL("ADISCR")=853.527

 +11       NEW FLD

           SET FLD=".01"

 +12      ;

 +13       FOR IND="ACHG","ACNFR","ADISCR"

               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,"ALLERGY",ALRIEN,IND,INDIEN))

                       if 'INDIEN

                           QUIT 

                       Begin DoDot:2

 +17                       SET SUBS=INDIEN_","_ALRIEN_","_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"),","_ALRNO_","_INVAL,INVAL,EXVAL)

                       End DoDot:2

               End DoDot:1

 +22      ;

 +23       QUIT 

 +24      ;

ALREACT(VPSMRAR,VPSDFN,LASTMRAR,ALRIEN,ALRNO) ; -- retrieve Allergy Reaction level fields and store them in VPSMRAR

 +1       ; INPUT

 +2       ;   DFN      : Patient IEN

 +3       ;   LASTMRAR : The last MRAR Transaction IEN for the patient

 +4       ;   ALRIEN   : Allergy IEN

 +5       ; OUTPUT

 +6       ;   VPSMRAR  : local array contains all field names/values for the last mrar

 +7       ;

 +8        NEW REC,INVAL,EXVAL,ATTR,FLD,SUBS,REACTNO

 +9        NEW FIL

           SET FIL=853.57

 +10       NEW REACTIEN

           SET REACTIEN=0

 +11      ;

 +12       FOR 

               SET REACTIEN=$ORDER(^VPS(853.5,DFN,"MRAR",LASTMRAR,"ALLERGY",ALRIEN,"REACTIONS",REACTIEN))

               if 'REACTIEN

                   QUIT 

               Begin DoDot:1

 +13               SET SUBS=REACTIEN_","_ALRIEN_","_LASTMRAR_","_DFN_","

 +14               KILL REC

                   DO GETS^DIQ(FIL,SUBS,"*","IE","REC")

 +15               SET REACTNO=REC(FIL,SUBS,".01","I")

 +16               SET FLD=0

 +17               FOR 

                       SET FLD=$ORDER(REC(FIL,SUBS,FLD))

                       if 'FLD

                           QUIT 

                       Begin DoDot:2

 +18                       KILL ATTR

                           DO FIELD^DID(FIL,FLD,"","LABEL;TYPE","ATTR")

 +19                       SET INVAL=REC(FIL,SUBS,FLD,"I")

 +20                       SET EXVAL=REC(FIL,SUBS,FLD,"E")

 +21                       IF ATTR("TYPE")="WORD-PROCESSING"

                               SET EXVAL=$$WP^VPSMRAR9(.REC,FIL,SUBS,FLD)

                               SET INVAL=""

 +22                       DO ADD^VPSMRAR9(.VPSMRAR,ATTR("LABEL"),","_ALRNO_","_REACTNO,INVAL,EXVAL)

                       End DoDot:2

               End DoDot:1

 +23      ;

 +24       QUIT 

 +25      ;

ADDALLER(VPSMRAR,DFN,LASTMRAR) ; -- retrieve Additional Allergy 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,ALRNO,FLD,SUBS

 +8        NEW FIL

           SET FIL=853.53

 +9        NEW ALRIEN

           SET ALRIEN=0

 +10      ;

 +11       FOR 

               SET ALRIEN=$ORDER(^VPS(853.5,DFN,"MRAR",LASTMRAR,"ALLERGYADD",ALRIEN))

               if 'ALRIEN

                   QUIT 

               Begin DoDot:1

 +12               SET SUBS=ALRIEN_","_LASTMRAR_","_DFN_","

 +13               KILL REC

                   DO GETS^DIQ(FIL,SUBS,"*","IE","REC")

 +14               SET ALRNO=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"),","_ALRNO,INVAL,EXVAL)

                       End DoDot:2

               End DoDot:1

 +22      ;

 +23       QUIT