AUPNMBI.m

AUPNMBI ; IHS/OIT/FBD&NKD - MBI APIS ; 10/25/2017 ;

 ;;99.1;IHS DICTIONARIES (PATIENT);**26,27**;MAR 9, 1999;Build 2

 ;

 Q  ;NO TOP-LEVEL CALL ALLOWED

 ;

ADDMBI(PATIEN,EFFDATE,MBI,SOURCE) ;PEP - ADD MBI VALUE FOR A PATIENT

 ; Function: Add an MBI for a patient on the specified effective date

 ; Call: $$ADDMBI^AUPNMBI(PATIEN,EFFDATE,MBI,SOURCE)

 ; Returned value:

 ;  Successful: EFF_DATE(? - as IEN in MBI multiple)

 ;  Unsuccessful: 0 (zero)

 ;

 N FDA,SF,IENS,RES,ERR

 S MBI=$$UP^XLFSTR($G(MBI))  ;TRANSLATE ALL ALPHAS TO UPPERCASE

 S SF=9000001.44,IENS="+1,"_$G(PATIEN)_","  ; SET MBI SUBFILE AND IENS STRING (LOOKUP/ADD)

 S:$D(^AUPNPAT($G(PATIEN),44,$G(EFFDATE))) IENS="?"_IENS

 S FDA(SF,IENS,.01)=$G(EFFDATE)  ; EFFECTIVE DATE (#.01)

 S FDA(SF,IENS,1)=$G(MBI)        ; MBI (#1)

 S FDA(SF,IENS,2)=$G(SOURCE)     ; SOURCE (#2)

 S FDA(SF,IENS,3)=$$DT^XLFDT     ; DATE ENTERED (#3)

 S FDA(SF,IENS,4)=$G(DUZ)        ; ENTERED BY (#4)

 S RES(1)=$G(EFFDATE)            ; ENTRY DINUM'ED BY DATE

 D UPDATE^DIE(,"FDA","RES","ERR")

 Q $S($D(ERR):"0^"_$G(ERR("DIERR","1","TEXT",1)),1:+$G(RES(1)))  ; ERROR: 0^MESSAGE, SUCCESS: IEN (DATE)

 ;

 ;

GETMBI(PATIEN,SVCDATE,FORMAT) ;PEP - GET MBI VALUE FOR A PATIENT

 ;Function: Retrieve an MBI for a patient on the specified date of service

 ; Call: $$GETMBI^AUPNMBI(PAT_IEN,DATE,FMT)

 ; FORMAT:

 ;  0/default: MBI value only return requested

 ;  1:         All fields, internal value return requested

 ;  2:         All fields, external value return requested

 ; Returned value:

 ;  Successful (Dependent upon FORMAT specification):

 ;   0/default: MBI

 ;   1:         MBI^EFF_DATE^SOURCE

 ;   2:         MBI^EFF_DATE_ext^SOURCE_ext

 ;  Unsuccessful: 0 (zero)

 ;

 N IEN,RES

 S (IEN,RES)=0,PATIEN=+$G(PATIEN),SVCDATE=+$G(SVCDATE),FORMAT=$G(FORMAT,0) Q:'PATIEN!'SVCDATE RES

 S IEN=$O(^AUPNPAT(PATIEN,44,SVCDATE+.000001),-1) Q:'IEN RES

 S RES=$P($G(^AUPNPAT(PATIEN,44,IEN,0)),U,2)

 I FORMAT S RES=RES_U_$$GET1^DIQ(9000001.44,IEN_","_PATIEN,.01,$S(FORMAT>1:"",1:"I"))_U_$$GET1^DIQ(9000001.44,IEN_","_PATIEN,2,$S(FORMAT>1:"",1:"I"))

 Q RES

 ;

DELMBI(PATIEN,EFFDATE,MBI) ;DELETE MBI VALUE FOR A PATIENT

 ; Function: Delete an MBI entry for a patient on the specified effective date

 ; Call: $$DELMBI^AUPNMBI(PATIEN,EFFDATE,MBI)

 ; Returned value:

 ;  Successful: 1

 ;  Unsuccessful: 0 (zero)

 ;  -  Error message (if any) concatenated to status response

 ;  -  Format: 0^error_message

 ;

 N PAT,DATE,DIK,DA,ERR  ;INITIALIZATION

 S PAT=$G(PATIEN),DATE=$G(EFFDATE),MBI=$G(MBI)

 I +PAT D  ;

 . I $D(^AUPNPAT(PAT)) D  ;

 . . I +DATE D  ;

 . . . I $D(^AUPNPAT(PAT,44,DATE)) D  ;

 . . . . I $P(^AUPNPAT(PAT,44,DATE,0),U,2)=MBI D  ;

 . . . . . S DA(1)=PAT,DA=DATE,DIK="^AUPNPAT("_DA(1)_",44,"

 . . . . . D ^DIK

 . . . . E  S ERR="0^MBI not found for specified date" I 1

 . . . E  S ERR="0^Effective date not found" I 1

 . . E  S ERR="0^Invalid effective date" I 1

 . E  S ERR="0^Invalid patient reference" I 1

 E  S ERR="0^Invalid pointer value" I 1

 Q:$D(ERR) ERR

 Q 1

 ;

HISTMBI(PATIEN,TARGET,FORMAT) ;PEP - GET MBI VALUE HISTORY FOR A PATIENT

 ;Function: Retrieve the entire MBI history for a patient, sorted by effective date

 ; Call: $$HISTMBI^AUPNMBI(PAT_IEN,.TARGET_ARRAY,FORMAT)

 ; FORMAT:

 ;  1/default: Effective_Date and Source returned in FileMan-internal format

 ;  2:         Effective_Date and Source returned in external format

 ; Returned value:

 ;  Successful: 1

 ;  -  MBI history returned as individual nodes in specified target array

 ;  -  Node format (dependent upon FORMAT specification):

 ;  -    1/default: MBI^Effective_Date^Source

 ;  -    2:         MBI^Effective_Date_ext^Source_ext

 ;  Unsuccessful: 0 (zero)

 ;  -  Error message (if any) concatenated to status response

 ;  -  Format: 0^error_message

 ;

 N ERR,MBI,PAT,TARCNT K TARGET  ;INITIALIZATION

 ;S PAT=+$G(PATIEN) ;AUPN*99.1*27 - ORIGINAL LINE - COMMENTED OUT

 S PAT=+$G(PATIEN),FORMAT=$G(FORMAT,1),TARCNT=0  ;IHS/OIT/NKD - AUPN*99.1*27 - INCLUDED OUTPUT FORMAT PARAMETER

 I +PAT D  ;

 . I $D(^AUPNPAT(PAT,0)) D  ;

 . . S MBI=0

 . . I +$O(^AUPNPAT(PAT,44,MBI)) D  ;

 . . . ;F  S MBI=$O(^AUPNPAT(PATIEN,44,MBI)) Q:'+MBI  S TARGET(MBI)=$$GETMBI(PAT,MBI,1) ;AUPN*99.1*27 - ORIGINAL LINE - COMMENTED OUT

 . . . F  S MBI=$O(^AUPNPAT(PATIEN,44,MBI)) Q:'+MBI  S TARGET(MBI)=$$GETMBI(PAT,MBI,FORMAT),TARCNT=TARCNT+1  ;IHS/OIT/NKD - AUPN*99.1*27 - INCLUDED OUTPUT FORMAT PARAMETER

 . . E  S ERR="0^No MBI history on file for patient" I 1

 . E  S ERR="0^Invalid patient reference" I 1

 E  S ERR="0^Invalid pointer value" I 1

 Q:$D(ERR) ERR

 Q TARCNT

 ;

FORMOK(MBI) ;PEP - VALIDATE MBI VALUE FORMAT

 ;Function: Validate MBI format compliance

 ;Call: $$FORMOK^AUPNMBI(MBI)

 ;Returned value:

 ;  Successful: MBI

 ;   Submitted MBI value returned if verified as being in valid MBI format

 ;  Unsuccessful: 0(zero)^error_message

 ;

 ;Acceptable MBI Format is:

 ;                            1 1

 ;Position: 1 2 3 4 5 6 7 8 9 0 1

 ;          ---------------------

 ;    Type: C A X N A X N A A N N

 ;

 ;Types are:

 ;  A = Alphabetic characters A-Z

 ;  C = Natural numbers 1-9

 ;  N = Whole numbers 0-9

 ;  X = Alphanumeric characters 0-9 and A-Z

 ;Letters excluded from use in alphabetics and alphanumerics: S, L, O, B, I, Z

 ;

 N CHAR,EXCLUDE,FLAG,MBILEN,POS,RETURN,XFORM

 S MBILEN=11  ;VALID LENGTH OF MBI STRING

 S EXCLUDE="SLOBIZ"  ;CMS-DEFINED LIST OF CHARACTERS EXCLUDED FROM ACCEPTABILITY

 S XFORM="ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"  ;ACCEPTABLE 'X'(ALPHANUMERIC) CHARACTERS

 ;

 S RETURN=0

 S MBI=$$UP^XLFSTR($G(MBI))  ;TRANSLATE ALL ALPHAS TO UPPERCASE

 I $L(MBI)=MBILEN D  ;ACCEPTABLE LENGTH CHECK

 . I MBI?1N1A1E1N1A1E1N2A2N,XFORM[$E(MBI,3),XFORM[$E(MBI,6) D  ;OVERALL FORMAT CHECK

 . . I +$E(MBI) D  ;FIRST DIGIT CHECK - MUST BE NON-ZERO (1-9)

 . . . S FLAG=0

 . . . F POS=1:1:MBILEN D  ;CHECK MBI STRING FOR EXCLUDED CHARACTERS

 . . . . S CHAR=$E(MBI,POS)       ;EACH CHARACTER INDIVIDUALLY EXTRACTED...

 . . . . I EXCLUDE[CHAR S FLAG=1  ;...AND FLAGGED IF PART OF THE EXCLUDED CHARACTER SET

 . . . I FLAG S RETURN="0^contains one or more excluded characters "_EXCLUDE Q  ;EXIT PROCESSING STREAM IF ANY EXCLUDED CHARACTERS FOUND

 . . . ;

 . . . S RETURN=MBI  ;ALL CHECKS PASSED, USER-SUBMITTED MBI VALUE RETURNED AS VALID

 . . E  S RETURN="0^positive integer required for first character"

 . E  S RETURN="0^incorrect format"

 E  S RETURN="0^incorrect length - must be "_MBILEN_" characters"

 ;

 Q RETURN

AUPNMBI   ; IHS/OIT/FBD&NKD - MBI APIS ; 10/25/2017 ;

 +1       ;;99.1;IHS DICTIONARIES (PATIENT);**26,27**;MAR 9, 1999;Build 2

 +2       ;

 +3       ;NO TOP-LEVEL CALL ALLOWED

           QUIT 

 +4       ;

ADDMBI(PATIEN,EFFDATE,MBI,SOURCE) ;PEP - ADD MBI VALUE FOR A PATIENT

 +1       ; Function: Add an MBI for a patient on the specified effective date

 +2       ; Call: $$ADDMBI^AUPNMBI(PATIEN,EFFDATE,MBI,SOURCE)

 +3       ; Returned value:

 +4       ;  Successful: EFF_DATE(? - as IEN in MBI multiple)

 +5       ;  Unsuccessful: 0 (zero)

 +6       ;

 +7        NEW FDA,SF,IENS,RES,ERR

 +8       ;TRANSLATE ALL ALPHAS TO UPPERCASE

           SET MBI=$$UP^XLFSTR($GET(MBI))

 +9       ; SET MBI SUBFILE AND IENS STRING (LOOKUP/ADD)

           SET SF=9000001.44

           SET IENS="+1,"_$GET(PATIEN)_","

 +10       IF $DATA(^AUPNPAT($GET(PATIEN),44,$GET(EFFDATE)))

               SET IENS="?"_IENS

 +11      ; EFFECTIVE DATE (#.01)

           SET FDA(SF,IENS,.01)=$GET(EFFDATE)

 +12      ; MBI (#1)

           SET FDA(SF,IENS,1)=$GET(MBI)

 +13      ; SOURCE (#2)

           SET FDA(SF,IENS,2)=$GET(SOURCE)

 +14      ; DATE ENTERED (#3)

           SET FDA(SF,IENS,3)=$$DT^XLFDT

 +15      ; ENTERED BY (#4)

           SET FDA(SF,IENS,4)=$GET(DUZ)

 +16      ; ENTRY DINUM'ED BY DATE

           SET RES(1)=$GET(EFFDATE)

 +17       DO UPDATE^DIE(,"FDA","RES","ERR")

 +18      ; ERROR: 0^MESSAGE, SUCCESS: IEN (DATE)

           QUIT $SELECT($DATA(ERR):"0^"_$GET(ERR("DIERR","1","TEXT",1)),1:+$GET(RES(1)))

 +19      ;

 +20      ;

GETMBI(PATIEN,SVCDATE,FORMAT) ;PEP - GET MBI VALUE FOR A PATIENT

 +1       ;Function: Retrieve an MBI for a patient on the specified date of service

 +2       ; Call: $$GETMBI^AUPNMBI(PAT_IEN,DATE,FMT)

 +3       ; FORMAT:

 +4       ;  0/default: MBI value only return requested

 +5       ;  1:         All fields, internal value return requested

 +6       ;  2:         All fields, external value return requested

 +7       ; Returned value:

 +8       ;  Successful (Dependent upon FORMAT specification):

 +9       ;   0/default: MBI

 +10      ;   1:         MBI^EFF_DATE^SOURCE

 +11      ;   2:         MBI^EFF_DATE_ext^SOURCE_ext

 +12      ;  Unsuccessful: 0 (zero)

 +13      ;

 +14       NEW IEN,RES

 +15       SET (IEN,RES)=0

           SET PATIEN=+$GET(PATIEN)

           SET SVCDATE=+$GET(SVCDATE)

           SET FORMAT=$GET(FORMAT,0)

           IF 'PATIEN!'SVCDATE

               QUIT RES

 +16       SET IEN=$ORDER(^AUPNPAT(PATIEN,44,SVCDATE+.000001),-1)

           IF 'IEN

               QUIT RES

 +17       SET RES=$PIECE($GET(^AUPNPAT(PATIEN,44,IEN,0)),U,2)

 +18       IF FORMAT

               SET RES=RES_U_$$GET1^DIQ(9000001.44,IEN_","_PATIEN,.01,$SELECT(FORMAT>1:"",1:"I"))_U_$$GET1^DIQ(9000001.44,IEN_","_PATIEN,2,$SELECT(FORMAT>1:"",1:"I"))

 +19       QUIT RES

 +20      ;

DELMBI(PATIEN,EFFDATE,MBI) ;DELETE MBI VALUE FOR A PATIENT

 +1       ; Function: Delete an MBI entry for a patient on the specified effective date

 +2       ; Call: $$DELMBI^AUPNMBI(PATIEN,EFFDATE,MBI)

 +3       ; Returned value:

 +4       ;  Successful: 1

 +5       ;  Unsuccessful: 0 (zero)

 +6       ;  -  Error message (if any) concatenated to status response

 +7       ;  -  Format: 0^error_message

 +8       ;

 +9       ;INITIALIZATION

           NEW PAT,DATE,DIK,DA,ERR

 +10       SET PAT=$GET(PATIEN)

           SET DATE=$GET(EFFDATE)

           SET MBI=$GET(MBI)

 +11      ;

           IF +PAT

               Begin DoDot:1

 +12      ;

                   IF $DATA(^AUPNPAT(PAT))

                       Begin DoDot:2

 +13      ;

                           IF +DATE

                               Begin DoDot:3

 +14      ;

                                   IF $DATA(^AUPNPAT(PAT,44,DATE))

                                       Begin DoDot:4

 +15      ;

                                           IF $PIECE(^AUPNPAT(PAT,44,DATE,0),U,2)=MBI

                                               Begin DoDot:5

 +16                                               SET DA(1)=PAT

                                                   SET DA=DATE

                                                   SET DIK="^AUPNPAT("_DA(1)_",44,"

 +17                                               DO ^DIK

                                               End DoDot:5

 +18                                      IF '$TEST

                                               SET ERR="0^MBI not found for specified date"

                                               IF 1

                                       End DoDot:4

 +19                              IF '$TEST

                                       SET ERR="0^Effective date not found"

                                       IF 1

                               End DoDot:3

 +20                      IF '$TEST

                               SET ERR="0^Invalid effective date"

                               IF 1

                       End DoDot:2

 +21              IF '$TEST

                       SET ERR="0^Invalid patient reference"

                       IF 1

               End DoDot:1

 +22      IF '$TEST

               SET ERR="0^Invalid pointer value"

               IF 1

 +23       IF $DATA(ERR)

               QUIT ERR

 +24       QUIT 1

 +25      ;

HISTMBI(PATIEN,TARGET,FORMAT) ;PEP - GET MBI VALUE HISTORY FOR A PATIENT

 +1       ;Function: Retrieve the entire MBI history for a patient, sorted by effective date

 +2       ; Call: $$HISTMBI^AUPNMBI(PAT_IEN,.TARGET_ARRAY,FORMAT)

 +3       ; FORMAT:

 +4       ;  1/default: Effective_Date and Source returned in FileMan-internal format

 +5       ;  2:         Effective_Date and Source returned in external format

 +6       ; Returned value:

 +7       ;  Successful: 1

 +8       ;  -  MBI history returned as individual nodes in specified target array

 +9       ;  -  Node format (dependent upon FORMAT specification):

 +10      ;  -    1/default: MBI^Effective_Date^Source

 +11      ;  -    2:         MBI^Effective_Date_ext^Source_ext

 +12      ;  Unsuccessful: 0 (zero)

 +13      ;  -  Error message (if any) concatenated to status response

 +14      ;  -  Format: 0^error_message

 +15      ;

 +16      ;INITIALIZATION

           NEW ERR,MBI,PAT,TARCNT

           KILL TARGET

 +17      ;S PAT=+$G(PATIEN) ;AUPN*99.1*27 - ORIGINAL LINE - COMMENTED OUT

 +18      ;IHS/OIT/NKD - AUPN*99.1*27 - INCLUDED OUTPUT FORMAT PARAMETER

           SET PAT=+$GET(PATIEN)

           SET FORMAT=$GET(FORMAT,1)

           SET TARCNT=0

 +19      ;

           IF +PAT

               Begin DoDot:1

 +20      ;

                   IF $DATA(^AUPNPAT(PAT,0))

                       Begin DoDot:2

 +21                       SET MBI=0

 +22      ;

                           IF +$ORDER(^AUPNPAT(PAT,44,MBI))

                               Begin DoDot:3

 +23      ;F  S MBI=$O(^AUPNPAT(PATIEN,44,MBI)) Q:'+MBI  S TARGET(MBI)=$$GETMBI(PAT,MBI,1) ;AUPN*99.1*27 - ORIGINAL LINE - COMMENTED OUT

 +24      ;IHS/OIT/NKD - AUPN*99.1*27 - INCLUDED OUTPUT FORMAT PARAMETER

                                   FOR 

                                       SET MBI=$ORDER(^AUPNPAT(PATIEN,44,MBI))

                                       IF '+MBI

                                           QUIT 

                                       SET TARGET(MBI)=$$GETMBI(PAT,MBI,FORMAT)

                                       SET TARCNT=TARCNT+1

                               End DoDot:3

 +25                      IF '$TEST

                               SET ERR="0^No MBI history on file for patient"

                               IF 1

                       End DoDot:2

 +26              IF '$TEST

                       SET ERR="0^Invalid patient reference"

                       IF 1

               End DoDot:1

 +27      IF '$TEST

               SET ERR="0^Invalid pointer value"

               IF 1

 +28       IF $DATA(ERR)

               QUIT ERR

 +29       QUIT TARCNT

 +30      ;

FORMOK(MBI) ;PEP - VALIDATE MBI VALUE FORMAT

 +1       ;Function: Validate MBI format compliance

 +2       ;Call: $$FORMOK^AUPNMBI(MBI)

 +3       ;Returned value:

 +4       ;  Successful: MBI

 +5       ;   Submitted MBI value returned if verified as being in valid MBI format

 +6       ;  Unsuccessful: 0(zero)^error_message

 +7       ;

 +8       ;Acceptable MBI Format is:

 +9       ;                            1 1

 +10      ;Position: 1 2 3 4 5 6 7 8 9 0 1

 +11      ;          ---------------------

 +12      ;    Type: C A X N A X N A A N N

 +13      ;

 +14      ;Types are:

 +15      ;  A = Alphabetic characters A-Z

 +16      ;  C = Natural numbers 1-9

 +17      ;  N = Whole numbers 0-9

 +18      ;  X = Alphanumeric characters 0-9 and A-Z

 +19      ;Letters excluded from use in alphabetics and alphanumerics: S, L, O, B, I, Z

 +20      ;

 +21       NEW CHAR,EXCLUDE,FLAG,MBILEN,POS,RETURN,XFORM

 +22      ;VALID LENGTH OF MBI STRING

           SET MBILEN=11

 +23      ;CMS-DEFINED LIST OF CHARACTERS EXCLUDED FROM ACCEPTABILITY

           SET EXCLUDE="SLOBIZ"

 +24      ;ACCEPTABLE 'X'(ALPHANUMERIC) CHARACTERS

           SET XFORM="ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"

 +25      ;

 +26       SET RETURN=0

 +27      ;TRANSLATE ALL ALPHAS TO UPPERCASE

           SET MBI=$$UP^XLFSTR($GET(MBI))

 +28      ;ACCEPTABLE LENGTH CHECK

           IF $LENGTH(MBI)=MBILEN

               Begin DoDot:1

 +29      ;OVERALL FORMAT CHECK

                   IF MBI?1N1A1E1N1A1E1N2A2N

                       IF XFORM[$EXTRACT(MBI,3)

                           IF XFORM[$EXTRACT(MBI,6)

                               Begin DoDot:2

 +30      ;FIRST DIGIT CHECK - MUST BE NON-ZERO (1-9)

                                   IF +$EXTRACT(MBI)

                                       Begin DoDot:3

 +31                                       SET FLAG=0

 +32      ;CHECK MBI STRING FOR EXCLUDED CHARACTERS

                                           FOR POS=1:1:MBILEN

                                               Begin DoDot:4

 +33      ;EACH CHARACTER INDIVIDUALLY EXTRACTED...

                                                   SET CHAR=$EXTRACT(MBI,POS)

 +34      ;...AND FLAGGED IF PART OF THE EXCLUDED CHARACTER SET

                                                   IF EXCLUDE[CHAR

                                                       SET FLAG=1

                                               End DoDot:4

 +35      ;EXIT PROCESSING STREAM IF ANY EXCLUDED CHARACTERS FOUND

                                           IF FLAG

                                               SET RETURN="0^contains one or more excluded characters "_EXCLUDE

                                               QUIT 

 +36      ;

 +37      ;ALL CHECKS PASSED, USER-SUBMITTED MBI VALUE RETURNED AS VALID

                                           SET RETURN=MBI

                                       End DoDot:3

 +38                              IF '$TEST

                                       SET RETURN="0^positive integer required for first character"

                               End DoDot:2

 +39              IF '$TEST

                       SET RETURN="0^incorrect format"

               End DoDot:1

 +40      IF '$TEST

               SET RETURN="0^incorrect length - must be "_MBILEN_" characters"

 +41      ;

 +42       QUIT RETURN