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

ACHSYCOR.m

Go to the documentation of this file. 
  1. ACHSYCOR ; IHS/ITSC/PMF - COMPARE RECORDS TO RECORDS FROM CORE 
  1.  ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
  1.  ;
  1.  ;This utility is for comparing records of documents from
  1.  ;CORE to the records in the CHS/MIS database.
  1.  ;
  1.  ;Before this program is run, the records from CORE must be
  1.  ;loaded into a global in the present uci.
  1.  ;
  1.  ;the default storage of those records is:
  1.  ;
  1.  ;    ^TEMP("CHSCORE",docnum) = record
  1.  ;
  1.  ;where docnum is the document number stripped of the year/facility,
  1.  ;so that doc 1-S83-00006 is listed as 6.
  1.  ;
  1.  ;the CORE record looks like this:
  1.  ;
  1.  ;patient type^doc_no^fy^can^obj_cls^cum_oblig^cum_dis^document balance
  1.  ;
  1.  ;At this point, the core records are going to be uniform in fiscal
  1.  ;year; that is, they will send only one fiscal year at a time.  For
  1.  ;that reason, this program will only work on one year at a time.
  1.  ;
  1.  ;the way this program works:
  1.  ;
  1.  ;GET the facility number
  1.  ;IF there is more than one facility number, then
  1.  ;  ask which one
  1.  ;ASK for the fiscal year
  1.  ;
  1.  ;FOR each document of that year in the B xref
  1.  ;  IF the document is listed in the core records, THEN
  1.  ;    SEE if the CAN number matchs
  1.  ;    SEE if the OCC matches
  1.  ;    GET the document status
  1.  ;    FOR each transaction on the document
  1.  ;      draw out the trans type and amount
  1.  ;    Record the total amount for each trans type
  1.  ;    Calculate and record the balance
  1.  ;    calculate and record the difference between the -
  1.  ;    - core balance and our balance
  1.  ;
  1.  ;record number of documents examined and number reported on
  1.  ;
  1.  D INIT
  1.  S FAC=$O(^ACHSF("B",""))
  1.  I $O(^ACHSF("B",FAC))'=""  D GETFAC I 'OK Q
  1.  ;
  1.  D GETFY I 'OK Q
  1.  ;
  1.  S DOCXREF=1_FY F  S DOCXREF=$O(^ACHSF(FAC,"D","B",DOCXREF)) Q:DOCXREF=""  Q:$E(DOCXREF,2)'=FY  D
  1.  . S SEQ=$O(^ACHSF(FAC,"D","B",DOCXREF,"")) I SEQ="" Q
  1.  . S DOCDAT=$G(^ACHSF(FAC,"D",SEQ,0)) I DOCDAT="" Q
  1.  . S NUMDEX=NUMDEX+1,ERR="" I NUMDEX#100=0 W " ."
  1.  . S DOCN=+$P(DOCDAT,U,1)
  1.  . I $P(DOCDAT,U,14)'=FY Q
  1.  . ;I '$D(^TEMP("CHSCORE",DOCN)) Q
  1.  . ;S COREDAT=$G(^TEMP("CHSCORE",DOCN))
  1.  . ;for testing
  1.  . S COREDAT="1^2^3^4^5^6^7^8^9^10^11^12^13^14^15"
  1.  . ;
  1.  . S NUMDMA=NUMDMA+1
  1.  . ;
  1.  . S STAT=$P(DOCDAT,U,12)
  1.  . S OCC=$P(DOCDAT,U,10),OCC=$P($G(^ACHSOCC(OCC,0)),U,1)
  1.  . I OCC'=$P(COREDAT,U,5) S ERR=ERR_BASH_"OCC MISMTC"
  1.  . ;
  1.  . S CAN=$P(DOCDAT,U,6),CAN=$P($G(^ACHS(2,CAN,0)),U,1)
  1.  . I CAN'=$P(COREDAT,U,4) S ERR=ERR_BASH_"CAN MISMTC"
  1.  . ;
  1.  . ; for each transaction...
  1.  . F TRANTYP="I","S","ZA","C","P","IP" S @TRANTYP=""
  1.  . S TNUM=0 F  S TNUM=$O(^ACHSF(FAC,"D",SEQ,"T",TNUM)) Q:TNUM=""  D
  1.  .. S TRANSDAT=$G(^ACHSF(FAC,"D",SEQ,"T",TNUM,0)) I TRANSDAT="" S ERR=ERR_BASH_"BAD TRANS" Q
  1.  .. ;
  1.  .. S TYPE=$P(TRANSDAT,U,2),AMT=+$P(TRANSDAT,U,4)
  1.  .. I TYPE="" S ERR=ERR_BASH_"BAD TRANS" Q
  1.  .. S @TRANTYP=@TRANTYP+AMT
  1.  .. Q
  1.  . ;
  1.  . S ^TEMP("CHSCORE2",DOCN)=COREDAT
  1.  . S ^TEMP("CHSCORE2",DOCN)=$G(^TEMP("CHSCORE2",DOCN))_U_STAT_U_($L(ERR,BASH)-1)_U_$P(ERR,BASH,2,9999)
  1.  . F TRANTYP="I","S","ZA","C","IP","P" S ^TEMP("CHSCORE2",DOCN)=$G(^TEMP("CHSCORE2",DOCN))_U_@TRANTYP
  1.  . S TOTAL=I+S-ZA-C-IP-P
  1.  . S ^TEMP("CHSCORE2",DOCN)=$G(^TEMP("CHSCORE2",DOCN))_U_TOTAL
  1.  . Q
  1.  ;
  1.  Q
  1.  ;
  1. INIT ;
  1.  S U="^",BASH="\"
  1.  ;number of docs examined and number of docs matched
  1.  S (NUMDEX,NUMDMA)=0
  1.  Q
  1.  ;
  1. GETFAC ;
  1.  S OK=0
  1.  W !!,"Enter the facility number to use:  "
  1.  R R:300
  1.  I R=""!(R="^") Q
  1.  I R="?" D  G GETFAC
  1.  . W ! S R="" F  S R=$O(^ACHSF("B",R)) Q:R=""  W !,?5,R
  1.  I '$D(^ACHSF("B",R)) W "Facility not on record" G GETFAC
  1.  S FAC=R,OK=1
  1.  Q
  1.  ;
  1. GETFY ;
  1.  S OK=0
  1.  W !!,"Enter the fiscal year single digit:  "
  1.  R R:300
  1.  I R=""!(R="^") Q
  1.  S FY=R,OK=1
  1.  Q