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

ACHSTX77.m

Go to the documentation of this file. 
  1. ACHSTX77 ;IHS/ADC/GTH - EXPORT DATA (8/9) - RECORD 7(638 STATISTICAL DATA FOR NPIRS) ; [ 12/06/2002  10:36 AM ]
  1.  ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**5**;JUN 11, 2001
  1.  ;IHS/SET/GTH ACHS*3.1*5 12/06/2002 - Remove old references to v 3 p9.
  1.  I 'ACHSF638,('ACHSF209) Q
  1.  I ACHSTY'="P" S RET=3 Q
  1.  I DESTN'="I" S RET=15 Q
  1.  I +DFN=0 S RET=19 Q
  1.  ;
  1.  I $G(^DPT(DFN,0))="" S RET=21 Q
  1.  ;
  1.  S ACHSSEX=$S($P(^DPT(DFN,0),U,2)="F":2,1:1),%=$P(^(0),U,3),ACHSDOB=17000000+%
  1.  S ACHSX=$P(ACHSDOCR,U,14)
  1.  D FYCVT^ACHSFU
  1.  ;
  1.  S ACHSAUTH=$E(ACHSY,3,4)_$E(+$P(ACHSDOCR,U)+100000,2,6)
  1. HRN ;
  1.  S ACHSHRN=$$HRN^ACHS(DFN,DUZ(2)),ACHSHRN=$E(1000000+ACHSHRN,2,7)
  1. SSN ;
  1.  S ACHSSSN=$E($$SSN^AUPNPAT(DFN)_$J("",9),1,9)
  1.  ;
  1. COMM ;
  1.  S ACHSCOMM=$J("",7)
  1.  I $P(^AUPNPAT(DFN,11),U,18)]"",$D(^AUTTCOM("B",$P(^(11),U,18))) S %=$P(^AUTTCOM($O(^AUTTCOM("B",$P(^AUPNPAT(DFN,11),U,18),0)),0),U,8),ACHSCOMM=$E(%,5,7)_$E(%,3,4)_$E(%,1,2)
  1. PTYP ;
  1.  S ACHSPTYP=$J("",2)
  1.  I $P(^AUTTVNDR($P(ACHSDOCR,U,8),11),U,3) S ACHSPTYP=$P(^AUTTVTYP($P(^(11),U,3),0),U),ACHSPTYP=$E(ACHSPTYP_"  ",1,2)
  1. EIN ;
  1.  S ACHSEIN=$E($P(^AUTTVNDR($P(ACHSDOCR,U,8),11),U)_$J("",10),1,10)
  1. IPA ;
  1.  S ACHSIPA=$J("",8)
  1.  I $D(^ACHSF(DUZ(2),"D",ACHSDIEN,"PA")) S ACHSIPA=+$P(^("PA"),U)
  1.  S ACHSIPA=$P(ACHSIPA,".")_$E($P(ACHSIPA,".",2)_"00",1,2),ACHSIPA=$E(100000000+ACHSIPA,2,9)
  1.  I TYPSER2=57 G 57
  1.  ;
  1.  S ACHSFULP=$S($P(ACHSTRAN,U,5)="P":2,1:1)
  1.  ;
  1.  S ACHSDATA=ACHSAUTH_ACHSHRN_ACHSSSN_ACHSDOB_ACHSSEX_TRIBE_"   "_ACHSCOMM_ACHSAFAC_ACHSPTYP_ACHSEIN
  1.  D DXPX^ACHSTX7A
  1.  G @TYPSER2
  1.  ;
  1. 43 ; 
  1.  S ACHSADDT=$J("",6)
  1.  I $P($G(^ACHSF(DUZ(2),"D",ACHSDIEN,8)),U,2) S %=$P(^(8),U,2),ACHSADDT=17000000+%
  1.  I +ACHSADDT<1 Q
  1.  S ACHSDIDT=$J("",6)
  1.  I $P($G(^ACHSF(DUZ(2),"D",ACHSDIEN,8)),U,3) S %=$P(^(8),U,3),ACHSDIDT=17000000+%
  1.  ;
  1.  S DA(1)=DUZ(2),DA=ACHSDIEN
  1.  S ACHSLOS=$E(1000+$$VAL^XBDIQ1(9002080.01,.DA,93),2,4)
  1.  ;
  1.  S ACHSDITY=$S($P($G(^ACHSF(DUZ(2),"D",ACHSDIEN,8)),U,4):$P(^(8),U,4),1:1),ACHSDITY=$S($D(^DIC(42.2,ACHSDITY,9999999)):$P(^(9999999),U),1:1)
  1.  ;
  1.  S DA(1)=DUZ(2),DA=ACHSDIEN
  1.  S ACHSRCOI=$$VAL^XBDIQ1(9002080.01,.DA,82)
  1.  S:ACHSRCOI["E" ACHSRCOI=$P(ACHSRCOI,"E",2)
  1.  S:ACHSRCOI["." ACHSRCOI=$P(ACHSRCOI,".")_$P(ACHSRCOI,".",2)
  1.  S ACHSRCOI=$E(ACHSRCOI_$J("",4),1,4)
  1.  I +ACHSRCOI<1 S ACHSRCOI="    "
  1. ECFIX ;
  1.  KILL Z
  1.  F ACHSI=1:1:5 I ACHSDX(ACHSI)["E" S Z(ACHSI)=ACHSDX(ACHSI) F ACHSJ=ACHSI:1 Q:ACHSJ=5  S ACHSDX(ACHSJ)=ACHSDX(ACHSJ+1),ACHSDX(ACHSJ+1)="     "
  1.  S W=0,ACHSINJP="  ",W=$O(Z(W))
  1.  I W>0 S ACHSRCOI=$E(Z(W),2,5),ACHSINJP="12"
  1.  S Z=""
  1.  F ACHSI=1:1:5 I +$E(ACHSDX(ACHSI),1,3)>799 S Z="EC"
  1.  I Z="EC"&(ACHSRCOI="    ") S ACHSRCOI="9889",ACHSINJP="12"
  1.  S ACHSDATA=19_ACHSDATA_ACHSADDT_ACHSDIDT_ACHSLOS_ACHSDITY_ACHSDX(1)_ACHSDX(2)_ACHSDX(3)_ACHSDX(4)_ACHSDX(5)_ACHSPX(1)_"    "_ACHSPX(2)_ACHSPX(3)_"          "_ACHSRCOI_ACHSINJP_ACHSIPA_ACHSFULP
  1.  Q
  1.  ;
  1. 57 ;
  1.  S ACHS=$$ADA^ACHSTX7A(DUZ(2),ACHSDIEN)
  1.  S ACHSDATA=25_$P(^AUTTLOC(DUZ(2),0),U,10)_$E(ACHSEIN,2,10)_$S(ACHSSEX=1:"M",1:"F")_ACHSDOB_ACHSSSN_$P(ACHS,U)_$P(ACHS,U,2)_$S($P(ACHSTRAN,U,10):17000000+$P(ACHSTRAN,U,10),1:$J("",8))
  1.  S ACHSDATA=ACHSDATA_$J("",32)_$$AGE^ACHSTX7A(DFN)_$P(ACHS,U,3)
  1.  G A3
  1.  ;
  1. 64 ;
  1.  I +ACHSAPC(1)<1 Q
  1. C64 ;
  1.  S ACHSHONN=$J("",7)
  1.  I $D(^ACHSF(DUZ(2),"D",ACHSDIEN,2)),$P(^(2),U),$D(^ACHSF(DUZ(2),"D",$P(^(2),U),0)) S ACHSX=$P(^(0),U,14),ACHSHONN=$P(^(0),U) D FYCVT^ACHSFU S ACHSHONN=$E(ACHSY,3,4)_ACHSHONN
  1.  S ACHSDOS=$J("",8)
  1.  I $P(ACHSTRAN,U,10) S %=$P(ACHSTRAN,U,10),ACHSDOS=17000000+%
  1.  S ACHSIPA=$E(ACHSIPA,3,8),%=$P(ACHSTRAN,U,9),ACHSVST=$E(100+%,2,3)
  1.  S ACHSDATA=20_ACHSDATA_ACHSHONN_ACHSDOS_2_ACHSAPC(1)_$S(ACHSAPC(1)="   ":" ",1:1)_ACHSAPC(2)_$S(ACHSAPC(2)="   ":" ",1:1)_ACHSVST_ACHSIPA_$J("",13)_ACHSFULP_ACHSPX(1)
  1. A3 ;
  1.  S ACHSDATA=ACHSDATA_$J("",162-$L(ACHSDATA))
  1.  S ACHSRCT=ACHSRCT+1,^ACHSTXPG(ACHSRCT)="7A"_$E(ACHSDATA,1,78),ACHSRTYP(7)=ACHSRTYP(7)+1
  1.  S PMFF=^ACHSTXPG(ACHSRCT) D ^ACHSTX99
  1.  S ACHSRCT=ACHSRCT+1,^ACHSTXPG(ACHSRCT)="7B"_$E(ACHSDATA,79,156),ACHSRTYP(7)=ACHSRTYP(7)+1
  1.  S PMFF=^ACHSTXPG(ACHSRCT) D ^ACHSTX99
  1.  ;
  1.  I TYPSER2=57 S ACHSRCT=ACHSRCT+1,^ACHSTXPG(ACHSRCT)="7C"_$E(ACHSDATA,157,234),ACHSRTYP(7)=ACHSRTYP(7)+1
  1.  S PMFF=^ACHSTXPG(ACHSRCT) D ^ACHSTX99
  1.  I ACHSRTYP(7)#10=0 W $J(ACHSRTYP(7),8)
  1.  S RET=0
  1.  Q
  1.  ;