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

ACHSRPI1.m

Go to the documentation of this file. 
  1. ACHSRPI1 ; IHS/ITSC/PMF - TPF RE-WRITE OF ACHSRPI ;
  1.  ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**13**;JUN 11,2001
  1.  ;ACHS*3.1*13 11/27/06 IHS/OIT/FCJ PRT POLICY # FR CORRECT FILES
  1.  ;
  1.  ;USED BY DENIAL LETTER ROUTINE ACHSDNL3 TO SHOW INSURANCES HELD BY
  1.  ;PATIENT IF DENIAL REASON = ALTERNATE RESOURCES
  1.  ;
  1. TEST ;THIS LOOP FOR TESTING
  1.  S ACHSFAC=3   ;FOR TESTING
  1.  S U="^",INSTAB=15
  1.  K ACHSEFF
  1.  F  S ACHSFAC=$O(^ACHSF(ACHSFAC)) Q:+ACHSFAC=0  D
  1.  .S ACHSDOC=0
  1.  .F  S ACHSDOC=$O(^ACHSF(ACHSFAC,"D",ACHSDOC)) Q:+ACHSDOC=0  D
  1.  ..S ACHSFDT=$P($G(^ACHSF(ACHSFAC,"D",ACHSDOC,3)),U)
  1.  ..S ACHSTDT=$P($G(^ACHSF(ACHSFAC,"D",ACHSDOC,3)),U,2)
  1.  ..S DFN=$P($G(^ACHSF(ACHSFAC,"D",ACHSDOC,0)),U,22)
  1.  ..D PVTINS(DFN,ACHSFDT,ACHSTDT)
  1.  ..D SUPINS(DFN,ACHSFDT,ACHSTDT)
  1.  ..D BOX3H(DFN,.ACHSEFF)
  1.  Q
  1.  ;
  1.  ;
  1.  ;DFN=PATIENT INTERNAL NUMBER
  1.  ;ACHSFDT= AUTHORIZED FROM DATE
  1.  ;ACHSEDT= ATUHORIZED TO DATE
  1.  ;
  1.  ;GET PRIVATE INSURANCE
  1.  ;(PATIENT INTERNAL NUMBER,AUTH FROM DATE,AUTH TO DATE,FACILITY NUMBER,DOCUMENT NUMBER,IGNORE AUTHORZATION DATES)
  1.  ;CALLED BY ACHDNL3
  1.  ;
  1. PVTINS(DFN,ACHSFDT,ACHSTDT,ACHSFAC,ACHSA,IGNORE) ;EP from ACHSDNL3
  1.  Q:DFN=""
  1.  S INSTAB=15
  1.  S ACHSDOC=$P($G(^ACHSDEN(ACHSFAC,"D",ACHSA,0)),U)    ;DOC 0 NODE
  1.  S DTOFSERV=$P($G(^ACHSDEN(ACHSFAC,"D",ACHSA,0)),U,4) ;DATE OF MEDICAL SERVICE
  1.  S ACHSGLOB="AUPNPRVT"
  1.  S INSDA=0
  1.  F X=1:1 S INSDA=$O(^AUPNPRVT(DFN,11,INSDA)) Q:+INSDA=0  D
  1.  .S ACHSPINS=$G(^AUPNPRVT(DFN,11,INSDA,0))
  1.  .S ACHSPEDT=$P(ACHSPINS,U,6)   ;POLICY EFFECTIVE DATE
  1.  .S ACHSPTDT=$P(ACHSPINS,U,7)   ;POLICY TERMINATION DATE
  1.  .;
  1.  .;CHECK IF DATE OF MEDICAL SERVICE IS BEFORE POLICY EFFECTIVE DATE
  1.  .I DTOFSERV<ACHSPEDT Q
  1.  .;CHECK IF DATE OF MEDICAL SERVICE IS AFTER POLICY TERMINATION DATE
  1.  .I DTOFSERV>ACHSPTDT Q
  1.  .I X=1 W !!?INSTAB,"PRIVATE INSURANCE COVERAGE",!?INSTAB,"BASED ON DATE OF SERVICE: " S Y=DTOFSERV X ^DD("DD") W Y
  1.  .;ACHS*3.1*13 11/27/06 IHS/OIT/FCJ PRT POLICY # FR CORRECT FILES
  1.  .;S ACHSPNUM=$P(ACHSPINS,U,2)   ;POLICY NUMBER
  1.  .I $P(ACHSPINS,U,8),$D(^AUPN3PPH($P(ACHSPINS,U,8),0)) S ACHSPNUM=$P(^AUPN3PPH($P(ACHSPINS,U,8),0),U,4) ;POLICY NUMBER
  1.  .S ACHSINSU=$P(ACHSPINS,U)     ;INSURER PTR TO INSURER FILE 9999999.18
  1.  .I ACHSINSU="" S ACHSINAM=" --- "
  1.  .E  S ACHSINAM=$P($G(^AUTNINS(ACHSINSU,0)),U)    ;INSURER NAME
  1.  .D RESULT(ACHSPEDT,ACHSPTDT,ACHSFDT,ACHSTDT,ACHSINAM,ACHSPNUM,IGNORE,DTOFSERV)
  1.  D END
  1.  Q
  1.  ;
  1.  ;LOOK FOR SUPPLEMENTAL INSURANCE ; MEDICARE,MEDICAID,RAILROAD
  1.  ;(PATIENT INTERNAL NUMBER,AUTH FROM DATE,AUTH TO DATE,FACILITY NUMBER,DOCUMENT NUMBER,IGNORE AUTHORIZATION DATES)
  1.  ;CALLED BY ACHDNL3
  1.  ;
  1. SUPINS(DFN,ACHSFDT,ACHSTDT,ACHSFAC,ACHSA,IGNORE) ;EP from ACHSDNL3
  1.  Q:DFN=""
  1.  N ACHSEIN
  1.  S INSTAB=15
  1.  S ACHSDOC=$P($G(^ACHSDEN(ACHSFAC,"D",ACHSA,0)),U)    ;DOC 0 NODE
  1.  S DTOFSERV=$P($G(^ACHSDEN(ACHSFAC,"D",ACHSA,0)),U,4) ;DATE OF MEDICAL SERVICE
  1.  F ACHSGLOB="^AUPNMCR","^AUPNMCD","^AUPNRRE" D
  1.  .S INSDA=0
  1.  .S ACHSEIN=DFN I ACHSGLOB["MCD" S ACHSEIN=$O(^AUPNMCD("B",DFN,""))
  1.  .I ACHSEIN="" Q
  1.  .;
  1.  .;9/13/01  pmf  several lines changed below.  DFN replaced ACHSEIN
  1.  .;
  1.  .F X=1:1 S INSDA=$O(@ACHSGLOB@(ACHSEIN,11,INSDA)) Q:+INSDA=0  D
  1.  ..S ACHSPINS=$G(@ACHSGLOB@(ACHSEIN,11,INSDA,0))    ;
  1.  ..S ACHSPIN0=$G(@ACHSGLOB@(ACHSEIN,0))          ;ZERO NODE
  1.  ..S ACHSPEDT=$P(ACHSPINS,U)     ;POLICY EFFECTIVE DATE
  1.  ..S ACHSPTDT=$P(ACHSPINS,U,2)   ;POLICY TERMINATION DATE
  1.  ..;
  1.  ..;CHECK IF DATE OF MEDICAL SERVICE IS BEFORE POLICY EFFECTIVE DATE
  1.  ..I DTOFSERV<ACHSPEDT Q
  1.  ..;CHECK IF DATE OF MEDICAL SERVICE IS AFTER POLICY TERMINATION DATE
  1.  ..I DTOFSERV>ACHSPTDT Q
  1.  ..;
  1.  ..;I X=1 W !!?INSTAB,"SUPPLEMENTAL INSURANCE COVERAGE",!?INSTAB,"BASED ON DATE OF SERVICE: " S Y=DTOFSERV X ^DD("DD") W Y
  1.  ..;
  1.  ..S ACHSPNUM=""
  1.  ..I ACHSGLOB="^AUPNRRE" S ACHSPNUM=$P(ACHSPIN0,U,4)
  1.  ..E  S ACHSPNUM=$P(ACHSPIN0,U,3)   ;POLICY NUMBER
  1.  ..S ACHSINSU=$P(ACHSPIN0,U,2)   ;INSURER PTR TO INSURER FILE 9999999.18
  1.  ..I ACHSINSU="" S ACHSINAM=" --- "
  1.  ..E  S ACHSINAM=$P($G(^AUTNINS(ACHSINSU,0)),U)      ;INSURER NAME
  1.  ..I ACHSGLOB="^AUPNMCR" S ACHSISUF=$P(ACHSPIN0,U,4)  ;SUFFIX PTR TO
  1.  ..E  S ACHSISUF=""                                  ;MEDICARE SUFFIX
  1.  ..;                                                 ;9999999.32
  1.  ..I ACHSISUF'="" S ACHSISUF=$P($G(^AUTTMCS(ACHSISUF,0)),U)
  1.  ..I ACHSGLOB="^AUPNRRE" S ACHSIPRE=$P(ACHSPIN0,U,3) ;PREFIX PTR TO
  1.  ..E  S ACHSIPRE=""                                   ;RAILROAD PREFIX
  1.  ..I ACHSIPRE'="" S ACHSIPRE=$P($G(^AUPNRRE(ACHSIPRE,0)),U)  ;9999999.33
  1.  ..S ACHSPNUM=ACHSIPRE_" "_ACHSPNUM_" "_ACHSISUF
  1.  ..D RESULT(ACHSPEDT,ACHSPTDT,ACHSFDT,ACHSTDT,ACHSINAM,ACHSPNUM,IGNORE,DTOFSERV)
  1.  D END
  1.  Q
  1.  ;
  1.  ;
  1.  ;DECIDE WHETHER POLICY IS GOOD FOR AUTHORIZED DATE RANGE
  1.  ;(POLICY EFFECT. DATE,POLICY TERM. DATE,AUTH FROM DATE,AUTH TO DATE)
  1.  ;
  1. POLGOOD(ACHSPEDT,ACHSPTDT,ACHSFDT,ACHSTDT,IGNORE) ;
  1.  S:ACHSPTDT="" ACHSPTDT=9999999
  1.  S:ACHSTDT="" ACHSTDT=9999999
  1.  ;
  1.  I ACHSPEDT="" Q 10                      ;MUST HAVE A POLICY EFFECTIVE
  1.                                          ;DATE
  1.  ;
  1.  I ACHSFDT="" Q 15                       ;MUST HAVE AUTHORIZE FROM DATE
  1.  ;
  1.                                          ;
  1.  I ACHSPTDT<ACHSFDT Q 20                 ;POLICY IS NO LONGER EFFECTIVE
  1.                                          ;
  1.                                          ;
  1.  I ACHSPTDT=9999999,ACHSTDT=9999999 D  S Y=X X ^DD("DD") Q 200_U_Y
  1.  .                                       ;IF POLICY TERMINATION DATE AND
  1.  .                                       ;AUTHORIZATION TO DATE ARE OPEN
  1.  .                                       ;TAKE LATEST OF THE TWO AS EFF
  1.  .S X=$S(ACHSPEDT>ACHSFDT:ACHSPEDT,1:ACHSFDT)
  1.  ;
  1.  I ACHSPTDT=ACHSPEDT!(ACHSPTDT<ACHSPEDT) Q 30
  1.                                          ;IF POLICY EFFECTIVE DATE
  1.                                          ;EQUALS POLICY TERMINATION
  1.                                          ;DATE OR POLICY TERMINATION
  1.                                          ;DATE IS LESS THAN THE EFFEC.
  1.                                          ;DATE THEN INVALID POLICY DATES
  1.                                          ;
  1.  I ACHSPEDT<(ACHSFDT+1),(ACHSPTDT>(ACHSTDT+1)) Q 40
  1.                                         ;IF POLICY EFFECTIVE DATE LESS
  1.                                         ;THAN AUTH. FROM DATE AND
  1.                                         ;POLICY TERMINATION DATE IS
  1.                                         ;GREATER THAN AUTHORIZATION TO
  1.                                         ;THEN FULL AUTH RANGE IS COVERE
  1.  ;
  1.  I ACHSPEDT>(ACHSFDT-1),(ACHSPTDT<(ACHSTDT+1)) Q 45
  1.                                          ;IF POLICY EFFECTIVE DATE IS
  1.                                          ;GREATER THAN AUTH. FROM DATE
  1.                                          ;AND THE POLICY TERM. DATE IS
  1.                                          ;LESS THAN THE AUTH. TO DATE
  1.                                          ;THEN PARTIAL AUTH
  1.                                          ;RANGE IS COVERED
  1.  ;
  1.  I ACHSPEDT>ACHSTDT Q 50                 ;IF POLICY EFFECTIVE DATE
  1.                                          ;IS GREATER THAN AUTH TO DATE
  1.                                          ;THEN NO COVERAGE
  1.  ;
  1.  I ACHSPTDT<ACHSFDT Q 20                  ;IF POLICY TERM. DATE IS LESS
  1.                                          ;THAN THE AUTH FROM DATE THEN
  1.                                          ;NO COVERAGE
  1.  ;
  1.  ;
  1.  Q 100                                   ;UNDETERMINED
  1.  ;
  1.  ;
  1.  ;PRINT RESULTS
  1.  ;(POLICY EFFECT. DATE,POLICY TERM. DATE,AUTH FROM DATE,AUTH TO DATE,INSURER NAME,POLICY NUMBER)
  1.  ;
  1. RESULT(ACHSPEDT,ACHSPTDT,ACHSFDT,ACHSTDT,ACHSINAM,ACHSPNUM,RESULT,DTOFSERV) ;
  1.  S:$G(ACHSPEDT)="" ACHSPEDT=" --- "
  1.  S:$G(ACHSPTDT)="" ACHSPTDT=" --- "
  1.  S:$G(ACHSFDT)="" ACHSFDT=" --- "
  1.  S:$G(ACHSTDT)="" ACHSTDT=" --- "
  1.  S:$G(ACHSINAM)="" ACHSINAM=" --- "
  1.  S:$G(ACHSPNUM)="" ACHSPNUM=" --- "
  1.  S STAT=$$POLGOOD(ACHSPEDT,ACHSPTDT,ACHSFDT,ACHSTDT)
  1.  ;
  1.  ;W !!!,"GLOBAL: ",$G(ACHSGLOB)
  1.  ;W !,"PATIENT: ",DFN,?35,"COVERAGE STATUS"
  1.  S INSTAB=15                                 ;INSURANCE INFO TAB
  1.  W !!?INSTAB,"INSURER: ",ACHSINAM
  1.  W !?INSTAB,"POLICY #: ",ACHSPNUM
  1.  ;
  1.  I 'IGNORE D
  1.  . W !?INSTAB,"FOR AUTH. DATE RANGE: "
  1.  . ;
  1.  . ;here we translate the value of STAT into a human readable
  1.  . ;phrase.  we have to keep line length down, so we do it
  1.  . ;in up to three steps.
  1.  . S ACHSYAYA=$S(+STAT=15:"MUST HAVE AUTH FROM DATE",+STAT=1:"YES",+STAT=100:"UNDETERMINED",+STAT=200:"YES AS OF "_$P(STAT,U,2),1:"")
  1.  . I ACHSYAYA="" S ACHSYAYA=$S(+STAT=10:"POLICY EFFECTIVE DATE MISSING",+STAT=20:"POLICY EXPIRED",+STAT=30:"INVALID POLICY DATES",+STAT=40:"FULL COVERAGE",1:"")
  1.  . I ACHSYAYA="" S ACHSYAYA=$S(+STAT=45:"PARTIAL COVERAGE",+STAT=50:"POLICY BEGINS AFTER AUTH ENDS",+STAT=0:"NO INACTIVE",1:"UNDETERMINED")
  1.  . W ACHSYAYA K ACHSYAYA
  1.  . Q
  1.  ;
  1.  ;
  1.  W !?INSTAB,"POLICY BEGIN: " S Y=ACHSPEDT X ^DD("DD") W Y
  1.  W !?INSTAB,"POLICY END: " S Y=ACHSPTDT X ^DD("DD") W Y
  1.  ;
  1.  I 'IGNORE W !?INSTAB,"AUTH FROM: " S Y=ACHSFDT X ^DD("DD") W Y
  1.  I 'IGNORE W !?INSTAB,"AUTH TO: " S Y=ACHSTDT X ^DD("DD") W Y
  1.  ;
  1.  I (U_1_U_200_U_40_U_45_U)'[(U_+STAT_U) S ACHSEFF(DFN,ACHSINAM,ACHSPEDT,ACHSPTDT,ACHSPNUM)="NO EFFECTIVE POLICIES FOUND"
  1.  ;SET THE EFFECTIVE COVERAGE ARRAY
  1.  S ACHSEFF(DFN,ACHSINAM,ACHSPEDT,ACHSPTDT,ACHSPNUM)=STAT
  1.  Q
  1.  ;
  1.  ;DO OTHER HEALTH INSURANCE BOX 3 H
  1.  ;(PATIENT INTERNAL NUMBER,ARRAY OF GOOD POLICIES)
  1. BOX3H(DFN,ACHSEFF) ;
  1.  Q:DFN=""
  1.  Q:'$D(ACHSEFF(DFN))
  1.  W !!!,"*****************"
  1.  S ACHSNAM=""
  1.  F  S ACHSNAM=$O(ACHSEFF(DFN,ACHSNAM)) Q:ACHSNAM=""  D
  1.  .S ACHSPEDT=""
  1.  .F  S ACHSPEDT=$O(ACHSEFF(DFN,ACHSNAM,ACHSPEDT)) Q:ACHSPEDT=""  D
  1.  ..S ACHSPTDT=""
  1.  ..F  S ACHSPTDT=$O(ACHSEFF(DFN,ACHSNAM,ACHSPEDT,ACHSPTDT)) Q:ACHSPTDT=""  D
  1.  ...S ACHSPNUM=""
  1.  ...F  S ACHSPNUM=$O(ACHSEFF(DFN,ACHSNAM,ACHSPEDT,ACHSPTDT,ACHSPNUM)) Q:ACHSPNUM=""  D
  1.  ....I ACHSEFF(DFN,ACHSNAM,ACHSPEDT,ACHSPTDT,ACHSPNUM)[("NO EFFECTIVE") W !,"***NO EFFECTIVE POLICIES FOUND!***" Q
  1.  ....W !,DFN_"  "_$P($G(^DPT(DFN,0)),U)
  1.  ....W !,$E(ACHSNAM,1,8)_" "_ACHSPNUM
  1.  ....W !?8,"EFF: "
  1.  ....I ACHSPEDT=9999999 W ""
  1.  ....E  S Y=ACHSPEDT X ^DD("DD") W Y
  1.  ....W "  TERM: "
  1.  ....I ACHSPTDT=9999999 W ""
  1.  ....E  S Y=ACHSPTDT X ^DD("DD") W Y
  1.  W !,"*******************",!!!
  1.  Q
  1.  ;
  1.  ;CLEAN UP VARAIABLES USED IN THIS ROUTINE
  1. END ;
  1.  K ACHSGLOB,ACHSFAC,ACHSFDT,ACHSEFF,ACHSINAM,ACHSIPRE,ACHSINSU,ACHSISUF
  1.  K ACHSNAM,ACHSPEDT,ACHSPIN0,ACHSPINS,ACHSPNUM,ACHSPTDT,ACHSTDT,DTOFSERV,IGNORE,INSDA,INSTAB,RESULT,X,Y
  1.  Q