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
