AUPNSEQ ;IHS/SD/EFG - API TO CREATE ARRAY OF SEQUENCED INSURERS ; 10/1/2003 10:00:27 AM
;;99.1;IHS DICTIONARIES (PATIENT);**12**;MAR 09, 1999;Build 9
;
; PASS THE PATIENT IEN, DATE OF SERVICE, AND OPTIONALLY, THE
; CATEGORY TO THIS ROUTINE
; CATEGORIES ARE : 'M' FOR MEDICAL
; 'D' FOR DENTAL
; 'O' FOR OPTOMETRY
; 'R' FOR PHARMACY
; 'P' FOR MENTAL HEALTH
; 'A' FOR AUTO ACCIDENT/TORT
; 'W' FOR WORKMAN'S COMP
;
; IF A CATEGORY IS PASSED TO THIS ROUTINE, THE ARRAY "SEQAR" WILL
; CONTAIN ONLY THE RECORDS FOR THE SPECIFIC CATEGORY.
; IF NO CATEGORY IS PASSED, THE ARRAY WILL CONTAIN THE
; RECORDS EACH CATEGORY FOR THE SPECIFIED DATE OF SERVICE.
;
; THE ARRAY'S FIRST SUBSCRIPT IS JOB#
; MAKE SURE WHEN USING THIS API, YOU KILL THE ARRAY
; USING THE JOB# WHEN YOU'RE DONE
;
; ARRAY LAYOUT :
; INSPTR = INSURER POINTER
; FOR MEDICAID, THIS IS A SCREENED POINTER THAT ONLY
; ALLOWS "MEDICAID". PLANPTR WILL CONTAIN
; THE POINTER TO THE SPECIFIC INSURER
; INSTYPE = INSURER TYPE FROM THE .21 FIELD IN THE INSURER FILE
; COV : FOR MEDICARE AND RAILROAD, THIS WILL BE AN "A" OR "B"
; FOR MEDICAID, THIS IS A FREE TEXT FIELD
; FOR PRIVATE, THIS WILL BE FROM THE COVERAGE POINTER
; FROM THE POLICY HOLDER FILE
; PLANPTR = MEDICAID IS THE ONLY INSURER THAT USES A PLAN NAME FIELD
; WHICH IS A POINTER BACK TO THE INSURER FILE
; BEGDT = ELIGIBILITY BEGINNING DATE
; ENDDT = ELIGIBILITY ENDING DATE
;
START(DFN,DOS,CAT) ; PEP - ENTRY POINT FOR EXTERNAL PACKAGES
K SEQAR($J)
I '$D(CAT) G ALL ; IF NO CAT, SHOW ALL CATEGORIES FOR DOS
S AUPNDOS="" ; ELSE SHOW RECORDS FOR DOS AND SPECIFIC CATEGORY
K HIT
F S AUPNDOS=$O(^AUPNICP("EFF2",DFN,AUPNDOS),-1) Q:'AUPNDOS!$D(HIT) D
. I AUPNDOS>DOS Q
. S AUPNREC=0
. F S AUPNREC=$O(^AUPNICP("EFF2",DFN,AUPNDOS,CAT,AUPNREC)) Q:'AUPNREC D
.. S SEQREC=$G(^AUPNICP(AUPNREC,0))
.. S SEQ=$P(SEQREC,U,5)
.. S INSPTR=$P(SEQREC,U,3)
.. S INSTYPE=$P(^AUTNINS(INSPTR,2),U,1)
.. S COV=$P(SEQREC,U,7)
.. S PLANPTR=$P(SEQREC,U,11)
.. S BEGDT=$P(SEQREC,U,8)
.. S ENDDT=$P(SEQREC,U,9)
.. S HIT=""
.. S SEQAR($J,CAT,SEQ)=INSPTR_"^"_INSTYPE_"^"_COV_"^"_PLANPTR_"^"_BEGDT_"^"_ENDDT
Q
ALL ;
S AUPNDOS=0
F S AUPNDOS=$O(^AUPNICP("EFF2",DFN,AUPNDOS)) Q:'AUPNDOS D
. I AUPNDOS>DOS Q
. S AUPNCAT=""
. F S AUPNCAT=$O(^AUPNICP("EFF2",DFN,AUPNDOS,AUPNCAT)) Q:AUPNCAT="" D
.. S AUPNREC=0
.. F S AUPNREC=$O(^AUPNICP("EFF2",DFN,AUPNDOS,AUPNCAT,AUPNREC)) Q:'AUPNREC D
... S SEQREC=$G(^AUPNICP(AUPNREC,0))
... S SEQ=$P(SEQREC,U,5)
... S INSPTR=$P(SEQREC,U,3)
... S INSTYPE=$P(^AUTNINS(INSPTR,2),U,1)
... S COV=$P(SEQREC,U,7)
... S PLANPTR=$P(SEQREC,U,11)
... S BEGDT=$P(SEQREC,U,8)
... S ENDDT=$P(SEQREC,U,9)
... S SEQAR($J,AUPNCAT,SEQ)=INSPTR_"^"_INSTYPE_"^"_COV_"^"_PLANPTR_"^"_BEGDT_"^"_ENDDT
Q
AUPNSEQ ;IHS/SD/EFG - API TO CREATE ARRAY OF SEQUENCED INSURERS ; 10/1/2003 10:00:27 AM
+1 ;;99.1;IHS DICTIONARIES (PATIENT);**12**;MAR 09, 1999;Build 9
+2 ;
+3 ; PASS THE PATIENT IEN, DATE OF SERVICE, AND OPTIONALLY, THE
+4 ; CATEGORY TO THIS ROUTINE
+5 ; CATEGORIES ARE : 'M' FOR MEDICAL
+6 ; 'D' FOR DENTAL
+7 ; 'O' FOR OPTOMETRY
+8 ; 'R' FOR PHARMACY
+9 ; 'P' FOR MENTAL HEALTH
+10 ; 'A' FOR AUTO ACCIDENT/TORT
+11 ; 'W' FOR WORKMAN'S COMP
+12 ;
+13 ; IF A CATEGORY IS PASSED TO THIS ROUTINE, THE ARRAY "SEQAR" WILL
+14 ; CONTAIN ONLY THE RECORDS FOR THE SPECIFIC CATEGORY.
+15 ; IF NO CATEGORY IS PASSED, THE ARRAY WILL CONTAIN THE
+16 ; RECORDS EACH CATEGORY FOR THE SPECIFIED DATE OF SERVICE.
+17 ;
+18 ; THE ARRAY'S FIRST SUBSCRIPT IS JOB#
+19 ; MAKE SURE WHEN USING THIS API, YOU KILL THE ARRAY
+20 ; USING THE JOB# WHEN YOU'RE DONE
+21 ;
+22 ; ARRAY LAYOUT :
+23 ; INSPTR = INSURER POINTER
+24 ; FOR MEDICAID, THIS IS A SCREENED POINTER THAT ONLY
+25 ; ALLOWS "MEDICAID". PLANPTR WILL CONTAIN
+26 ; THE POINTER TO THE SPECIFIC INSURER
+27 ; INSTYPE = INSURER TYPE FROM THE .21 FIELD IN THE INSURER FILE
+28 ; COV : FOR MEDICARE AND RAILROAD, THIS WILL BE AN "A" OR "B"
+29 ; FOR MEDICAID, THIS IS A FREE TEXT FIELD
+30 ; FOR PRIVATE, THIS WILL BE FROM THE COVERAGE POINTER
+31 ; FROM THE POLICY HOLDER FILE
+32 ; PLANPTR = MEDICAID IS THE ONLY INSURER THAT USES A PLAN NAME FIELD
+33 ; WHICH IS A POINTER BACK TO THE INSURER FILE
+34 ; BEGDT = ELIGIBILITY BEGINNING DATE
+35 ; ENDDT = ELIGIBILITY ENDING DATE
+36 ;
START(DFN,DOS,CAT) ; PEP - ENTRY POINT FOR EXTERNAL PACKAGES
+1 KILL SEQAR($JOB)
+2 ; IF NO CAT, SHOW ALL CATEGORIES FOR DOS
IF '$DATA(CAT)
GOTO ALL
+3 ; ELSE SHOW RECORDS FOR DOS AND SPECIFIC CATEGORY
SET AUPNDOS=""
+4 KILL HIT
+5 FOR
SET AUPNDOS=$ORDER(^AUPNICP("EFF2",DFN,AUPNDOS),-1)
IF 'AUPNDOS!$DATA(HIT)
QUIT
Begin DoDot:1
+6 IF AUPNDOS>DOS
QUIT
+7 SET AUPNREC=0
+8 FOR
SET AUPNREC=$ORDER(^AUPNICP("EFF2",DFN,AUPNDOS,CAT,AUPNREC))
IF 'AUPNREC
QUIT
Begin DoDot:2
+9 SET SEQREC=$GET(^AUPNICP(AUPNREC,0))
+10 SET SEQ=$PIECE(SEQREC,U,5)
+11 SET INSPTR=$PIECE(SEQREC,U,3)
+12 SET INSTYPE=$PIECE(^AUTNINS(INSPTR,2),U,1)
+13 SET COV=$PIECE(SEQREC,U,7)
+14 SET PLANPTR=$PIECE(SEQREC,U,11)
+15 SET BEGDT=$PIECE(SEQREC,U,8)
+16 SET ENDDT=$PIECE(SEQREC,U,9)
+17 SET HIT=""
+18 SET SEQAR($JOB,CAT,SEQ)=INSPTR_"^"_INSTYPE_"^"_COV_"^"_PLANPTR_"^"_BEGDT_"^"_ENDDT
End DoDot:2
End DoDot:1
+19 QUIT
ALL ;
+1 SET AUPNDOS=0
+2 FOR
SET AUPNDOS=$ORDER(^AUPNICP("EFF2",DFN,AUPNDOS))
IF 'AUPNDOS
QUIT
Begin DoDot:1
+3 IF AUPNDOS>DOS
QUIT
+4 SET AUPNCAT=""
+5 FOR
SET AUPNCAT=$ORDER(^AUPNICP("EFF2",DFN,AUPNDOS,AUPNCAT))
IF AUPNCAT=""
QUIT
Begin DoDot:2
+6 SET AUPNREC=0
+7 FOR
SET AUPNREC=$ORDER(^AUPNICP("EFF2",DFN,AUPNDOS,AUPNCAT,AUPNREC))
IF 'AUPNREC
QUIT
Begin DoDot:3
+8 SET SEQREC=$GET(^AUPNICP(AUPNREC,0))
+9 SET SEQ=$PIECE(SEQREC,U,5)
+10 SET INSPTR=$PIECE(SEQREC,U,3)
+11 SET INSTYPE=$PIECE(^AUTNINS(INSPTR,2),U,1)
+12 SET COV=$PIECE(SEQREC,U,7)
+13 SET PLANPTR=$PIECE(SEQREC,U,11)
+14 SET BEGDT=$PIECE(SEQREC,U,8)
+15 SET ENDDT=$PIECE(SEQREC,U,9)
+16 SET SEQAR($JOB,AUPNCAT,SEQ)=INSPTR_"^"_INSTYPE_"^"_COV_"^"_PLANPTR_"^"_BEGDT_"^"_ENDDT
End DoDot:3
End DoDot:2
End DoDot:1
+17 QUIT
