VPSMRAR2.m

VPSMRAR2  ;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

 ;

SUB52(PTIEN,DTIEN,FLD,DIEFLAG,DATA,REQFLDS) ; file the ALLERGY multiple (853.52)

 ; INPUTS 

 ;   PTIEN   : D0 - Patient DFN for 853.5 entry1

 ;   DTIEN   : D1 - 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 Allergy fields

 S RESULT=$$CHKALR(.REQFLDS,DATA)

 Q:RESULT'="" RESULT

 ;

 ; -- Add Allergy sub entry if it doesn't exist

 ;N ALLERID S ALLERID=$P(DATA,U,3) ;Allergy Entry #

 N ALLERID S ALLERID=$P($P(DATA,U,2),",",2) ;Allergy Entry #

 I '$D(^VPS(853.5,PTIEN,"MRAR",DTIEN,"ALLERGY","B",ALLERID)) D

 . N ADDOK S ADDOK=$$ADDMRAR^VPSMRAR0(853.52,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 IEN

 N ALLERIEN S ALLERIEN=$O(^VPS(853.5,PTIEN,"MRAR",DTIEN,"ALLERGY","B",ALLERID,""))

 I ALLERIEN="" S RESULT=$$RESULT^VPSMRAR0(DATA,99,"Data was not filed into MRAR PDO")

 Q:RESULT'="" RESULT

 I FLD=.02,$$GET1^DIQ(120.8,$P(DATA,U,3)_",",.01,"I")'=PTIEN S RESULT=$$RESULT^VPSMRAR0(DATA,99,"DFN does not match DFN associated with PATIENT ALLERGIES")

 Q:RESULT'="" RESULT

 ;

 ; -- Store 853.52 field entries

 N WP S WP=FLD="1"!(FLD=2)!(FLD=3)

 N IENS S IENS=ALLERIEN_","_DTIEN_","_PTIEN_","

 S RESULT=$$FILE^VPSMRAR0(853.52,WP,IENS,FLD,DIEFLAG,DATA)

 ;

 Q RESULT

 ;

SUB52X(SUBFIL,SUBS,PTIEN,DTIEN,DATA,REQFLDS,DIEFLAG) ; file the ALLERGY CHANGED INDICATORS (853.525)

 ; INPUTS 

 ;   SUBFIL  : Sub File# : 853.525, 853.526, or 853.527

 ;   SUBS    : Subscript associated with the Sub File : ACHG, ACNFR, ADISCR

 ;   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 Allergy fields

 S RESULT=$$CHKALC(.REQFLDS,DATA)

 Q:RESULT'="" RESULT

 ;

 ; -- Add Allergy changed/confirmed/discrepancy sub entry if it doesn't exist

 N ALLERID S ALLERID=$P($P(DATA,U,2),",",2)

 N AIEN S AIEN=$O(^VPS(853.5,PTIEN,"MRAR",DTIEN,"ALLERGY","B",ALLERID,0))

 I 'AIEN S RESULT=$$RESULT^VPSMRAR0(DATA,99,"Corrupted Allergy entry")

 Q:RESULT'="" RESULT

 ;

 N ALLCHGID S ALLCHGID=$P($P(DATA,U,2),",",3)

 ;I $P(DATA,U,3)'=ALLCHGID 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,"ALLERGY",AIEN,SUBS,"B",ALLCHGID))

 I EXIST S RESULT=$$RESULT^VPSMRAR0(DATA,99,"Duplicate Allergy Changed/Confirmed/Discrepancy entry")

 Q:RESULT'="" RESULT

 ;

 N OK S OK=$$ADDMRAR^VPSMRAR0(SUBFIL,AIEN_","_DTIEN_","_PTIEN,ALLCHGID)

 I 'OK S RESULT=$$RESULT^VPSMRAR0(DATA,99,"Unable to file Allergy Changed/Confirmed/Discrepancy entry")

 I OK S RESULT=$$RESULT^VPSMRAR0(DATA,1,"") ; data for specific field was filed successfully into PDO record

 ;

 Q RESULT

  ;

CHKALR(REQFLDS,DATA) ;Check required Allergy 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 ALLERID S ALLERID=$P($P(DATA,U,2),",",2)

 I 'ALLERID S RESULT=$$RESULT^VPSMRAR0(DATA,99,"Allergy Entry # is required")

 Q:RESULT'="" RESULT

 ;

 ; -- For Local VistA, Local Allergy ID is required

 ; -- For Remote (CDW), Remote Allergy ID and Remote Allergy Name are required

 N ISLOCAL S ISLOCAL=$D(REQFLDS("LOCAL ALLERGY ID",ALLERID))

 N ISREMOTE S ISREMOTE=$D(REQFLDS("REMOTE ALLERGY ID",ALLERID))&$D(REQFLDS("REMOTE ALLERGY NAME",ALLERID))

 I 'ISLOCAL&'ISREMOTE S RESULT=$$RESULT^VPSMRAR0(DATA,99,"Local Allergy ID or Remote Allergy ID and Remote Allergy Name are required")

 Q RESULT

 ;

CHKALC(REQFLDS,DATA) ;Check required Allergy 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 ALLERID S ALLERID=$P($P(DATA,U,2),",",2)

 I 'ALLERID S RESULT=$$RESULT^VPSMRAR0(DATA,99,"Allergy Entry # is required")

 Q:RESULT'="" RESULT

 ;

 N ALLCHGID S ALLCHGID=$P($P(DATA,U,2),",",3)

 I 'ALLCHGID S RESULT=$$RESULT^VPSMRAR0(DATA,99,"Allergy Changed/Confirmed/Discrepancy is required")

 Q:RESULT'="" RESULT

 ;

 I '$D(^VPS(853.3,ALLCHGID)) S RESULT=$$RESULT^VPSMRAR0(DATA,99,"Invalid Allergy Changed/Confirmed/Discrepancy")

 Q RESULT

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---VPSMRAR2   5776     printed  Mar 13, 2025@21:48:09                                                                                                                                                                                                    Page 2

VPSMRAR2  ;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       ;

SUB52(PTIEN,DTIEN,FLD,DIEFLAG,DATA,REQFLDS) ; file the ALLERGY multiple (853.52)

 +1       ; INPUTS 

 +2       ;   PTIEN   : D0 - Patient DFN for 853.5 entry1

 +3       ;   DTIEN   : D1 - 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    : Field Name^IENS^Field Value

 +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      ; -- Check required Allergy fields

 +16       SET RESULT=$$CHKALR(.REQFLDS,DATA)

 +17       if RESULT'=""

               QUIT RESULT

 +18      ;

 +19      ; -- Add Allergy sub entry if it doesn't exist

 +20      ;N ALLERID S ALLERID=$P(DATA,U,3) ;Allergy Entry #

 +21      ;Allergy Entry #

           NEW ALLERID

           SET ALLERID=$PIECE($PIECE(DATA,U,2),",",2)

 +22       IF '$DATA(^VPS(853.5,PTIEN,"MRAR",DTIEN,"ALLERGY","B",ALLERID))

               Begin DoDot:1

 +23               NEW ADDOK

                   SET ADDOK=$$ADDMRAR^VPSMRAR0(853.52,DTIEN_","_PTIEN,ALLERID,DIEFLAG)

 +24               IF 'ADDOK

                       SET RESULT=$$RESULT^VPSMRAR0(DATA,99,"Data was not filed into MRAR PDO. Failed to add Allergy entry")

               End DoDot:1

 +25       if RESULT'=""

               QUIT RESULT

 +26      ;

 +27      ; -- Get Allergy IEN

 +28       NEW ALLERIEN

           SET ALLERIEN=$ORDER(^VPS(853.5,PTIEN,"MRAR",DTIEN,"ALLERGY","B",ALLERID,""))

 +29       IF ALLERIEN=""

               SET RESULT=$$RESULT^VPSMRAR0(DATA,99,"Data was not filed into MRAR PDO")

 +30       if RESULT'=""

               QUIT RESULT

 +31       IF FLD=.02

               IF $$GET1^DIQ(120.8,$PIECE(DATA,U,3)_",",.01,"I")'=PTIEN

                   SET RESULT=$$RESULT^VPSMRAR0(DATA,99,"DFN does not match DFN associated with PATIENT ALLERGIES")

 +32       if RESULT'=""

               QUIT RESULT

 +33      ;

 +34      ; -- Store 853.52 field entries

 +35       NEW WP

           SET WP=FLD="1"!(FLD=2)!(FLD=3)

 +36       NEW IENS

           SET IENS=ALLERIEN_","_DTIEN_","_PTIEN_","

 +37       SET RESULT=$$FILE^VPSMRAR0(853.52,WP,IENS,FLD,DIEFLAG,DATA)

 +38      ;

 +39       QUIT RESULT

 +40      ;

SUB52X(SUBFIL,SUBS,PTIEN,DTIEN,DATA,REQFLDS,DIEFLAG) ; file the ALLERGY CHANGED INDICATORS (853.525)

 +1       ; INPUTS 

 +2       ;   SUBFIL  : Sub File# : 853.525, 853.526, or 853.527

 +3       ;   SUBS    : Subscript associated with the Sub File : ACHG, ACNFR, ADISCR

 +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 Allergy fields

 +17       SET RESULT=$$CHKALC(.REQFLDS,DATA)

 +18       if RESULT'=""

               QUIT RESULT

 +19      ;

 +20      ; -- Add Allergy changed/confirmed/discrepancy sub entry if it doesn't exist

 +21       NEW ALLERID

           SET ALLERID=$PIECE($PIECE(DATA,U,2),",",2)

 +22       NEW AIEN

           SET AIEN=$ORDER(^VPS(853.5,PTIEN,"MRAR",DTIEN,"ALLERGY","B",ALLERID,0))

 +23       IF 'AIEN

               SET RESULT=$$RESULT^VPSMRAR0(DATA,99,"Corrupted Allergy entry")

 +24       if RESULT'=""

               QUIT RESULT

 +25      ;

 +26       NEW ALLCHGID

           SET ALLCHGID=$PIECE($PIECE(DATA,U,2),",",3)

 +27      ;I $P(DATA,U,3)'=ALLCHGID 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,"ALLERGY",AIEN,SUBS,"B",ALLCHGID))

 +30       IF EXIST

               SET RESULT=$$RESULT^VPSMRAR0(DATA,99,"Duplicate Allergy Changed/Confirmed/Discrepancy entry")

 +31       if RESULT'=""

               QUIT RESULT

 +32      ;

 +33       NEW OK

           SET OK=$$ADDMRAR^VPSMRAR0(SUBFIL,AIEN_","_DTIEN_","_PTIEN,ALLCHGID)

 +34       IF 'OK

               SET RESULT=$$RESULT^VPSMRAR0(DATA,99,"Unable to file Allergy 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      ;

CHKALR(REQFLDS,DATA) ;Check required Allergy 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 ALLERID

           SET ALLERID=$PIECE($PIECE(DATA,U,2),",",2)

 +12       IF 'ALLERID

               SET RESULT=$$RESULT^VPSMRAR0(DATA,99,"Allergy Entry # is required")

 +13       if RESULT'=""

               QUIT RESULT

 +14      ;

 +15      ; -- For Local VistA, Local Allergy ID is required

 +16      ; -- For Remote (CDW), Remote Allergy ID and Remote Allergy Name are required

 +17       NEW ISLOCAL

           SET ISLOCAL=$DATA(REQFLDS("LOCAL ALLERGY ID",ALLERID))

 +18       NEW ISREMOTE

           SET ISREMOTE=$DATA(REQFLDS("REMOTE ALLERGY ID",ALLERID))&$DATA(REQFLDS("REMOTE ALLERGY NAME",ALLERID))

 +19       IF 'ISLOCAL&'ISREMOTE

               SET RESULT=$$RESULT^VPSMRAR0(DATA,99,"Local Allergy ID or Remote Allergy ID and Remote Allergy Name are required")

 +20       QUIT RESULT

 +21      ;

CHKALC(REQFLDS,DATA) ;Check required Allergy 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 ALLERID

           SET ALLERID=$PIECE($PIECE(DATA,U,2),",",2)

 +12       IF 'ALLERID

               SET RESULT=$$RESULT^VPSMRAR0(DATA,99,"Allergy Entry # is required")

 +13       if RESULT'=""

               QUIT RESULT

 +14      ;

 +15       NEW ALLCHGID

           SET ALLCHGID=$PIECE($PIECE(DATA,U,2),",",3)

 +16       IF 'ALLCHGID

               SET RESULT=$$RESULT^VPSMRAR0(DATA,99,"Allergy Changed/Confirmed/Discrepancy is required")

 +17       if RESULT'=""

               QUIT RESULT

 +18      ;

 +19       IF '$DATA(^VPS(853.3,ALLCHGID))

               SET RESULT=$$RESULT^VPSMRAR0(DATA,99,"Invalid Allergy Changed/Confirmed/Discrepancy")

 +20       QUIT RESULT