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

ACHSACO1.m

Go to the documentation of this file. 
  1. ACHSACO1 ; IHS/ITSC/TPF/PMF - AREA CONSOLIDATION (2/3) ;
  1.  ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**13,23**;JUN 11,2001;Build 43
  1.  ;ACHS*3.1*13 6.14.2007 IHS/OIT/FCJ ADDED UFMS REC TO REC SUB, REC COUNTER AND TOT
  1.  ;
  1. A1 ; Initialize counters, main process loop.
  1.  ;ACHS*3.1*13 IHS/OIT/FCJ ADD UFMS COUNTER IN 2 LINES NXT LINE;ACHS*3.1*23 ADD STAT ICD10 COUNTER
  1.  S ACHSCT=+^ACHSPCC("COUNT"),(ACHSCTV,ACHSCTFI,ACHSCTFS,ACHSCTPG,ACHSCTP2,ACHSCTPD,ACHSCTUF)=0
  1.  F ACHS=2:1:7,"U" S ACHSTOTL(ACHS)=0
  1.  S ACHSCTFI=$G(^ACHSZOCT("BCBS"))
  1.  S ACHSCTPD=$G(^ACHSZOCT("AOPD"))
  1.  S ACHSCTV=+$P($G(^ACHSAOVU(0)),U)
  1.  S ACHSCTPG=$G(^ACHSZOCT("PIG"))
  1.  S ACHSCTPG=$G(^ACHSPIG(0,0))
  1.  S ACHSCTP2=$G(^ACHSPG2(0,0))  ;ACHS*3.1*23
  1.  S ACHSCCOR=$G(^ACHSCORE("COUNT"))
  1.  S ACHSCTUF=$G(^ACHSUFMS("COUNT"))  ;ACHS*3.1*13 6.14.2007 IHS/OIT/FCJ ADDED COUNTER FOR UFMS REC
  1.  S ACHSCTUA=$G(^ACHSUFMS(0))  ;ACHS*3.1*13 6.14.2007 IHS/OIT/FCJ ADDED COUNTER FOR UFMS $
  1.  S ACHSCCOR("P")=$$AOP^ACHS(2,2)
  1.  U IO(0)
  1.  ;
  1.  W !,"Transferring ",$P(ACHSXD2,U,7)," CHS Data Records..."
  1.  W !,"From ",$P($P(IOPAR,":"),"(",2),!!
  1.  S DX=$X,DY=$Y
  1.  S ACHSCTVS=ACHSCTV+1
  1.  ;
  1.  ;adding new var TCOUNT for transaction count.  1/4/01  pmf
  1.  ;F  D  Q:$E(X)="*"
  1.  F TCOUNT=1:1 D  Q:$E(X)="*"
  1.  .U IO
  1.  .R X:300
  1.  .Q:$E(X)="*"                   ;REACHED EOF MARK -GOOD FILE
  1.  .R ACHSX2:300
  1.  .;I '($E(ACHSX2)) Q             ;ACHS*3.1*13 IHS/OIT/FCJ COMMENTED OUT TO READ "U" TYPE REC
  1.  .D T
  1.  .S X=+$P($P(X,"(",2),")")      ;
  1.  .;
  1.  .;the next couple of lines is supposed to tell them when
  1.  .;every 10 records have been transferred, with a little
  1.  .;fancy video stuff.  however, the value of X may not be
  1.  .;what we need it to be, and the IOXY execution is not
  1.  .;working at all, so I'm replacing it.
  1.  .;keep these comments until the end of beta testing, just
  1.  .;so we keep track of what's going on.  1/4/01  pmf
  1.  .;I '(X#10) U IO(0) W X X IOXY
  1.  .I TCOUNT#10=0 U IO(0) W TCOUNT,"   "
  1.  ;
  1.  ;REACHED END OF FILE WITH NO BAD RECORDS
  1.  D END^ACHSACO2
  1.  Q
  1.  ;
  1.  ;
  1. T ;
  1.  ;S ACHSRTYP=+$E(ACHSX2)                           ;RECORD TYPE
  1.  S ACHSRTYP=$E(ACHSX2)                           ;RECORD TYPE ACHS*3.1*13 IHS/OIT/FCJ Removed "+" TO READ "U" TYPE REC
  1.  S ACHSTOTL(ACHSRTYP)=ACHSTOTL(ACHSRTYP)+1        ;COUNT OF RECORD TYPES
  1.  S:'$D(ACHSZFAC(ACHSFCPT)) ACHSZFAC(ACHSFCPT)=0          ;FACILITY COUNT
  1.  S $P(ACHSZFAC(ACHSFCPT),U)=$P(ACHSZFAC(ACHSFCPT),U)+1
  1.  ;
  1.  ;
  1.  D T2:ACHSRTYP=2          ;FACILITY GENERATED DHR RECORD
  1.                           ;INCLUDES 638 DENTAL RECORD FOR NPIRS
  1.                           ; BEGINNING WITH '25'
  1.                           ;
  1.  D T3:ACHSRTYP=3          ;PATIENT RECORD. INCLUDES 3A, 3B
  1.                           ;AND 3C THIRD PARTY COVERAGE
  1.                                  ; 
  1.  D T4:ACHSRTYP=4          ;VENDOR RECORD. INCLUDES 4A AND 4B
  1.                           ;
  1.  D T5:ACHSRTYP=5          ;DOCUMENT (PURCHASE ORDER) RECORD
  1.                           ;INCLUDES 5A AND 5B
  1.                           ;
  1.  D T6:ACHSRTYP=6          ;PAYMENT RECORD FOR AREA OFFICE
  1.                           ;INCLUDES 6A AND 6B
  1.                           ;
  1.  D T7:ACHSRTYP=7          ;638 STATISTICAL RECORDS FOR NPIRS
  1.                           ;INCLUDES 7A AND 7B
  1.  D TU:ACHSRTYP="U"        ;UFMS RECORD ;ACHS*3.1*13 IHS/OIT/FCJ Added for UFMS REC
  1.  ;
  1.  ;ACHS*3.1*13 IHS/OIT/FCJ ADDED "U" TO NXT LINE
  1.  ;F ACHSJ=2:1:7 S:ACHSTOTL(ACHSJ)>0 ACHSZFAC(ACHSFCPT,ACHSDRUN,ACHSJ)=ACHSTOTL(ACHSJ)
  1.  F ACHSJ=2:1:7,"U" S:ACHSTOTL(ACHSJ)>0 ACHSZFAC(ACHSFCPT,ACHSDRUN,ACHSJ)=ACHSTOTL(ACHSJ)
  1.  Q
  1.  ;
  1. T2 ; FACILITY GENERATED DHR records for HAS and/or CORE.
  1.  ; For HAS
  1.  D  ; ALWAYS CREATE THE ACHSPCC GLOBAL FOR TRANSMISSION
  1.  . N ACHSSRTY
  1.  .;IF SECOND CHAR IS "B" OR "C" THEN OKAY
  1.  .;OTHERWISE SET NULL
  1.  .S ACHSSRTY=$S("BC"[$E(ACHSX2,2):$E(ACHSX2,2),1:"")
  1.  .;I HAVE SEEN THE SECOND CHAR AS A "5" AND A "0"
  1.  . I ACHSSRTY="" S ACHSHR1=ACHSX2     ;"20" ????? AND "25" DENTAL RECORDS
  1.  .;
  1.  . I ACHSSRTY="B" S ACHSHR2=ACHSX2
  1.  .;
  1.  . I ACHSSRTY="C" D
  1.  .. S ACHSCT=ACHSCT+1
  1.  .. S ^ACHSPCC(ACHSFACD,ACHSCT)=$$CORE(1)
  1.  .. S ACHSCT=ACHSCT+1
  1.  .. S ^ACHSPCC(ACHSFACD,ACHSCT)=$$CORE(2)
  1.  . S ^ACHSPCC("COUNT")=ACHSCT
  1.  ;
  1.  ; For CORE
  1.  ;I ACHSCCOR("P")'="HAS" S ACHSCCOR=ACHSCCOR+1,^ACHSCORE(ACHSFACD,ACHSCCOR)=ACHSX2,^ACHSCORE("COUNT")=ACHSCCOR
  1.  Q
  1.  ;
  1. T3 ;
  1.  ;IF WE SHOULD PROCESS FI DATA AND THERE ARE FACILITIES EXPORTING FI DATA
  1.  ;'PROCESS FI DATA'      'FACILITIES EXPORTING FI DATA'
  1.  Q:$$AOP^ACHS(2,3)'="Y"!('$D(^ACHSAOP(DUZ(2),20,ACHSFCPT)))
  1.  S ACHSCTFI=ACHSCTFI+1,^ACHSBCBS(ACHSCTFI)=ACHSX2
  1.  Q
  1.  ;
  1. T4 ;
  1.  ;CHECK TO SEE IF WE SHOULD PROCESS 3RD PARTY COVERAGE TO FI AND WHERE
  1.  ;'PROCESS FI DATA'       'FACILITIES EXPORTING FI DATA'
  1.  G T4A:$$AOP^ACHS(2,3)'="Y"!('$D(^ACHSAOP(DUZ(2),20,ACHSFCPT)))
  1.  S ACHSCTFI=ACHSCTFI+1,^ACHSBCBS(ACHSCTFI)=ACHSX2
  1. T4A ;
  1.  ;CHECK TO SEE IF WE SHOULD PROCESS AREA OFFICE DATA 
  1.  ;'PROCESS AREA OFFICE DATA'
  1.  Q:$$AOP^ACHS(2,4)'="Y"
  1.  S ACHSCTV=ACHSCTV+1,^ACHSAOVU(ACHSCTV)=ACHSX2
  1.  Q
  1.  ;
  1. T5 ;'PROCESS FI DATA'    'FACILITIES EXPORTING FI DATA'
  1.  I $$AOP^ACHS(2,3)="Y",$D(^ACHSAOP(DUZ(2),20,ACHSFCPT)) S ACHSCTFI=ACHSCTFI+1,^ACHSBCBS(ACHSCTFI)=ACHSX2
  1.  D SVRSUB:$D(^ACHSAOP(DUZ(2),21))  ;IF 'SPECIAL REPORT VENDORS'
  1.  Q
  1.  ;
  1. T6 ;'PROCESS AREA OFFICE DATA'
  1.  Q:$$AOP^ACHS(2,4)'="Y"
  1.  S ACHSCTPD=ACHSCTPD+1,^ACHSAOPD(ACHSCTPD)=ACHSX2
  1.  Q
  1.  ;
  1. T7 ; Statistical records.
  1.  ;ACHS*3.1*23 ADDED TEST FOR NEW STAT RECORD.
  1.  I ACHSSTV="CRV003" D
  1.  .S ACHSCTP2=ACHSCTP2+1
  1.  .I $E(ACHSX2,1,2)="7A" S ACHSSTYP=$E(ACHSX2,3,4)
  1.  .S ^ACHSPG2(ACHSSTYP,ACHSFACD,ACHSCTP2)=ACHSX2
  1.  E  D
  1.  .S ACHSCTPG=ACHSCTPG+1
  1.  .I $E(ACHSX2,1,2)="7A" S ACHSSTYP=$E(ACHSX2,3,4)
  1.  .S ^ACHSPIG(ACHSSTYP,ACHSFACD,ACHSCTPG)=ACHSX2
  1.  Q
  1. TU ; UFMS Record ;ACHS*3.1*13 IHS/OIT/FCJ ADDED FOR PROCESSING UFMS RECORD
  1.  Q:$E(ACHSX2,1,2)'="U2"
  1.  S ACHSCTUF=ACHSCTUF+1
  1.  S ^ACHSUFMS(ACHSCTUF)=$E(ACHSX2,2,161)
  1.  S ACHSCTUA=ACHSCTUA+$E(ACHSX2,53,64)
  1.  Q
  1.  ;
  1. SVRSUB ; Generate ^ACHSSVR global from 5A & 5B records.
  1.  G SVR5A:$E(ACHSX2,1,2)="5A",SVR5B:$E(ACHSX2,1,2)="5B"
  1.  Q
  1.  ;
  1. SVR5A ;
  1.  K ACHSX3
  1.  S DIC="^AUTTVNDR(",DIC(0)="M",D="C",X=$E(ACHSX2,22,33)
  1.  I $E(X,11,12)="  " S X=$E(X,1,10)
  1.  D ^DIC
  1.  Q:Y<1
  1.  Q:'$D(^ACHSAOP(DUZ(2),21,"B",+Y))
  1.  S ACHSX3=ACHSX2
  1.  S ACHSZFAC=$E(ACHSX2,15,20)
  1.  S ACHSEIN=$E(ACHSX2,22,33)
  1.  S:$E(ACHSEIN,11,12)="  " ACHSEIN=$E(ACHSEIN,1,10)
  1.  S ACHSCTFS=ACHSCTFS+1
  1.  S ^ACHSSVR(ACHSEIN,ACHSZFAC,ACHSCTFS)=ACHSX3
  1.  Q
  1.  ;
  1. SVR5B ;
  1.  Q:'$D(ACHSX3)
  1.  S ACHSX4=ACHSX2
  1.  S ^ACHSSVR(ACHSEIN,ACHSZFAC,ACHSCTFS)=ACHSX3_ACHSX4
  1.  Q
  1.  ;
  1. REC(X) ;EP - Return the name of the export record, 1-8.
  1.  ;CALLED BY ACHSACO2+9 AT END OF REPORT
  1.  ;ALSO CALLED BY:
  1.  ;              ACHSTX3+4,ACHSTX4+4,ACHSTX5+4,ACHSTX6+4,ACHSTX7+35
  1.  ;              ACHSTX8+6
  1.  Q:'$G(X) ""
  1.  ;ACHS*3.1*13 IHS/OIT/FCJ ADDED UFMS REC TO REC SUB
  1.  Q $P("NOT USED^DHR RECORDS FOR HAS/CORE^PATIENT RECORDS FOR AO/FI^VENDOR RECORDS FOR AO/FI^DOCUMENT RECORDS FOR AO/FI^PAYMENT RECORDS FOR AO^STATISTICAL RECORDS^UFMS RECORDS",U,X)
  1.  ;
  1.  ;BEGIN CORE MODIFICATIONS ADDITIONAL CODE
  1. CORE(R) ;PROCESS A '2B' RECORD INTO THE 80-160 '2' PART TWO RECORD
  1.  I R=1 D
  1.  . S ACHSEIN=$E(ACHSX2,3,14)
  1.  . S R=$E(ACHSHR1,1,64)_$E(ACHSEIN_$J("",15),1,15)_" "
  1.  I R=2 D
  1.  . S ACHSF12=$E(ACHSHR2,59,60)                       ;FISCAL YEAR
  1.  . S ACHSF10=$E(ACHSHR2,61,64)                       ;BEGIN DATE
  1.  . S ACHSF11=$E(ACHSHR2,65,68)                       ;END DATE
  1.  . S R=$J("",45)_ACHSF10_ACHSF11_ACHSF12_$J("",25)
  1.  . S R=$E(R,1,60)_$$REPEAT^XLFSTR("9",20)            ;REQUIRED BY HAS
  1.  Q R
  1.  ;END CORE MODIFICATIONS ADDITIONAL CODE