ACHSTX22 ; IHS/ITSC/PMF - export data (?/??) - RECORD 2(DHR)
;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
;;ACHS*3*4 PATCH TO PATCH #3 & HAS TO CORE CONVERSION
;;ACHS*3*7 FIX THE RETRANSMISSION PROBLEM
;
;This program will create a type 2 record for ACHSDIEN, or
; tell us why not.
;
;To get a type 2 record:
; NOT be both 638 AND parm209=true. either is ok, neither
; is ok.
; I, C, and S types only. Not P, ZA, IP, or others.
; Note: ZA and IP are already
; filtered out by now
;
;
;default
I ACHSF638="Y",ACHSF209 S RET=2 Q
I ACHSTY="P" S RET=3 Q
;
;gonna do a type 2 record
S (ACHSX,X1)=FSCLYR
D FYCVT^ACHSFU
;
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:"")
;
S ACHSRCT=ACHSRCT+1,ACHSRTYP(2)=ACHSRTYP(2)+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)
;
S PMFF=^ACHSDATA(ACHSRCT) D ^ACHSTX99
;
I $L(^ACHSDATA(ACHSRCT))'=80 S STOP=5 Q
;
;
;remove these lines for test
;I ACHSRCT=1 S ACHSFDT=ACHSBDT W !!,"NUMBER OF RECORDS PROCESSED = ",!!
;I ACHSRCT#25=0 W $J(ACHSRCT,8)
;
;
;now the 2b and 2c records
;
S ACHSCAN="IHS/AP:"_$E(CAN,2,3)_"/SU:"_$E(CAN,4)_"/YR:"_$E(CAN,5)_"/CC:"_$E(CAN,6,7)
S ACHSCAN=ACHSCAN_$J("",30-$L(ACHSCAN))
;
S ACHSOBJC=$E($P($G(^ACHSOCC(OCCPTR,0)),U,2),1,20)
S ACHSOBJC=ACHSOBJC_$J("",20-$L(ACHSOBJC))
;
S ACHSDR3=$G(^ACHSF(DUZ(2),"D",ACHSDIEN,3))
S ACHSABD=$E($P(ACHSDR3,U,1),4,7)
S ACHSAED=$E($P(ACHSDR3,U,2),4,7)
K ACHSDR3
;
S %="2B"_ACHSFC_"."_ACHSCAN_ACHSOBJC_ACHSY_ACHSABD_ACHSAED ;ACHS
D SET(%)
; 2C
; Vendor EIN
S %=$E(VNDEIN_$J("",10),1,10)_$E(VNDEINSF_" ",1,2)
;
; Vendor Name
S %=%_$E(VNDNAM,1,30)
S %=%_$J("",42-$L(%))
;
; Vendor CityStZip
S STATE=$P($G(^DIC(5,VNDSTATE,0)),U,2)
S %=%_VNDCITY_","_STATE_","_VNDZIP
S %=$E(%,1,72),%=%_$J("",72-$L(%))
K STATE
;
S %="2C"_%
D SET(%)
S RET=0
;
Q
;
SET(%) ;
S %=%_$J("",80-$L(%))
S ACHSRCT=ACHSRCT+1,^ACHSDATA(ACHSRCT)=%
;
;remove next line for test
;I ACHSRCT#25=0 W $J(ACHSRCT,8)
;
S PMFF=^ACHSDATA(ACHSRCT) D ^ACHSTX99
Q
ACHSTX22 ; IHS/ITSC/PMF - export data (?/??) - RECORD 2(DHR)
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
+2 ;;ACHS*3*4 PATCH TO PATCH #3 & HAS TO CORE CONVERSION
+3 ;;ACHS*3*7 FIX THE RETRANSMISSION PROBLEM
+4 ;
+5 ;This program will create a type 2 record for ACHSDIEN, or
+6 ; tell us why not.
+7 ;
+8 ;To get a type 2 record:
+9 ; NOT be both 638 AND parm209=true. either is ok, neither
+10 ; is ok.
+11 ; I, C, and S types only. Not P, ZA, IP, or others.
+12 ; Note: ZA and IP are already
+13 ; filtered out by now
+14 ;
+15 ;
+16 ;default
+17 IF ACHSF638="Y"
IF ACHSF209
SET RET=2
QUIT
+18 IF ACHSTY="P"
SET RET=3
QUIT
+19 ;
+20 ;gonna do a type 2 record
+21 SET (ACHSX,X1)=FSCLYR
+22 DO FYCVT^ACHSFU
+23 ;
+24 SET ACHSEFDT=$EXTRACT(DT,4,5)_$EXTRACT(DT,6,7)_$EXTRACT(DT,2,3)
SET ACHSCDE=$SELECT(ACHSCTY="I":"05013",ACHSCTY="F":"05024",ACHSCTY="P":"05025",ACHSTY="S":"05015",1:"")
+25 ;
+26 SET ACHSRCT=ACHSRCT+1
SET ACHSRTYP(2)=ACHSRTYP(2)+1
+27 ;
+28 SET ^ACHSDATA(ACHSRCT)="2"_ACHSEFDT_ACHSCDE_$SELECT(TYPSERV=1:323,TYPSERV=2:324,TYPSERV=3:325,1:"")_ACHSDOCN_$JUSTIFY("",13)_"1"_X1_CAN_OCC_ACHSIPA_VNDFNFC_$JUSTIFY("",16)
+29 ;
+30 SET PMFF=^ACHSDATA(ACHSRCT)
DO ^ACHSTX99
+31 ;
+32 IF $LENGTH(^ACHSDATA(ACHSRCT))'=80
SET STOP=5
QUIT
+33 ;
+34 ;
+35 ;remove these lines for test
+36 ;I ACHSRCT=1 S ACHSFDT=ACHSBDT W !!,"NUMBER OF RECORDS PROCESSED = ",!!
+37 ;I ACHSRCT#25=0 W $J(ACHSRCT,8)
+38 ;
+39 ;
+40 ;now the 2b and 2c records
+41 ;
+42 SET ACHSCAN="IHS/AP:"_$EXTRACT(CAN,2,3)_"/SU:"_$EXTRACT(CAN,4)_"/YR:"_$EXTRACT(CAN,5)_"/CC:"_$EXTRACT(CAN,6,7)
+43 SET ACHSCAN=ACHSCAN_$JUSTIFY("",30-$LENGTH(ACHSCAN))
+44 ;
+45 SET ACHSOBJC=$EXTRACT($PIECE($GET(^ACHSOCC(OCCPTR,0)),U,2),1,20)
+46 SET ACHSOBJC=ACHSOBJC_$JUSTIFY("",20-$LENGTH(ACHSOBJC))
+47 ;
+48 SET ACHSDR3=$GET(^ACHSF(DUZ(2),"D",ACHSDIEN,3))
+49 SET ACHSABD=$EXTRACT($PIECE(ACHSDR3,U,1),4,7)
+50 SET ACHSAED=$EXTRACT($PIECE(ACHSDR3,U,2),4,7)
+51 KILL ACHSDR3
+52 ;
+53 ;ACHS
SET %="2B"_ACHSFC_"."_ACHSCAN_ACHSOBJC_ACHSY_ACHSABD_ACHSAED
+54 DO SET(%)
+55 ; 2C
+56 ; Vendor EIN
+57 SET %=$EXTRACT(VNDEIN_$JUSTIFY("",10),1,10)_$EXTRACT(VNDEINSF_" ",1,2)
+58 ;
+59 ; Vendor Name
+60 SET %=%_$EXTRACT(VNDNAM,1,30)
+61 SET %=%_$JUSTIFY("",42-$LENGTH(%))
+62 ;
+63 ; Vendor CityStZip
+64 SET STATE=$PIECE($GET(^DIC(5,VNDSTATE,0)),U,2)
+65 SET %=%_VNDCITY_","_STATE_","_VNDZIP
+66 SET %=$EXTRACT(%,1,72)
SET %=%_$JUSTIFY("",72-$LENGTH(%))
+67 KILL STATE
+68 ;
+69 SET %="2C"_%
+70 DO SET(%)
+71 SET RET=0
+72 ;
+73 QUIT
+74 ;
SET(%) ;
+1 SET %=%_$JUSTIFY("",80-$LENGTH(%))
+2 SET ACHSRCT=ACHSRCT+1
SET ^ACHSDATA(ACHSRCT)=%
+3 ;
+4 ;remove next line for test
+5 ;I ACHSRCT#25=0 W $J(ACHSRCT,8)
+6 ;
+7 SET PMFF=^ACHSDATA(ACHSRCT)
DO ^ACHSTX99
+8 QUIT
