ACHSYCOR ; IHS/ITSC/PMF - COMPARE RECORDS TO RECORDS FROM CORE
;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
;
;This utility is for comparing records of documents from
;CORE to the records in the CHS/MIS database.
;
;Before this program is run, the records from CORE must be
;loaded into a global in the present uci.
;
;the default storage of those records is:
;
; ^TEMP("CHSCORE",docnum) = record
;
;where docnum is the document number stripped of the year/facility,
;so that doc 1-S83-00006 is listed as 6.
;
;the CORE record looks like this:
;
;patient type^doc_no^fy^can^obj_cls^cum_oblig^cum_dis^document balance
;
;At this point, the core records are going to be uniform in fiscal
;year; that is, they will send only one fiscal year at a time. For
;that reason, this program will only work on one year at a time.
;
;the way this program works:
;
;GET the facility number
;IF there is more than one facility number, then
; ask which one
;ASK for the fiscal year
;
;FOR each document of that year in the B xref
; IF the document is listed in the core records, THEN
; SEE if the CAN number matchs
; SEE if the OCC matches
; GET the document status
; FOR each transaction on the document
; draw out the trans type and amount
; Record the total amount for each trans type
; Calculate and record the balance
; calculate and record the difference between the -
; - core balance and our balance
;
;record number of documents examined and number reported on
;
D INIT
S FAC=$O(^ACHSF("B",""))
I $O(^ACHSF("B",FAC))'="" D GETFAC I 'OK Q
;
D GETFY I 'OK Q
;
S DOCXREF=1_FY F S DOCXREF=$O(^ACHSF(FAC,"D","B",DOCXREF)) Q:DOCXREF="" Q:$E(DOCXREF,2)'=FY D
. S SEQ=$O(^ACHSF(FAC,"D","B",DOCXREF,"")) I SEQ="" Q
. S DOCDAT=$G(^ACHSF(FAC,"D",SEQ,0)) I DOCDAT="" Q
. S NUMDEX=NUMDEX+1,ERR="" I NUMDEX#100=0 W " ."
. S DOCN=+$P(DOCDAT,U,1)
. I $P(DOCDAT,U,14)'=FY Q
. ;I '$D(^TEMP("CHSCORE",DOCN)) Q
. ;S COREDAT=$G(^TEMP("CHSCORE",DOCN))
. ;for testing
. S COREDAT="1^2^3^4^5^6^7^8^9^10^11^12^13^14^15"
. ;
. S NUMDMA=NUMDMA+1
. ;
. S STAT=$P(DOCDAT,U,12)
. S OCC=$P(DOCDAT,U,10),OCC=$P($G(^ACHSOCC(OCC,0)),U,1)
. I OCC'=$P(COREDAT,U,5) S ERR=ERR_BASH_"OCC MISMTC"
. ;
. S CAN=$P(DOCDAT,U,6),CAN=$P($G(^ACHS(2,CAN,0)),U,1)
. I CAN'=$P(COREDAT,U,4) S ERR=ERR_BASH_"CAN MISMTC"
. ;
. ; for each transaction...
. F TRANTYP="I","S","ZA","C","P","IP" S @TRANTYP=""
. S TNUM=0 F S TNUM=$O(^ACHSF(FAC,"D",SEQ,"T",TNUM)) Q:TNUM="" D
.. S TRANSDAT=$G(^ACHSF(FAC,"D",SEQ,"T",TNUM,0)) I TRANSDAT="" S ERR=ERR_BASH_"BAD TRANS" Q
.. ;
.. S TYPE=$P(TRANSDAT,U,2),AMT=+$P(TRANSDAT,U,4)
.. I TYPE="" S ERR=ERR_BASH_"BAD TRANS" Q
.. S @TRANTYP=@TRANTYP+AMT
.. Q
. ;
. S ^TEMP("CHSCORE2",DOCN)=COREDAT
. S ^TEMP("CHSCORE2",DOCN)=$G(^TEMP("CHSCORE2",DOCN))_U_STAT_U_($L(ERR,BASH)-1)_U_$P(ERR,BASH,2,9999)
. F TRANTYP="I","S","ZA","C","IP","P" S ^TEMP("CHSCORE2",DOCN)=$G(^TEMP("CHSCORE2",DOCN))_U_@TRANTYP
. S TOTAL=I+S-ZA-C-IP-P
. S ^TEMP("CHSCORE2",DOCN)=$G(^TEMP("CHSCORE2",DOCN))_U_TOTAL
. Q
;
Q
;
INIT ;
S U="^",BASH="\"
;number of docs examined and number of docs matched
S (NUMDEX,NUMDMA)=0
Q
;
GETFAC ;
S OK=0
W !!,"Enter the facility number to use: "
R R:300
I R=""!(R="^") Q
I R="?" D G GETFAC
. W ! S R="" F S R=$O(^ACHSF("B",R)) Q:R="" W !,?5,R
I '$D(^ACHSF("B",R)) W "Facility not on record" G GETFAC
S FAC=R,OK=1
Q
;
GETFY ;
S OK=0
W !!,"Enter the fiscal year single digit: "
R R:300
I R=""!(R="^") Q
S FY=R,OK=1
Q
ACHSYCOR ; IHS/ITSC/PMF - COMPARE RECORDS TO RECORDS FROM CORE
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
+2 ;
+3 ;This utility is for comparing records of documents from
+4 ;CORE to the records in the CHS/MIS database.
+5 ;
+6 ;Before this program is run, the records from CORE must be
+7 ;loaded into a global in the present uci.
+8 ;
+9 ;the default storage of those records is:
+10 ;
+11 ; ^TEMP("CHSCORE",docnum) = record
+12 ;
+13 ;where docnum is the document number stripped of the year/facility,
+14 ;so that doc 1-S83-00006 is listed as 6.
+15 ;
+16 ;the CORE record looks like this:
+17 ;
+18 ;patient type^doc_no^fy^can^obj_cls^cum_oblig^cum_dis^document balance
+19 ;
+20 ;At this point, the core records are going to be uniform in fiscal
+21 ;year; that is, they will send only one fiscal year at a time. For
+22 ;that reason, this program will only work on one year at a time.
+23 ;
+24 ;the way this program works:
+25 ;
+26 ;GET the facility number
+27 ;IF there is more than one facility number, then
+28 ; ask which one
+29 ;ASK for the fiscal year
+30 ;
+31 ;FOR each document of that year in the B xref
+32 ; IF the document is listed in the core records, THEN
+33 ; SEE if the CAN number matchs
+34 ; SEE if the OCC matches
+35 ; GET the document status
+36 ; FOR each transaction on the document
+37 ; draw out the trans type and amount
+38 ; Record the total amount for each trans type
+39 ; Calculate and record the balance
+40 ; calculate and record the difference between the -
+41 ; - core balance and our balance
+42 ;
+43 ;record number of documents examined and number reported on
+44 ;
+45 DO INIT
+46 SET FAC=$ORDER(^ACHSF("B",""))
+47 IF $ORDER(^ACHSF("B",FAC))'=""
DO GETFAC
IF 'OK
QUIT
+48 ;
+49 DO GETFY
IF 'OK
QUIT
+50 ;
+51 SET DOCXREF=1_FY
FOR
SET DOCXREF=$ORDER(^ACHSF(FAC,"D","B",DOCXREF))
IF DOCXREF=""
QUIT
IF $EXTRACT(DOCXREF,2)'=FY
QUIT
Begin DoDot:1
+52 SET SEQ=$ORDER(^ACHSF(FAC,"D","B",DOCXREF,""))
IF SEQ=""
QUIT
+53 SET DOCDAT=$GET(^ACHSF(FAC,"D",SEQ,0))
IF DOCDAT=""
QUIT
+54 SET NUMDEX=NUMDEX+1
SET ERR=""
IF NUMDEX#100=0
WRITE " ."
+55 SET DOCN=+$PIECE(DOCDAT,U,1)
+56 IF $PIECE(DOCDAT,U,14)'=FY
QUIT
+57 ;I '$D(^TEMP("CHSCORE",DOCN)) Q
+58 ;S COREDAT=$G(^TEMP("CHSCORE",DOCN))
+59 ;for testing
+60 SET COREDAT="1^2^3^4^5^6^7^8^9^10^11^12^13^14^15"
+61 ;
+62 SET NUMDMA=NUMDMA+1
+63 ;
+64 SET STAT=$PIECE(DOCDAT,U,12)
+65 SET OCC=$PIECE(DOCDAT,U,10)
SET OCC=$PIECE($GET(^ACHSOCC(OCC,0)),U,1)
+66 IF OCC'=$PIECE(COREDAT,U,5)
SET ERR=ERR_BASH_"OCC MISMTC"
+67 ;
+68 SET CAN=$PIECE(DOCDAT,U,6)
SET CAN=$PIECE($GET(^ACHS(2,CAN,0)),U,1)
+69 IF CAN'=$PIECE(COREDAT,U,4)
SET ERR=ERR_BASH_"CAN MISMTC"
+70 ;
+71 ; for each transaction...
+72 FOR TRANTYP="I","S","ZA","C","P","IP"
SET @TRANTYP=""
+73 SET TNUM=0
FOR
SET TNUM=$ORDER(^ACHSF(FAC,"D",SEQ,"T",TNUM))
IF TNUM=""
QUIT
Begin DoDot:2
+74 SET TRANSDAT=$GET(^ACHSF(FAC,"D",SEQ,"T",TNUM,0))
IF TRANSDAT=""
SET ERR=ERR_BASH_"BAD TRANS"
QUIT
+75 ;
+76 SET TYPE=$PIECE(TRANSDAT,U,2)
SET AMT=+$PIECE(TRANSDAT,U,4)
+77 IF TYPE=""
SET ERR=ERR_BASH_"BAD TRANS"
QUIT
+78 SET @TRANTYP=@TRANTYP+AMT
+79 QUIT
End DoDot:2
+80 ;
+81 SET ^TEMP("CHSCORE2",DOCN)=COREDAT
+82 SET ^TEMP("CHSCORE2",DOCN)=$GET(^TEMP("CHSCORE2",DOCN))_U_STAT_U_($LENGTH(ERR,BASH)-1)_U_$PIECE(ERR,BASH,2,9999)
+83 FOR TRANTYP="I","S","ZA","C","IP","P"
SET ^TEMP("CHSCORE2",DOCN)=$GET(^TEMP("CHSCORE2",DOCN))_U_@TRANTYP
+84 SET TOTAL=I+S-ZA-C-IP-P
+85 SET ^TEMP("CHSCORE2",DOCN)=$GET(^TEMP("CHSCORE2",DOCN))_U_TOTAL
+86 QUIT
End DoDot:1
+87 ;
+88 QUIT
+89 ;
INIT ;
+1 SET U="^"
SET BASH="\"
+2 ;number of docs examined and number of docs matched
+3 SET (NUMDEX,NUMDMA)=0
+4 QUIT
+5 ;
GETFAC ;
+1 SET OK=0
+2 WRITE !!,"Enter the facility number to use: "
+3 READ R:300
+4 IF R=""!(R="^")
QUIT
+5 IF R="?"
Begin DoDot:1
+6 WRITE !
SET R=""
FOR
SET R=$ORDER(^ACHSF("B",R))
IF R=""
QUIT
WRITE !,?5,R
End DoDot:1
GOTO GETFAC
+7 IF '$DATA(^ACHSF("B",R))
WRITE "Facility not on record"
GOTO GETFAC
+8 SET FAC=R
SET OK=1
+9 QUIT
+10 ;
GETFY ;
+1 SET OK=0
+2 WRITE !!,"Enter the fiscal year single digit: "
+3 READ R:300
+4 IF R=""!(R="^")
QUIT
+5 SET FY=R
SET OK=1
+6 QUIT
