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

ACHSTX22.m

Go to the documentation of this file. 
  1. ACHSTX22 ; IHS/ITSC/PMF - export data (?/??) - RECORD 2(DHR) 
  1.  ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
  1.  ;;ACHS*3*4 PATCH TO PATCH #3 & HAS TO CORE CONVERSION
  1.  ;;ACHS*3*7 FIX THE RETRANSMISSION PROBLEM
  1.  ;
  1.  ;This program will create a type 2 record for ACHSDIEN, or
  1.  ;    tell us why not.
  1.  ;
  1.  ;To get a type 2 record:
  1.  ;       NOT be both 638 AND parm209=true. either is ok, neither
  1.  ;                                         is ok.
  1.  ;       I, C, and S types only.  Not P, ZA, IP, or others.
  1.  ;                                Note:  ZA and IP are already
  1.  ;                                       filtered out by now
  1.  ;
  1.  ;
  1.  ;default
  1.  I ACHSF638="Y",ACHSF209 S RET=2 Q
  1.  I ACHSTY="P" S RET=3 Q
  1.  ;
  1.  ;gonna do a type 2 record
  1.  S (ACHSX,X1)=FSCLYR
  1.  D FYCVT^ACHSFU
  1.  ;
  1.  S ACHSEFDT=$E(DT,4,5)_$E(DT,6,7)_$E(DT,2,3),ACHSCDE=$S(ACHSCTY="I":"05013",ACHSCTY="F":"05024",ACHSCTY="P":"05025",ACHSTY="S":"05015",1:"")
  1.  ;
  1.  S ACHSRCT=ACHSRCT+1,ACHSRTYP(2)=ACHSRTYP(2)+1
  1.  ;
  1.  S ^ACHSDATA(ACHSRCT)="2"_ACHSEFDT_ACHSCDE_$S(TYPSERV=1:323,TYPSERV=2:324,TYPSERV=3:325,1:"")_ACHSDOCN_$J("",13)_"1"_X1_CAN_OCC_ACHSIPA_VNDFNFC_$J("",16)
  1.  ;
  1.  S PMFF=^ACHSDATA(ACHSRCT) D ^ACHSTX99
  1.  ;
  1.  I $L(^ACHSDATA(ACHSRCT))'=80 S STOP=5 Q
  1.  ;
  1.  ;
  1.  ;remove these lines for test
  1.  ;I ACHSRCT=1 S ACHSFDT=ACHSBDT W !!,"NUMBER OF RECORDS PROCESSED = ",!!
  1.  ;I ACHSRCT#25=0 W $J(ACHSRCT,8)
  1.  ;
  1.  ;
  1.  ;now the 2b and 2c records
  1.  ;
  1.  S ACHSCAN="IHS/AP:"_$E(CAN,2,3)_"/SU:"_$E(CAN,4)_"/YR:"_$E(CAN,5)_"/CC:"_$E(CAN,6,7)
  1.  S ACHSCAN=ACHSCAN_$J("",30-$L(ACHSCAN))
  1.  ;
  1.  S ACHSOBJC=$E($P($G(^ACHSOCC(OCCPTR,0)),U,2),1,20)
  1.  S ACHSOBJC=ACHSOBJC_$J("",20-$L(ACHSOBJC))
  1.  ;
  1.  S ACHSDR3=$G(^ACHSF(DUZ(2),"D",ACHSDIEN,3))
  1.  S ACHSABD=$E($P(ACHSDR3,U,1),4,7)
  1.  S ACHSAED=$E($P(ACHSDR3,U,2),4,7)
  1.  K ACHSDR3
  1.  ;
  1.  S %="2B"_ACHSFC_"."_ACHSCAN_ACHSOBJC_ACHSY_ACHSABD_ACHSAED ;ACHS
  1.  D SET(%)
  1.  ; 2C
  1.  ; Vendor EIN
  1.  S %=$E(VNDEIN_$J("",10),1,10)_$E(VNDEINSF_"  ",1,2)
  1.  ;
  1.  ; Vendor Name
  1.  S %=%_$E(VNDNAM,1,30)
  1.  S %=%_$J("",42-$L(%))
  1.  ;
  1.  ; Vendor CityStZip
  1.  S STATE=$P($G(^DIC(5,VNDSTATE,0)),U,2)
  1.  S %=%_VNDCITY_","_STATE_","_VNDZIP
  1.  S %=$E(%,1,72),%=%_$J("",72-$L(%))
  1.  K STATE
  1.  ;
  1.  S %="2C"_%
  1.  D SET(%)
  1.  S RET=0
  1.  ;
  1.  Q
  1.  ;
  1. SET(%)  ; 
  1.  S %=%_$J("",80-$L(%))
  1.  S ACHSRCT=ACHSRCT+1,^ACHSDATA(ACHSRCT)=%
  1.  ;
  1.  ;remove next line for test
  1.  ;I ACHSRCT#25=0 W $J(ACHSRCT,8)
  1.  ;
  1.  S PMFF=^ACHSDATA(ACHSRCT) D ^ACHSTX99
  1.  Q