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

ACHSEOBN.m

Go to the documentation of this file. 
  1. ACHSEOBN ; IHS/ITSC/PMF - PROCESS EOBRS extention of ACHSEOB3 ;    [ 10/16/2001   8:16 AM ]
  1.  ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
  1.  ;
  1.  ;
  1. VNDR    ;EP - Attempt to match Vendor 
  1.  ;GET RID OF HYPEN IN 'EIN NO.'_"-"_'EIN SUFFIX'
  1.  S ACHSPROV=$E(ACHSEOBR("C",16),1,10)_$E(ACHSEOBR("C",16),12,13)
  1.  S ACHSPROV=$P(ACHSPROV," ")      ;?????
  1.  ;
  1.  ;TRY TO FIND VENDOR IN 'EIN NO' AND 'EIN SUFFIX' X-REF
  1.  I $O(^AUTTVNDR("E",ACHSPROV,0)) S ACHSPROV=$O(^(0)) Q
  1.  S ACHSPROV=$E(ACHSPROV,1,10)   ;'EIN NO'
  1.  ;
  1.  ;TRY TO FIND VENDOR IN 'EIN NO' X-REF
  1.  I $O(^AUTTVNDR("C",ACHSPROV,0)) S ACHSPROV=$O(^(0)) Q
  1.  ;
  1.  S ACHSPROV=ACHSEOBR("D",8)             ;VENDOR NAME
  1.  ;TAKE OFF SPACE AT END OF NAME
  1.  F  Q:$E(ACHSPROV,$L(ACHSPROV))'=" "  S ACHSPROV=$E(ACHSPROV,1,$L(ACHSPROV)-1)
  1.  ;USE VENDOR NAME TO FIND VENDOR PTR IN B X-REF
  1.  I $O(^AUTTVNDR("B",ACHSPROV,0)) S ACHSPROV=$O(^(0)) Q
  1.  S ACHSPROV=0
  1.  Q
  1.  ;
  1. CHKOCC ;EP from ACHSEOB3
  1.  ;check the object class code
  1.  ; the object class code that we store and the object class code
  1.  ; that we send in and get back are NOT necessarily the same.
  1.  ; when the code is going out, a "crosswalk" is done to translate
  1.  ; it to a newer code.  This means that to check the code coming in,
  1.  ; we want to crosswalk it backwards to the old code.
  1.  ;
  1.  ;if the code coming back is not of the right pattern, write
  1.  ;  warning and quit
  1.  I ACHSEOBR("C",9)'?4AN D CHKOCC0 Q
  1.  ;
  1.  ;if the code returned with the EOBR matches the SCC, quit 
  1.  I ACHSEOBR("C",9)=$P(^ACHS(3,DUZ(2),1,$P(ACHSDOCR,U,7),0),U) Q
  1.  ;
  1.  ;or, if the code returned with the EOBR matches the OCC, quit
  1.  N OCC
  1.  S OCC=$P(ACHSDOCR,U,10) I OCC'="" S OCC=$P($G(^ACHSOCC(OCC,0)),U,1) I ACHSEOBR("C",9)=OCC Q
  1.  ;
  1.  ;now do the crosswalk. convert the SCC on file to an OCC, and see
  1.  ;if that OCC matches the code returned with the EOBR
  1.  N %,T
  1.  S OCC=$P(^ACHS(3,DUZ(2),1,$P(ACHSDOCR,U,7),0),U)
  1.  F %=1:1 S T=$P($T(CRSWLK+%),";",3) Q:T="END"  I $P(T,U)=OCC S OCC=$P(T,U,2) Q
  1.  I ACHSEOBR("C",9)'=OCC D CHKOCC0
  1.  Q
  1.  ;
  1. CHKOCC0 ;
  1.  ;mismatch - record warning and go on
  1.  S ACHSERRE=10,ACHSEDAT=ACHSEOBR("C",9) D ^ACHSEOBG
  1.  Q
  1. CRSWLK ;
  1.  ;;2185^2185
  1.  ;;252A^256Q
  1.  ;;252B^256Q
  1.  ;;252H^256Q
  1.  ;;252J^256Q
  1.  ;;252D^256R
  1.  ;;252G^256R
  1.  ;;252L^256R
  1.  ;;252M^256R
  1.  ;;252Q^256R
  1.  ;;252S^256R
  1.  ;;254B^256R
  1.  ;;254D^256R
  1.  ;;254E^256R
  1.  ;;254G^256R
  1.  ;;254J^256R
  1.  ;;254L^256R
  1.  ;;254A^256T
  1.  ;;254C^256T
  1.  ;;252Z^256Z
  1.  ;;252F^256W
  1.  ;;254V^256W
  1.  ;;2611^2611
  1.  ;;263A^263A
  1.  ;;263L^263A
  1.  ;;263G^263G
  1.  ;;263K^263K
  1.  ;;4319^4319
  1.  ;;8116^8116
  1.  ;;END;END
  1.  ;
  1. SENDMSG ;EP from ACHSEOB3
  1.  N X,Y,Z
  1.  K ^TMP("ACHSEOB3")
  1.  F X=1:1 S Y=$P($T(TXT+X),";;",2) Q:Y="###"  S Z="" X:$L($P(Y,";",2)) $P(Y,";",2) S ^TMP("ACHSEOB3",$J,X)=$P(Y,";",1)_Z
  1.  K X,Y,Z
  1.  N XMSUB,XMDUZ,XMTEXT,XMY
  1.  S XMB="ACHS EOBR PROCESSING"
  1.  S XMDUZ="CHS EOBR Automatic Processing",XMSUB="3P Pay on EOBR, no Insurance in Reg."
  1.  S XMTEXT="^TMP(""ACHSEOB3"",$J,"
  1.  S XMY(1)=""
  1.  D ^XMB,KILL^XM
  1.  K ^TMP("ACHSEOB3")
  1.  Q
  1.  ;
  1. TXT ;
  1.  ;;During automatic processing of CHS EOBRs, an EOBR was found
  1.  ;;to have a payment from a Third Party Source, and no insurance
  1.  ;;for the patient was effective for the patient on the DOS, in
  1.  ;;your local Patient Registration files.  Specific info:
  1.  ;;       EOBR Control Number :  ;S Z=ACHSEOBR("A",13)_"-"_ACHSEOBR("A",5)
  1.  ;;     Purchase Order Number :  ;S Z=ACHSEOBR("A",12)
  1.  ;;              Patient Name :  ;S Z=ACHSEOBR("B",8)
  1.  ;;                       HRN :  ;S Z=ACHSEOBR("B",9)
  1.  ;;Amount Paid by Third Party :  $;S Z=$FN($E(ACHSEOBR("D",11),1,7)_"."_$E(ACHSEOBR("D",11),8,9),",",2)
  1.  ;; 
  1.  ;;The current EOBR data does not include the Third Party source.
  1.  ;;If you want that information, contact the Fiscal Intemediary.
  1.  ;;Your area CHS Officer can provide you with contacts at the FI.
  1.  ;;###
  1.  ;