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

ACHSTX7X.m

Go to the documentation of this file. 
  1. ACHSTX7X ; IHS/ITSC/TPF/PMF - CHS TRIBAL STATISTICAL EXPORT ERROR REPORT ; 
  1.  ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**22,23**;JUN 11, 2001;Build 43
  1.  ;
  1.  ; Produces report for incomplete data items for Statisitcal (638)
  1.  ; records to be sent to DDPS.
  1.  ;
  1.  ; Sites can use the "Enter/Edit Medical Data" to fill in any
  1.  ; missing ICD9 or APC codes, and the Vendor edit option to
  1.  ; fill in an EIN or Vendor Type.  Bad Admit/Discharge dates are
  1.  ; rare and will have to be fixed w/FM.
  1.  ;
  1.  ;  THANKS TO FONDA JACKSON OF PORTLAND FOR THE ORIGINAL ROUTINE.
  1.  ;
  1.  I $$PARM^ACHS(0,8)'="Y" W !,"Your site is not a 638 facility." D RTRN^ACHS Q
  1.  ;
  1. DEV ;
  1.  S %ZIS="MQP"
  1.  D ^%ZIS
  1.  G:POP CLOSE
  1.  G:'$D(IO("Q")) START
  1.  S ZTRTN="START^ACHSTX7X",ZTDESC=$$DESC
  1.  D ^%ZTLOAD,HOME^%ZIS
  1.  G CLOSE
  1.  ;
  1. START ;EP - From TaskMan.
  1.  K ^TMP("ACHSTX7X",$J)
  1.  N ACHSBDTS,ACHSEIN,ACHSFC,ACHSFYDT
  1.  D SETUP
  1.  D CALC
  1.  D PRINT
  1.  D CLOSE
  1.  Q
  1.  ;
  1. SETUP ; -----  Set vars.  --------------------------------------------------
  1.  D FY^ACHSUF,FC^ACHSUF
  1.  S (ACHSDCR,ACHSBDT)=0,ACHSEDT=DT
  1.  S X=$O(^ACHS(9,DUZ(2),"FY",ACHSCFY,"AR",0))
  1.  I X?7N D
  1.  . S ACHSDCR=$O(^ACHS(9,DUZ(2),"FY",ACHSCFY,"AR",X,ACHSDCR))
  1.  . S ACHSEDT=$P(^ACHS(9,DUZ(2),"FY",ACHSCFY,"W",ACHSDCR,0),U,2)
  1.  . S ACHSBDT=$P($G(^ACHS(9,DUZ(2),"FY",ACHSCFY,"W",ACHSDCR-1,0)),U,2)
  1.  . I ACHSBDT'?7N S ACHSBDT=ACHSFYDT-10000
  1.  .Q
  1.  I ACHSDCR=0 S ACHSBDT=ACHSFYDT-10000
  1.  S ACHSBDTS=ACHSBDT
  1.  Q
  1.  ;
  1. CALC ; -----  Check for documents with incomplete data items.  ------------
  1.  F  S ACHSBDT=$O(^ACHSF(DUZ(2),"TB",ACHSBDT)) Q:(ACHSBDT>ACHSEDT)!(ACHSBDT'?7N)  D
  1.  . Q:'$D(^ACHSF(DUZ(2),"TB",ACHSBDT,"P"))
  1.  . S ACHSDIEN=0
  1.  . F  S ACHSDIEN=$O(^ACHSF(DUZ(2),"TB",ACHSBDT,"P",ACHSDIEN)) Q:ACHSDIEN'?1N.N  D
  1.  .. Q:$P(^ACHSF(DUZ(2),"D",ACHSDIEN,0),U,3)
  1.  .. S ACHSTIEN=$O(^ACHSF(DUZ(2),"TB",ACHSBDT,"P",ACHSDIEN,0))
  1.  .. S ACHSDOCR=^ACHSF(DUZ(2),"D",ACHSDIEN,0),ACHSTOS=$P(ACHSDOCR,U,4)
  1.  .. D CHK
  1.  ..Q
  1.  .Q
  1.  Q
  1.  ;
  1. CHK ; --- Text at CHK_ labels are used in report.     
  1.  F %=1:1:4 S ACHSERR(%)=0
  1.  S ACHSTST=0
  1. CHK1 ;ERROR IN ICD-9 CODE; Error 1.
  1.  G:($$PARM^ACHS(0,18)-1)<$P(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",ACHSTIEN,0),U,10) CHK2   ;ACHS*3.1*23 ONLY TST ICD9 TYPE
  1.  D DXPX^ACHSTX7A
  1.  ;I ACHSTOS=1,+ACHSDX(1)<1 S ACHSERR(1)=1,ACHSTST=1 G CHK2
  1.  I ACHSTOS=1,'(+ACHSDX(1)>0),"EV"'[$E(ACHSDX(1)) S ACHSERR(1)=1,ACHSTST=1 G CHK2
  1.  I ACHSTOS=2 G CHK2
  1.  I ACHSTOS=3,+ACHSAPC(1)<1 S ACHSERR(1)=1,ACHSTST=1
  1. CHK2 ;INVALID EIN; Error 2.
  1.  I '$P(ACHSDOCR,U,8) S ACHSERR(2)=1,ACHSTST=1,ACHSEIN="" G CHK4
  1.  S (ACHSEIN,X)=$P($G(^AUTTVNDR($P(ACHSDOCR,U,8),11)),U)
  1.  X $P(^DD(9999999.11,1101,0),U,5,99)
  1.  I '$D(X) S ACHSERR(2)=1,ACHSTST=1 G CHK3
  1.  I "12"'[$E(X) S ACHSERR(2)=1,ACHSTST=1
  1. CHK3 ;INVALID PROVIDER TYPE; Error 3.
  1.  S X=$P($G(^AUTTVNDR($P(ACHSDOCR,U,8),11)),U,3)
  1.  I X<1 S ACHSERR(3)=1,ACHSTST=1
  1.  I X,'$D(^AUTTVTYP(X,0)) S ACHSERR(3)=1,ACHSTST=1
  1. CHK4 ;INVALID ADMISSION/DISCHARGE DATE; Error 4.
  1.  I ACHSTOS=1 D
  1.  . S X=$P($G(^ACHSF(DUZ(2),"D",ACHSDIEN,8)),U,2)
  1.  . S Y=$P($G(^ACHSF(DUZ(2),"D",ACHSDIEN,8)),U,3)
  1.  . ;ACHS*3.1*22 IHS.OIT.FCJ MODIFIED TO TEST ADM DT > DISCHARGE DT
  1.  . ;S:(Y>ACHSBDT)!(Y>ACHSEDT)!(X>ACHSEDT)!(X'?7N)!(Y'?7N) ACHSERR(4)=1,ACHSTST=1
  1.  .S:(Y<X)!(X'?7N)!(Y'?7N)!($P(^ACHSF(DUZ(2),"D",ACHSDIEN,3),U)>Y)!(X<$P(^ACHSF(DUZ(2),"D",ACHSDIEN,3),U)) ACHSERR(4)=1,ACHSTST=1
  1.  .Q
  1. CHKEND ; -----  Set TMP Global with document Errors.
  1.  Q:ACHSTST=0
  1.  S ^TMP("ACHSTX7X",$J,ACHSTOS,ACHSDIEN)=$P(ACHSDOCR,U,14)_"-"_ACHSFC_"-"_$P(ACHSDOCR,U)
  1.  F %=1:1:4 S $P(^TMP("ACHSTX7X",$J,ACHSTOS,ACHSDIEN),U,%+1)=ACHSERR(%)
  1.  S $P(^TMP("ACHSTX7X",$J,ACHSTOS,ACHSDIEN),U,6)=ACHSEIN
  1.  Q
  1.  ;
  1. CLOSE ; -----  Close device, kill vars, quit.  -----------------------------
  1.  D ^%ZISC
  1.  K ACHSTOS,ACHSDX,ACHSAPC,ACHSERR,ACHSTST,ACHSDOCR,ACHSDIEN,ACHSTIEN,ACHSPX,ACHSCFY,ACHSX,ACHSY,ACHSPG,R,ACHSBDT,ACHSDCR,ACHS,ACHSEDT,^TMP("ACHSTX7X",$J)
  1.  Q
  1.  ;
  1. PRINT ; -----  Print Errors.  ----------------------------------------------
  1.  U IO
  1.  S ACHSPG=0
  1.  D PHDR
  1.  S (ACHSTOS(1),ACHSTOS(2),ACHSTOS(3))=0
  1.  I $D(^TMP("ACHSTX7X",$J)) D
  1.  . F ACHSTOS=1,2,3 S ACHSDIEN=0 F  S ACHSDIEN=$O(^TMP("ACHSTX7X",$J,ACHSTOS,ACHSDIEN)) Q:ACHSDIEN'?1N.N  D  Q:$D(DUOUT)
  1.  .. S ACHSTOS(ACHSTOS)=ACHSTOS(ACHSTOS)+1
  1.  .. I $Y>(IOSL-5) D RTRN^ACHS Q:$D(DUOUT)  D PHDR
  1.  .. W !?7,$P(^TMP("ACHSTX7X",$J,ACHSTOS,ACHSDIEN),U)
  1.  .. F %=1:1:4  I $P(^TMP("ACHSTX7X",$J,ACHSTOS,ACHSDIEN),U,%+1)=1 W ?45,$P($T(@("CHK"_%)),";",2) W:%=2 " ",$P(^TMP("ACHSTX7X",$J,ACHSTOS,ACHSDIEN),U,6) W !
  1.  ..Q
  1.  .Q
  1.  Q:$D(DUOUT)
  1.  I $Y>(IOSL-8) D RTRN^ACHS Q:$D(DUOUT)  D PHDR
  1.  W !!,"  TOTAL HOSPITAL DOCUMENTS WITH ERRORS = ",$J($FN(ACHSTOS(1),","),6)
  1.  W !!,"    TOTAL DENTAL DOCUMENTS WITH ERRORS = ",$J($FN(ACHSTOS(2),","),6)
  1.  W !!,"TOTAL OUTPATIENT DOCUMENTS WITH ERRORS = ",$J($FN(ACHSTOS(3),","),6),!
  1.  D RTRN^ACHS
  1.  Q
  1.  ;
  1. PHDR ; -----  Header for Report.
  1.  S ACHSPG=ACHSPG+1
  1.  W @IOF,!,$$LOC^ACHS,?70,"Page ",ACHSPG
  1.  W !,$$REPEAT^XLFSTR("-",80),!,$$C^XBFUNC($$DESC,80)
  1.  W !,$$C^XBFUNC("From Transaction Date "_$$FMTE^XLFDT(ACHSBDTS)_" to "_$$FMTE^XLFDT(ACHSEDT),80)
  1.  W !,$$REPEAT^XLFSTR("-",80)
  1.  W !!?5,"DOCUMENT NUMBER",?45,"TYPE OF ERROR",!?5,$$REPEAT^XLFSTR("-",15),?45,$$REPEAT^XLFSTR("-",13),!
  1.  Q
  1.  ;
  1. DESC() ;
  1.  Q $P($P($P($T(ACHSTX7X),";",2),"-",2)," ",2,7)
  1.  ;
  1. HELP ;EP - From DIR.
  1.  W !,$$C^XBFUNC($$DESC),!
  1.  F %=3:1 W !?5,$P($T(HELP+%),";",3) Q:$P($T(HELP+%+1),";",3)=""
  1.  ;;This report will examine data in documents produced since your last
  1.  ;;export, and produce a report listing any documents with missing or
  1.  ;;invalid data, that is required by the Data center in Albuquerque.
  1.  ;;  
  1.  ;;Checks include checking for valid ICD-9 codes, EIN vendor number,
  1.  ;;Provider Type, and valid Admit/Discharge dates.
  1.  Q
  1.  ;