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

ACHSPCC2.m

Go to the documentation of this file. 
  1. ACHSPCC2 ; IHS/ITSC/PMF - CHS AREA SPLITOUT (2/5)(DHR) ;JUL 10, 2008
  1.  ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**5,14**;JUN 11,2001
  1.  ;IHS/SET/GTH ACHS*3.1*5 12/06/2002 - Remove direct ref to non-package global.
  1.  ;3.1*14 11.7.2007 IHS/OIT/FCJ Changed total display no longer using DHR's
  1.  S (ACHSFAC,ACHSRR,ACHSHASH,ACHSCT2)=0
  1.  K ACHSFTOT,ACHSFCT,AFSJFLG
  1.  U IO(0)
  1.  W !?10,"GENERATING DHR RECORDS FOR HAS ",!!
  1.  D WAIT^DICD
  1.  W:$E(IOST)="P" !
  1.  S (ACHSCT1,X)=$S($D(^ACHSPCC("COUNT")):^("COUNT"),1:100)
  1.  I X'=100 S ACHSCT1=$S(X>9999:100,X>8888:90,X>6666:80,X>4444:70,X>2222:50,X>500:30,1:5)
  1. L1 ; Process a Facility.
  1.  S ACHSFAC=$O(^ACHSPCC(ACHSFAC))
  1.  G LEND:+ACHSFAC=0!(ACHSFAC>999999)
  1.  S (ACHSFTOT(ACHSFAC),ACHSFCT(ACHSFAC))=0
  1. L2 ; Process DHRs for a Facility.
  1.  S ACHSRR=$O(^ACHSPCC(ACHSFAC,ACHSRR))
  1.  G L1:ACHSRR=""
  1.  I ACHSRR#2=0 G L3
  1.  S ACHSDES1=$E(^ACHSPCC(ACHSFAC,ACHSRR),8,12)
  1.  S ACHSZDOC=$E(^ACHSPCC(ACHSFAC,ACHSRR),13,25)
  1.  S ACHSCT2=ACHSCT2+1
  1.  I ACHSCT2#ACHSCT1=0 U IO(0) W $J(ACHSCT2,8)
  1. L3 ; Check for CANCELLED documents and add up totals.
  1.  S X=$G(^ACHSPCC(ACHSFAC,ACHSRR))
  1.  I $E(X)'=2 G L5
  1.  S X1=$E(X,8,80),X="2"_ACHSEFDT_X1,^ACHSPCC(ACHSFAC,ACHSRR)=X
  1.  ; FY/CORE/HAS -- CANCELATION TRANSLATION LOGIC
  1.  S (ACHSHLD1,ACHSHLD2)="" ; START WITH A CLEAN STATE
  1.  I $$AOP^ACHS(2,2)="CORE" G L9 ; DON'T X-LATE CANCELATIONS
  1.  S ACHSHLD1=X ; WE ARE NOT SURE OF A TRANSLATION YET
  1.  I ACHSDES1="05024" S X=$E(X,1,7)_"19"_$S($E(X,48,51)="2185":"2",1:"1")_"14"_ACHSZDOC_ACHSZDOC_$E(X,39,51)_"000000000000"_$E(X,64,80),^ACHSPCC(ACHSFAC,ACHSRR)=X
  1.  G L9
  1.  ;
  1. L5 ; Set the 2nd half of the DHR, if Doc was canceled.
  1.  I ACHSHLD1="" G L9 ; WE ARE NOT TRANSLATING
  1.  S ACHS2FY=$E(X,54,55) ; GET THE FISCAL YEAR CORE USES
  1.  I ACHS2FY<72!(ACHS2FY>98) D  G L9 ; UNDO THE TRANSLATION
  1.  . S ACHSHLD2=$O(^ACHSPCC(ACHSFAC,ACHSRR),-1) ; BACKUP
  1.  . S ^ACHSPCC(ACHSFAC,ACHSHLD2)=ACHSHLD1 ; RESET TO ORIGINAL STATE
  1.  I ACHSDES1="05024" S X=$E(X,1,14)_"50XXXX"_$E(X,21,39)_"*10000"_$E(X,46,80),^ACHSPCC(ACHSFAC,ACHSRR)=X
  1. L9 ;
  1.  I $E(X)=2 S ACHSHASH=ACHSHASH+$E(X,52,63),ACHSFTOT(ACHSFAC)=ACHSFTOT(ACHSFAC)+$E(X,52,63),ACHSFCT(ACHSFAC)=ACHSFCT(ACHSFAC)+1
  1.  G L2
  1.  ;
  1. LEND ;
  1.  U IO(0)
  1.  W !!,"TOTAL DHR RECORDS GENERATED = ",ACHSCT2,!
  1.  D RTRN^ACHS,HDR1
  1.  S ACHSHASH=$E(ACHSHASH+1000000000000,2,13),ACHSCT2=$E(ACHSCT2+10000,2,5)
  1.  K ACHSDES1,ACHSZDOC
  1.  S ACHSFAC=""
  1.  F  S ACHSFAC=$O(ACHSFTOT(ACHSFAC)) Q:ACHSFAC=""  D
  1.  . S X=ACHSFTOT(ACHSFAC)/100,X2=2,X3=16
  1.  . D COMMA^%DTC
  1.  . W ?10,$E($P(^DIC(4,$O(^AUTTLOC("C",ACHSFAC,0)),0),U),1,30),?46,$J(ACHSFCT(ACHSFAC),5),?55,X,!!
  1.  . I $Y>(IOSL-6) D RTRN^ACHS,HDR1
  1.  .Q
  1.  W ?10,$E(Y,1,60)
  1.  S X=+ACHSHASH/100,X2="2$",X3=16
  1.  D COMMA^%DTC
  1.  W !!?15,"TOTAL CHS TRANSACTIONS",?51-$L($J(ACHSCT2,0,0)),$J(ACHSCT2,0,0),?55,X,!!?10,"NUMBER OF OUTPUT DHR RECORDS = ",?46,$J((ACHSCT2+2)*2,5)
  1.  S ACHSJCLC=8
  1.  W !!?10,"NUMBER OF JCL RECORDS = ",?46,$J(ACHSJCLC,5),!!?10,$E(Y,1,41)
  1.  S ACHSTXCT=((ACHSCT2+2)*2)+ACHSJCLC
  1.  W !?15,"TOTAL RECORDS TO TRANSMIT = ",?46,$J(ACHSTXCT,5),!!
  1.  D RTRN^ACHS
  1.  W @IOF
  1.  ;I $P($G(^AFSHPARM(DUZ(2),0)),U,5)["N" D ^%ZISC I 1 ; Allow posting of DHR Date to 1166;IHS/SET/GTH ACHS*3.1*5 12/06/2002
  1.  I $$GET1^DIQ(9002322.3,DUZ(2),1.03)["N" D ^%ZISC I 1 ; Allow posting of DHR Date to 1166 ;IHS/SET/GTH ACHS*3.1*5 12/06/2002
  1.  E  S ACHSPTRD=IO ; Allow 1166 posting.
  1.  D HOME^%ZIS
  1.  K ACHSFTOT
  1.  Q
  1.  ;
  1. HDR1 ;
  1.  U IO
  1.  S (X,Y)="",$P(X,"*",71)="",$P(Y,"-",69)=""
  1.  W @IOF,!?5,X,!?5,"*",?10,"C H S  DATA  SPLIT-OUT (EXPORT)  FOR: ",$E($$LOC^ACHS,1,25),?74,"*",!?5,"*",?5,$E(DT,4,5),"-",$E(DT,6,7),"-",$E(DT,2,3),?22,"TRANSACTION  TOTALS  BY  FACILITY",?74,"*",!
  1.  ;ACHS*3.1*14 11.7.2007 IHS/OIT/FCJ DISPLAY IS NOT TOTAL OF BC RECORDS BUT OF THE DHR TOTALS SO REMOVED FROM NEXT LINE
  1.  ;W ?5,"*",Y,"*",!?5,"*"," THE DESTINATION OF THESE DATA RECORDS IS: ",$S('($$AOP^ACHS(2,8)="Y"):"PARKLAWN COMPUTER CENTER",$$AOP^ACHS(2,8)="Y":"BLUE CROSS/SHIELD OF NM",1:" "),?74,"*",!
  1.  W ?5,"*",Y,"*",!?5,"*"," THE DESTINATION OF THESE DATA RECORDS IS: ",$S('($$AOP^ACHS(2,8)="Y"):"PARKLAWN COMPUTER CENTER",$$AOP^ACHS(2,8)="Y":"DHR DATA",1:" "),?74,"*",!
  1.  W ?5,"*",Y,"*",!?5,"*",?10,"NAME OF FACILITY",?44,"NUMB TRNS",?60,"DOLLAR AMT",?74,"*",!?5,X,!!
  1.  Q
  1.  ;