- AGINS1 ; IHS/ASDS/EFG - ROUTINE 2 TO BUILD AGINS ARRAY ;
- ;;7.1;PATIENT REGISTRATION;**2,3,13**;AUG 25, 2005;Build 1
- ;IHS/OIT/NKD AG*7.1*13 RAILROAD DISPLAY FIX
- Q
- LOAD ;EP - LOAD ARRAY AGINS WITH ELIGIBILITY DATA
- S SEL=SEL+1
- I '$D(PLANPTR) S PLANPTR=""
- S AGINS(SEL)=$G(INS)_U_$G(INSPTR)_U_$G(COVPTR)_U_$G(COV)_U_$G(EFF)_U_$G(END)_U_$G(PHPTR)_U_$G(PH)_U_$G(POLNUM)_U_$G(TYPE)_U_$G(RECPTR)_U_$G(PLANPTR)_U_$G(ISACTIVE)_U_$G(INSGLORF)_U_$G(MCDRATE)_U_$G(RELPOLHO)
- S AGINS(SEL)=AGINS(SEL)_U_$G(PCP)_U_$G(PLANNAME)_U_$G(GRPNAME)_U_$G(GRPNUMB)_U_$G(GSTREET)_U_$G(GCITY)_U_$G(GSTATE)_U_$G(GZIP)_U_$G(INSGEND)_U_$G(OPCOPAY)_U_$G(OPCOINS)_U_$G(FAMDEDUC)_U_$G(INDDEDUC)
- Q
- ;CALLED FROM AGINS
- ADDSEQNM ;EP - ADD SEQ #
- N SEQ,SEQ2,EFFDT,ENDDT,OLDSEQ,MEDCR,INSPTR,MEDICARE,MEDTYP,MEDSEQ,MED2SEQ,NEWSEQ,RAILSEQ,RAIL2SEQ
- N COVTYP ;IHS/SD/TPF 12/2/2005 AG*7.1*1
- S SEQ2=0,MEDCR=0
- S SEQ="" F S SEQ=$O(AGINS(SEQ)) Q:SEQ="" D
- .S EFFDT=$P(AGINS(SEQ),U,5)
- .S ENDDT=$P(AGINS(SEQ),U,6)
- .S SPECSUB=$S(ENDDT="":"O",1:"T") ;O=OPEN ENDED , T=TERM DATE PRESENT
- .S MEDTYP=$P(AGINS(SEQ),U,4)
- .S INSPTR=$P(AGINS(SEQ),U,2)
- .S SEQ2=SEQ2+1
- .;RESORT BASED ON MOST RECENT EFF OR END DATE DEPENDING ON WHETHER TWO DATES EXIST OR NOT
- .I MEDTYP="" D
- ..I SPECSUB="O" S AGINSN1(SPECSUB,9999999-EFFDT_U_INSPTR,SEQ)=AGINS(SEQ)
- ..E S AGINSN1(SPECSUB,9999999-ENDDT_U_INSPTR,SEQ)=AGINS(SEQ)
- .E D
- ..I SPECSUB="O" S AGINSN1(SPECSUB,9999999-EFFDT_U_INSPTR,SEQ)=AGINS(SEQ)
- ..E S AGINSN1(SPECSUB,9999999-ENDDT_U_INSPTR,SEQ)=AGINS(SEQ)
- ;NEW SEQ AND DISPLAY ARRAY FOR 7.1. SO MCR AND RR PART A
- ;AN B LIST TOGETHER AS ONE ITEM ON THE SUMMARY PAGE
- ;DO NOT INLCUDE MEDICARE PART D
- S MEDCARE=0
- S RAILROAD=0
- S NEWSEQ=0
- S NEWSEQR=0
- S SPECSUB=""
- F S SPECSUB=$O(AGINSN1(SPECSUB)) Q:SPECSUB="" D
- .S EFFDT=""
- .F S EFFDT=$O(AGINSN1(SPECSUB,EFFDT)) Q:EFFDT="" D
- ..S OLDSEQ=""
- ..F S OLDSEQ=$O(AGINSN1(SPECSUB,EFFDT,OLDSEQ)) Q:OLDSEQ="" D
- ...S MEDTYP=$P(AGINSN1(SPECSUB,EFFDT,OLDSEQ),U,2)
- ...S COVTYP=$P(AGINSN1(SPECSUB,EFFDT,OLDSEQ),U,4) ;IHS/SD/TPF 12/2/2005 AG*7.1*1
- ...;MEDICARE
- ...I MEDTYP=2,MEDCARE,(COVTYP'="D") S MED2SEQ=MED2SEQ+1,AGINSNN(MEDSEQ,MED2SEQ)=AGINS(OLDSEQ) Q
- ...;I MEDTYP=2,'MEDCARE S MEDCARE=1 S NEWSEQ=NEWSEQ+1,MEDSEQ=NEWSEQ,MED2SEQ=1 S AGINSNN(MEDSEQ,MED2SEQ)=AGINS(OLDSEQ) Q
- ...I MEDTYP=2,'MEDCARE,(COVTYP'="D") S MEDCARE=1 S NEWSEQ=NEWSEQ+1,MEDSEQ=NEWSEQ,MED2SEQ=1 S AGINSNN(MEDSEQ,MED2SEQ)=AGINS(OLDSEQ) Q ;IHS/SD/TPF 12/2/2005 AG*7.1*1
- ...;NEW CODE FOR RAILROAD
- ...;I MEDTYP=1,RAILROAD S RAIL2SEQ=RAIL2SEQ+1,AGINSNN(MEDSEQ,RAIL2SEQ)=AGINS(OLDSEQ) Q ; IHS/OIT/NKD AG*7.1*13
- ...I MEDTYP=1,RAILROAD S RAIL2SEQ=RAIL2SEQ+1,AGINSNN(RAILSEQ,RAIL2SEQ)=AGINS(OLDSEQ) Q
- ...;I MEDTYP=1,'RAILROAD S RAILROAD=1 S NEWSEQ=NEWSEQ+1,MEDSEQ=NEWSEQ,RAIL2SEQ=1 S AGINSNN(MEDSEQ,RAIL2SEQ)=AGINS(OLDSEQ) Q ; IHS/OIT/NKD AG*7.1*13
- ...I MEDTYP=1,'RAILROAD S RAILROAD=1 S NEWSEQ=NEWSEQ+1,RAILSEQ=NEWSEQ,RAIL2SEQ=1 S AGINSNN(RAILSEQ,RAIL2SEQ)=AGINS(OLDSEQ) Q
- ...;END RAILROAD
- ...I MEDTYP'=2,(MEDTYP'=1) S NEWSEQ=NEWSEQ+1
- ...I MEDTYP=2,(COVTYP="D") S NEWSEQ=NEWSEQ+1 ;IHS/SD/TPF 12/5/05 AG*7.1*1 ITEM 1
- ...S AGINSNN(NEWSEQ)=AGINS(OLDSEQ)
- ;AGINS REMAINS AND WILL BE USED WITH SEQUENCING
- ;AGINSNN NEW ARRAY TO BE USED WITH "DEFAULT" OR "NORMAL" DISPLAY
- Q
- AGINS1 ; IHS/ASDS/EFG - ROUTINE 2 TO BUILD AGINS ARRAY ;
- +1 ;;7.1;PATIENT REGISTRATION;**2,3,13**;AUG 25, 2005;Build 1
- +2 ;IHS/OIT/NKD AG*7.1*13 RAILROAD DISPLAY FIX
- +3 QUIT
- LOAD ;EP - LOAD ARRAY AGINS WITH ELIGIBILITY DATA
- +1 SET SEL=SEL+1
- +2 IF '$DATA(PLANPTR)
- SET PLANPTR=""
- +3 SET AGINS(SEL)=$GET(INS)_U_$GET(INSPTR)_U_$GET(COVPTR)_U_$GET(COV)_U_$GET(EFF)_U_$GET(END)_U_$GET(PHPTR)_U_$GET(PH)_U_$GET(POLNUM)_U_$GET(TYPE)_U_$GET(RECPTR)_U_$GET(PLANPTR)_U_$GET(ISACTIVE)_U_$GET(INSGLORF)_U_$GET(MCDRATE)_U_$GET(RELPOLHO)
- +4 SET AGINS(SEL)=AGINS(SEL)_U_$GET(PCP)_U_$GET(PLANNAME)_U_$GET(GRPNAME)_U_$GET(GRPNUMB)_U_$GET(GSTREET)_U_$GET(GCITY)_U_$GET(GSTATE)_U_$GET(GZIP)_U_$GET(INSGEND)_U_$GET(OPCOPAY)_U_$GET(OPCOINS)_U_$GET(FAMDEDUC)_U_$GET(INDDEDUC)
- +5 QUIT
- +6 ;CALLED FROM AGINS
- ADDSEQNM ;EP - ADD SEQ #
- +1 NEW SEQ,SEQ2,EFFDT,ENDDT,OLDSEQ,MEDCR,INSPTR,MEDICARE,MEDTYP,MEDSEQ,MED2SEQ,NEWSEQ,RAILSEQ,RAIL2SEQ
- +2 ;IHS/SD/TPF 12/2/2005 AG*7.1*1
- NEW COVTYP
- +3 SET SEQ2=0
- SET MEDCR=0
- +4 SET SEQ=""
- FOR
- SET SEQ=$ORDER(AGINS(SEQ))
- IF SEQ=""
- QUIT
- Begin DoDot:1
- +5 SET EFFDT=$PIECE(AGINS(SEQ),U,5)
- +6 SET ENDDT=$PIECE(AGINS(SEQ),U,6)
- +7 ;O=OPEN ENDED , T=TERM DATE PRESENT
- SET SPECSUB=$SELECT(ENDDT="":"O",1:"T")
- +8 SET MEDTYP=$PIECE(AGINS(SEQ),U,4)
- +9 SET INSPTR=$PIECE(AGINS(SEQ),U,2)
- +10 SET SEQ2=SEQ2+1
- +11 ;RESORT BASED ON MOST RECENT EFF OR END DATE DEPENDING ON WHETHER TWO DATES EXIST OR NOT
- +12 IF MEDTYP=""
- Begin DoDot:2
- +13 IF SPECSUB="O"
- SET AGINSN1(SPECSUB,9999999-EFFDT_U_INSPTR,SEQ)=AGINS(SEQ)
- +14 IF '$TEST
- SET AGINSN1(SPECSUB,9999999-ENDDT_U_INSPTR,SEQ)=AGINS(SEQ)
- End DoDot:2
- +15 IF '$TEST
- Begin DoDot:2
- +16 IF SPECSUB="O"
- SET AGINSN1(SPECSUB,9999999-EFFDT_U_INSPTR,SEQ)=AGINS(SEQ)
- +17 IF '$TEST
- SET AGINSN1(SPECSUB,9999999-ENDDT_U_INSPTR,SEQ)=AGINS(SEQ)
- End DoDot:2
- End DoDot:1
- +18 ;NEW SEQ AND DISPLAY ARRAY FOR 7.1. SO MCR AND RR PART A
- +19 ;AN B LIST TOGETHER AS ONE ITEM ON THE SUMMARY PAGE
- +20 ;DO NOT INLCUDE MEDICARE PART D
- +21 SET MEDCARE=0
- +22 SET RAILROAD=0
- +23 SET NEWSEQ=0
- +24 SET NEWSEQR=0
- +25 SET SPECSUB=""
- +26 FOR
- SET SPECSUB=$ORDER(AGINSN1(SPECSUB))
- IF SPECSUB=""
- QUIT
- Begin DoDot:1
- +27 SET EFFDT=""
- +28 FOR
- SET EFFDT=$ORDER(AGINSN1(SPECSUB,EFFDT))
- IF EFFDT=""
- QUIT
- Begin DoDot:2
- +29 SET OLDSEQ=""
- +30 FOR
- SET OLDSEQ=$ORDER(AGINSN1(SPECSUB,EFFDT,OLDSEQ))
- IF OLDSEQ=""
- QUIT
- Begin DoDot:3
- +31 SET MEDTYP=$PIECE(AGINSN1(SPECSUB,EFFDT,OLDSEQ),U,2)
- +32 ;IHS/SD/TPF 12/2/2005 AG*7.1*1
- SET COVTYP=$PIECE(AGINSN1(SPECSUB,EFFDT,OLDSEQ),U,4)
- +33 ;MEDICARE
- +34 IF MEDTYP=2
- IF MEDCARE
- IF (COVTYP'="D")
- SET MED2SEQ=MED2SEQ+1
- SET AGINSNN(MEDSEQ,MED2SEQ)=AGINS(OLDSEQ)
- QUIT
- +35 ;I MEDTYP=2,'MEDCARE S MEDCARE=1 S NEWSEQ=NEWSEQ+1,MEDSEQ=NEWSEQ,MED2SEQ=1 S AGINSNN(MEDSEQ,MED2SEQ)=AGINS(OLDSEQ) Q
- +36 ;IHS/SD/TPF 12/2/2005 AG*7.1*1
- IF MEDTYP=2
- IF 'MEDCARE
- IF (COVTYP'="D")
- SET MEDCARE=1
- SET NEWSEQ=NEWSEQ+1
- SET MEDSEQ=NEWSEQ
- SET MED2SEQ=1
- SET AGINSNN(MEDSEQ,MED2SEQ)=AGINS(OLDSEQ)
- QUIT
- +37 ;NEW CODE FOR RAILROAD
- +38 ;I MEDTYP=1,RAILROAD S RAIL2SEQ=RAIL2SEQ+1,AGINSNN(MEDSEQ,RAIL2SEQ)=AGINS(OLDSEQ) Q ; IHS/OIT/NKD AG*7.1*13
- +39 IF MEDTYP=1
- IF RAILROAD
- SET RAIL2SEQ=RAIL2SEQ+1
- SET AGINSNN(RAILSEQ,RAIL2SEQ)=AGINS(OLDSEQ)
- QUIT
- +40 ;I MEDTYP=1,'RAILROAD S RAILROAD=1 S NEWSEQ=NEWSEQ+1,MEDSEQ=NEWSEQ,RAIL2SEQ=1 S AGINSNN(MEDSEQ,RAIL2SEQ)=AGINS(OLDSEQ) Q ; IHS/OIT/NKD AG*7.1*13
- +41 IF MEDTYP=1
- IF 'RAILROAD
- SET RAILROAD=1
- SET NEWSEQ=NEWSEQ+1
- SET RAILSEQ=NEWSEQ
- SET RAIL2SEQ=1
- SET AGINSNN(RAILSEQ,RAIL2SEQ)=AGINS(OLDSEQ)
- QUIT
- +42 ;END RAILROAD
- +43 IF MEDTYP'=2
- IF (MEDTYP'=1)
- SET NEWSEQ=NEWSEQ+1
- +44 ;IHS/SD/TPF 12/5/05 AG*7.1*1 ITEM 1
- IF MEDTYP=2
- IF (COVTYP="D")
- SET NEWSEQ=NEWSEQ+1
- +45 SET AGINSNN(NEWSEQ)=AGINS(OLDSEQ)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +46 ;AGINS REMAINS AND WILL BE USED WITH SEQUENCING
- +47 ;AGINSNN NEW ARRAY TO BE USED WITH "DEFAULT" OR "NORMAL" DISPLAY
- +48 QUIT
