Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AGAPIS

AGAPIS.m

Go to the documentation of this file. 
  1. AGAPIS ;IHS/SD/TPF - PATIENT REGISTRATION ELIGIBLITY API CALL
  1.  ;;7.1;PATIENT REGISTRATION;**2,12**;AUG 25, 2005;Build 1
  1.  ;
  1.  ;IHS/OIT/NKD AG*7.1*12 INSURER TYPE
  1.  ;
  1.  W !,"DO NOT CALL FROM ROOT!"
  1.  Q
  1.  ;
  1.  ;GENERAL LOGIC:
  1.  ;
  1.  ;USING THE "EFF" CROSS REFERENCE IN THE "CATEGORY PRIORITIZING" FILE
  1.  ;#9000035 FIND ALL PRIORITIZED CATEGORIES FOR THE PATIENT DFN (AGGIEN)
  1.  ;WHICH ARE EFFECTIVE (EFFECTIVE DATE OF PRIORITY (#.06) ) AS
  1.  ;OF THE DATE OF SERVICE (AGGDOS).
  1.  ;
  1.  ;NEXT, ELIMINATE ANY ENTRIES IN THE ELIGIBILITY FILE WHICH ARE FOUND TO
  1.  ;BE NON-ACTIVE GIVEN THE DATE OF SERVICE (AGGDOS). THE DATE OF SERVICE
  1.  ;IS COMPARED TO THE 'BEGIN' AND ENDING DATES OF COVERAGE FOUND IN THE
  1.  ;APPROPRIATE ELIGIBLITY FILE.
  1.  ;
  1.  ;IF THE ELIGIBILITY ENTRY IS FOUND TO BE ACTIVE THEN THE CATEGORY AND
  1.  ;ELIGIBILITY DATA IS ADDED TO THE RETURNED ARRAY
  1.  ;OR STRING IF AGGBMX=1.
  1.  ;
  1.  ;THE RETURNED ARRAY HAS THE FOLLOWING BASIC STRUCTURE:
  1.  ; 
  1.  ;     AGGXY(CATEGORY,PRIORITY,INSURER POINTER,File #, fda iens,
  1.  ;                      Field#/Field Name, [Internal/External])=DATA
  1.  ; 
  1.  ;THE SUBSCRIPT STRUCTURE BEYOND THE INSURER POINTER (THIRD SUBSCRIPT) IS
  1.  ;IN THE FORM OF A STANDARD FDA ARRAY RETURNED BY THE FIELMAN DBS API
  1.  ;$$GETS^DIQ() Data Retriever AND IS DEPENDENT UPON THE FLAGS PASSED VIA
  1.  ;PARAMETER AGGFLAG. SEE "VA FILEMAN V. 22.0 PROGRAMMER MANUAL"
  1.  ;PAGE 2-186 FOR DETAILS ON WHAT THE FLAGS MEAN. KEEP IN MIND THE
  1.  ;RETURNED ARRAY'S STRUCTURE CHANGES DEPENDING ON THE FLAGS BEING PASSED.
  1.  ;NOTE: THE 'INSURER POINTER' SUBSCRIPT FOR THE GUARANTOR WILL BE THE
  1.  ;GLOBAL RFERENCE TO THE ACTUAL GUARANTOR
  1.  ;  E.G.
  1.  ;  AGGXY("T",1,"AUPNPAT(5571,0)","9000003.1","97,",".01","E")="GEGNUN,DELORES M"
  1.  ;
  1.  ;IN THE CASE ABOVE, THE GUARANTOR IS THE PATIENT. THE GUARANTOR
  1.  ;AS OF THIS PATCH CAN BE A PATIENT, AN INSURER OR AN EMPLOYER
  1.  ;
  1.  ;IF AGGBMX=1 THEN THE BMXNet STRING IS RETURNED. IT'S FORMAT IS THE
  1.  ;SAME AS THE BMXNet STRUCTURE FOR STATIC TABLES. SEE PAGES 8-9 OF THE
  1.  ;"BMXNet ADO.NET Data Access and Connectivity Utilities for RPMS User
  1.  ;Manual" FOR A DESCRIPTION OF THIS STRUCTURE.
  1.  ;
  1.  ;PARAMETERS:
  1.  ;AGGXY   = RETURNED DATA ARRAY OR STRING
  1.  ;AGGIEN  = PATIENT'S DFN. if null error message returned
  1.  ;AGGDOS  = DATE OF SERVICE
  1.  ;          If null, AGGDOS=DT
  1.  ;   
  1.  ;AGGFLAG = STANDARD FLAGS FOR GETS^DIQ  CALL
  1.  ;           "I" = INTERNAL
  1.  ;           "E" = EXTERNAL VALUES (DEFAULT)
  1.  ;           "N" = DON'T RETURN NULL VALUES
  1.  ;           "R" = RESOLVE FILE NUMBERS TO NAMES
  1.  ;   
  1.  ;           if null the default is "E"
  1.  ;   
  1.  ;AGGCAT  = A ^ DELIMITED STRING CONTAINING THE CATEGORIES REQUESTED
  1.  ;          'M' FOR MEDICAL;
  1.  ;          'D' FOR DENTAL;
  1.  ;          'O' FOR OPTOMETRY;
  1.  ;          'R' FOR PHARMACY;
  1.  ;          'P' FOR MENTAL HEALTH;
  1.  ;          'A' FOR AUTO ACCIDENT/TORT;    This is the same
  1.  ;                                         as third party liability
  1.  ;          'W' FOR WORKMAN'S COMP;
  1.  ;  
  1.  ;          E.G.  ^M^A^W^
  1.  ;  
  1.  ;          WILL RETURN MEDICAL,AUTO ACCIDENT AND WORKMEN'S COM
  1.  ;          CATEGORIES.
  1.  ;          if null the default is ALL CATEGORIES
  1.  ;  
  1.  ;AGGBMX  = IF 1 THEN DATA IS RETURNED IN BMXNET FORMAT
  1.  ;          IF 0 THEN DATA IS RETURNED IN ARRAY FORMAT DESCRIBED ABOVE
  1.  ;          if null the default is 0
  1.  ;  
  1.  ;IF NO EFFECTIVE SEQUENCE CATEGORIES ARE FOUND:
  1.  ;  1) THE BMXNET CALLER WIL RECEIVE THE COLUMN SCHEMA WITH NO RECORDS
  1.  ;     E.G. AGGXY="T00004CATEGORY^N000030PRIORITY^N000030INSURER^
  1.  ;              N000030FILE_NUMBER^F000030FDA_IENS^F000050FIELD^
  1.  ;              F000080DATA^"
  1.  ;  
  1.  ;  2) AGGXY WILL BE UNDEFINED FOR A NON BMXNET CALLER
  1.  ;     D GETELIG^AGAPIS(.LJF,10416,DT,"ER","",0)   
  1. GETELIG(AGGXY,AGGIEN,AGGDOS,AGGFLAG,AGGCAT,AGGBMX) ;PEP - API ENTRY FOR ACTIVE INSURANCE COVERAGE
  1.  N PATIEN,RECORD,FLD,AGGDATA,AGGRET,AGGRETMP,CATPRIOR
  1.  I '$D(^AUPNPAT(AGGIEN))!'$D(^DPT(AGGIEN)) S AGGXY="T00040ERROR"_$C(30)_"Patient not in either PATIENT or VA PATIENT file"_$C(30)_$C(31) Q
  1.  I $G(AGGCAT)'="" D
  1.  .I $E(AGGCAT)'=U S AGGCAT=U_AGGCAT
  1.  .I $E(AGGCAT,$L(AGGCAT))'=U S AGGCAT=AGGCAT_U
  1.  I $G(AGGIEN)="",$G(AGGBMX) S AGGXY="T00040ERROR"_$C(30)_"No patient IEN"_$C(30)_$C(31) Q
  1.  I $G(AGGIEN)="" K AGGXY Q
  1.  S:$G(AGGBMX)="" AGGBMX=0
  1.  S:$G(AGGDOS)="" AGGDOS=DT
  1.  S:$G(AGGCAT)'="" AGGCAT=$$UPPER(AGGCAT)
  1.  S:AGGFLAG'="" AGGFLAG=$$UPPER(AGGFLAG)
  1.  S:$G(AGGCAT)="" AGGCAT=$$GETCODES()
  1.  S:$G(AGGFLAG)="" AGGFLAG="E"
  1.  S AGGRETMP=""
  1.  ;GO THROUGH THE CATEGORIES AND GRAB ONLY THOSE SELECTED IN AGGCAT
  1.  S CAT=""
  1.  F  S CAT=$O(^AUPNICP("EFF",AGGIEN,CAT)) Q:CAT=""  D
  1.  .Q:AGGCAT'[(U_CAT_U)
  1.  .S EFFDT=$O(^AUPNICP("EFF",AGGIEN,CAT,AGGDOS+.01),-1)
  1.  .Q:EFFDT=""
  1.  .S RECORD=""
  1.  .F  S RECORD=$O(^AUPNICP("EFF",AGGIEN,CAT,EFFDT,RECORD)) Q:RECORD=""  D
  1.  ..K AGGDATA,AGGERR
  1.  ..;GET DATA FROM 'CATEGORY PRIORITIZING' FILE
  1.  ..D GETS^DIQ(9000035,RECORD,"*","I","AGGDATA","AGGERR")
  1.  ..I $D(AGGERR) Q
  1.  ..M AGGRETMP=AGGDATA
  1.  ;GO GET INSURANCE ELIGIBILITY
  1.  K CATPRIOR
  1.  D GETINS(.AGGRETMP,.CATPRIOR)
  1.  D DELOBSOL(.CATPRIOR)   ;DELETE OBSOLETE FIELDS MARKED WITH '*' IN NAME
  1.  ;HERE WE SHOULD HAVE A LIST OF ALL ACTIVE SEQ. ELIGIBILITIES SORTED IN CATPRIOR
  1.  I 'AGGBMX M AGGXY=CATPRIOR D CLEAN Q
  1.  ;OTHERWISE SEND BACK A BMX RECORD SET
  1.  D BMXHDR(.HDR)
  1.  D BMXSET(.CATPRIOR,.AGGXY)
  1.  S AGGXY=HDR_$C(30)_AGGXY_$C(30)
  1.  D CLEAN
  1.  Q
  1.  ;GET ELIGIBLITY INFO AND SORT BY CATEGORY,PRIORITY AND INSURER
  1. GETINS(AGGELIG,CATPRIOR) ;
  1.  S RECORD=""
  1.  ;SORT THE CATEGORIZED ENTRIES BY CATEGORY AND PRIORITY
  1.  F  S RECORD=$O(AGGELIG(9000035,RECORD)) Q:RECORD=""  D
  1.  .S RECPTR=$G(AGGELIG(9000035,RECORD,".15","I"))
  1.  .S INSPTR=$G(AGGELIG(9000035,RECORD,".03","I"))
  1.  .S PRIORITY=$G(AGGELIG(9000035,RECORD,".05","I"))
  1.  .S CATEGORY=$G(AGGELIG(9000035,RECORD,.04,"I"))
  1.  .S COVTYPE=$G(AGGELIG(9000035,RECORD,.07,"I"))
  1.  .S CATPRIOR(CATEGORY,PRIORITY,INSPTR)=RECPTR_"|"_COVTYPE
  1.  ;
  1.  ;NOW GET THE ELIGIBILITY DATA
  1.  S CATEGORY=""
  1.  F  S CATEGORY=$O(CATPRIOR(CATEGORY)) Q:CATEGORY=""  D
  1.  .S PRIORITY=""
  1.  .F  S PRIORITY=$O(CATPRIOR(CATEGORY,PRIORITY)) Q:PRIORITY=""  D
  1.  ..S INSPTR=""
  1.  ..S INSPTR=$O(CATPRIOR(CATEGORY,PRIORITY,INSPTR)) Q:INSPTR=""  D
  1.  ...K AGGERR,AGGDATA
  1.  ...;GET INSURER TYPE FROM INSURER FILE
  1.  ...I $P(CATPRIOR(CATEGORY,PRIORITY,INSPTR),"|",2)="G" D
  1.  ....S INSTYPE="GUARANTOR"
  1.  ...;E  S INSTYPE=$$GET1^DIQ(9999999.18,INSPTR,.21,"E","AGGINS","AGGERR")
  1.  ...E  S INSTYPE=$$INSTYP^AGUTL(INSPTR,1)  ;IHS/OIT/NKD AG*7.1*12
  1.  ...S RECPTR=$P(CATPRIOR(CATEGORY,PRIORITY,INSPTR),"|")
  1.  ...S COVTYPE=$P(CATPRIOR(CATEGORY,PRIORITY,INSPTR),"|",2)
  1.  ...I INSPTR=1,(COVTYPE'="D") D GETRRAB^AGAPIS1(.CATPRIOR) Q  ;RAILROAD RETIRMENT A & B
  1.  ...I INSPTR=2,(COVTYPE'="D") D GETMCRAB^AGAPIS1(.CATPRIOR) Q  ;MEDICARE A & B
  1.  ...I INSPTR=3 D GETMCD^AGAPIS1(.CATPRIOR) Q  ;MEDICAID
  1.  ...I INSPTR=1,(COVTYPE="D") D GETRRD^AGAPIS1(.CATPRIOR) Q  ;RAILROAD RETIREMENT PART D
  1.  ...I INSPTR=2,(COVTYPE="D") D GETMCRD^AGAPIS1(.CATPRIOR) Q  ;MEDICARE PART D
  1.  ...I INSTYPE="MCR PART D",(COVTYPE="D") D GETMCRD^AGAPIS1(.CATPRIOR) Q  ;MEDICARE PART D
  1.  ...I INSTYPE="GUARANTOR" D GETGUAR^AGAPIS1(.CATPRIOR) Q
  1.  ...I INSTYPE="THIRD PARTY LIABILITY" D GETTPL^AGAPIS1(.CATPRIOR) Q
  1.  ...I INSTYPE="WORKMEN'S COMP." D WCOMP^AGAPIS1(.CATPRIOR) Q
  1.  ...;ALL OTHERS SHOULD BE PRIVATE INSURANCE
  1.  ...D GETPRVT^AGAPIS1(.CATPRIOR)
  1.  ...K AGGDATA,AGGERR
  1.  Q
  1. CLEAN ;
  1.  K AGCODES,AGGRET,AGGDATA,AGGFLAG,AGGFILE,FIELDTYP,AGGHDR,AGGZERO
  1.  K RECORD,AGCODES,AGGRETMP,AGCDSTR,CAT,CATEGORY,COVTYPE,EFFDT,INSPTR,INSTYPE,POLHPTR
  1.  K PRIORITY,RECPTR,TPRECPTR,SBRECPTR,FILENO,DATA,FIELDS,FDAIENS,AGGINS,AGGPOLH
  1.  K X,Y,HDR,AGGFIELD
  1.  Q
  1.  ;CREATE BMXNET COLUMN HEADER FOR BMX RECORD SET
  1. BMXHDR(HDR) ;
  1.  S HDR="T00004CATEGORY"_U
  1.  S HDR=HDR_"N000030PRIORITY"_U
  1.  S HDR=HDR_"N000030INSURER"_U
  1.  S HDR=HDR_"N000030FILE_NUMBER"_U
  1.  S HDR=HDR_"F000030FDA_IENS"_U
  1.  S HDR=HDR_"F000050FIELD"_U
  1.  S HDR=HDR_"F000080DATA"
  1.  Q HDR
  1.  ;CREATE BMXNET RECORD SET TO SEND BACK TO CLIENT
  1. BMXSET(CATPRIOR,AGGXY) ;
  1.  N AGGRET
  1.  S AGGRET=""
  1.  S CATEGORY=""
  1.  F  S CATEGORY=$O(CATPRIOR(CATEGORY)) Q:CATEGORY=""  D
  1.  .S PRIORITY=""
  1.  .F  S PRIORITY=$O(CATPRIOR(CATEGORY,PRIORITY)) Q:PRIORITY=""  D
  1.  ..S INSPTR=""
  1.  ..F  S INSPTR=$O(CATPRIOR(CATEGORY,PRIORITY,INSPTR)) Q:INSPTR=""  D
  1.  ...S FILENO=""
  1.  ...F  S FILENO=$O(CATPRIOR(CATEGORY,PRIORITY,INSPTR,FILENO)) Q:FILENO=""  D
  1.  ....S FDAIENS=""
  1.  ....F  S FDAIENS=$O(CATPRIOR(CATEGORY,PRIORITY,INSPTR,FILENO,FDAIENS)) Q:FDAIENS=""  D
  1.  .....S FIELD=""
  1.  .....F  S FIELD=$O(CATPRIOR(CATEGORY,PRIORITY,INSPTR,FILENO,FDAIENS,FIELD)) Q:FIELD=""  D
  1.  ......S DATA=$G(CATPRIOR(CATEGORY,PRIORITY,INSPTR,FILENO,FDAIENS,FIELD))
  1.  ......S:DATA="" DATA=$G(CATPRIOR(CATEGORY,PRIORITY,INSPTR,FILENO,FDAIENS,FIELD,"I"))
  1.  ......S:DATA="" DATA=$G(CATPRIOR(CATEGORY,PRIORITY,INSPTR,FILENO,FDAIENS,FIELD,"E"))
  1.  ......S AGGRET=AGGRET_CATEGORY_U_PRIORITY_U_INSPTR_U_FILENO_U_FDAIENS_U_FIELD_U_DATA_$C(30)
  1.  ......;W !,AGGRET
  1.  M AGGXY=AGGRET
  1.  Q
  1. GETCODES() ;
  1.  S AGZERO=$G(^DD(9000035,.04,0)),AGCDSTR=$P(AGZERO,U,3)
  1.  S AGCODES=U
  1.  F PIECE=1:1 Q:$P($P(AGCDSTR,";",PIECE),":")=""  S AGCODES=AGCODES_$S($P($P(AGCDSTR,";",PIECE),":")="A":"T",1:$P($P(AGCDSTR,";",PIECE),":"))_U
  1.  K AGZERO,PIECE
  1.  Q AGCODES
  1. UPPER(STR) ;EP - CHANGE LOWER TO UPPER
  1.  Q $TR(STR,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  1. TYPE(TYPE) ;SET FIELDTYPE TO T(TEXT),N(UMERIC),I(NTEGER) OR D(ATE)
  1.  Q:TYPE["D" "D"
  1.  Q:TYPE["N" "N"
  1.  Q:TYPE["P" "I"
  1.  Q "F"
  1. SPECIAL(STR) ;CHANGE SPECIAL CHARS TO NULL
  1.  Q $TR(STR,"'""!@#$%^&*():;<>?/\|,.`~[]{}-+=","")
  1.  ;DELETE OBSOLETE FIELDS
  1. DELOBSOL(CATPRIOR) ;
  1.  S CATEGORY=""
  1.  F  S CATEGORY=$O(CATPRIOR(CATEGORY)) Q:CATEGORY=""  D
  1.  .S PRIORITY=""
  1.  .F  S PRIORITY=$O(CATPRIOR(CATEGORY,PRIORITY)) Q:PRIORITY=""  D
  1.  ..S INSPTR=""
  1.  ..F  S INSPTR=$O(CATPRIOR(CATEGORY,PRIORITY,INSPTR)) Q:INSPTR=""  D
  1.  ...S FILENO=""
  1.  ...F  S FILENO=$O(CATPRIOR(CATEGORY,PRIORITY,INSPTR,FILENO)) Q:FILENO=""  D
  1.  ....S FDAIENS=""
  1.  ....F  S FDAIENS=$O(CATPRIOR(CATEGORY,PRIORITY,INSPTR,FILENO,FDAIENS)) Q:FDAIENS=""  D
  1.  .....S FIELD=""
  1.  .....F  S FIELD=$O(CATPRIOR(CATEGORY,PRIORITY,INSPTR,FILENO,FDAIENS,FIELD)) Q:FIELD=""  D
  1.  ......D FIELD^DID(FILENO,FIELD,"","LABEL","AGGFIELD","AGGERR")
  1.  ......I AGGFIELD("LABEL")["*" K CATPRIOR(CATEGORY,PRIORITY,INSPTR,FILENO,FDAIENS,FIELD)
  1.  Q