ACHSTX66 ; IHS/ADC/GTH - EXPORT DATA (7/9) - RECORD 6(PAY FOR AO) ;
;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
;
I 'ACHSF212 S RET=13 Q
I ACHSTY'="P" S RET=3 Q
I DESTN'="I" S RET=15 Q
;
S ACHSEIN=$E(VNDEIN_VNDEINSF_$J("",12),1,12)
;
S ACHSPTYP=" "
I +VNDTYPE,$D(^AUTTVTYP(VNDTYPE,0)) S ACHSPTYP=$P(^(0),U)
;
S ACHSHRN=CHART I CHART<1,$P(ACHSTRAN,U,3) S ACHSHRN=$$HRN^ACHS($P(ACHSTRAN,U,3),DUZ(2))
;
S ACHSHRN=$E(ACHSHRN+1000000,2,7),ACHSCN=$E(CNTRPTR_$J("",10),1,10)
S ACHSDCR=$E(DCRACCT+100,2,3),ACHSRCT=ACHSRCT+1,ACHSRTYP(6)=ACHSRTYP(6)+1
;
S ^ACHSTXPD(ACHSRCT)="6A"_$E(ACHSDOCN,2,99)_TYPSER2_ORDDAT_"6"_ACHSAFAC_ACHSHRN_ACHSEIN_ACHSPTYP_VNDFNFC_ACHSCN_CAN_OCC_ACHSDCR_$J("",10)
;
S PMFF=^ACHSTXPD(ACHSRCT) D ^ACHSTX99
;
S X=$P(ACHSDOCR,U,9),X=$P(X,".",1)_$E($P(X,".",2)_"00",1,2),ACHSOAMT=$E(X+100000000,2,9)
D IPA^ACHSTX8
S ACHSIPA=$E(ACHSIPA,5,12),ACHSFULP=$S($P(ACHSTRAN,U,5)="P":2,1:1),X=$P(ACHSTRAN,U,3)
G A3:+X<1,A4:$D(^DPT(X))
A3 ;
S ACHSLNAM=$J("",20),ACHSFNAM=$J("",10)
G A5
;
A4 ;
S ACHSLNAM=$E($P($P(^DPT(X,0),U),",")_$J("",20),1,20),ACHSFNAM=$E($P($P(^DPT(X,0),U),",",2)_$J("",10),1,10)
A5 ;
;S ACHSWKLD=$E(+$P(ACHSTRAN,U,9)+1000,2,4),ACHSDOS=$P(ACHSTRAN,U,10),ACHSDOS=$E(ACHSDOS,4,7)_$E(ACHSDOS,2,3),ACHSDOS=$E(ACHSDOS,1,6),ACHSDOS=$J(ACHSDOS,6) ;ACHS*3*9 IV&V DATE FIX
S ACHSWKLD=$E(+$P(ACHSTRAN,U,9)+1000,2,4),ACHSDOS=$P(ACHSTRAN,U,10) S:ACHSDOS="" ACHSDOS=" " ;ACHS*3*9 IV&V DATE FIX
S X=$P(ACHSTRAN,U,8),X=$P(X,".",1)_$E($P(X,".",2)_"00",1,2),ACHSTHRD=$E(X+100000000,2,9)
S ACHSRCT=ACHSRCT+1
S ^ACHSTXPD(ACHSRCT)="6B"_ACHSOAMT_ACHSIPA_ACHSFULP_ACHSLNAM_ACHSFNAM_ACHSDOS_ACHSWKLD_ACHSTHRD_$J("",14)
;
S PMFF=^ACHSTXPD(ACHSRCT) D ^ACHSTX99
;
S ACHSRTYP(6)=ACHSRTYP(6)+1
S RET=0
;
Q
ACHSTX66 ; IHS/ADC/GTH - EXPORT DATA (7/9) - RECORD 6(PAY FOR AO) ;
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
+2 ;
+3 IF 'ACHSF212
SET RET=13
QUIT
+4 IF ACHSTY'="P"
SET RET=3
QUIT
+5 IF DESTN'="I"
SET RET=15
QUIT
+6 ;
+7 SET ACHSEIN=$EXTRACT(VNDEIN_VNDEINSF_$JUSTIFY("",12),1,12)
+8 ;
+9 SET ACHSPTYP=" "
+10 IF +VNDTYPE
IF $DATA(^AUTTVTYP(VNDTYPE,0))
SET ACHSPTYP=$PIECE(^(0),U)
+11 ;
+12 SET ACHSHRN=CHART
IF CHART<1
IF $PIECE(ACHSTRAN,U,3)
SET ACHSHRN=$$HRN^ACHS($PIECE(ACHSTRAN,U,3),DUZ(2))
+13 ;
+14 SET ACHSHRN=$EXTRACT(ACHSHRN+1000000,2,7)
SET ACHSCN=$EXTRACT(CNTRPTR_$JUSTIFY("",10),1,10)
+15 SET ACHSDCR=$EXTRACT(DCRACCT+100,2,3)
SET ACHSRCT=ACHSRCT+1
SET ACHSRTYP(6)=ACHSRTYP(6)+1
+16 ;
+17 SET ^ACHSTXPD(ACHSRCT)="6A"_$EXTRACT(ACHSDOCN,2,99)_TYPSER2_ORDDAT_"6"_ACHSAFAC_ACHSHRN_ACHSEIN_ACHSPTYP_VNDFNFC_ACHSCN_CAN_OCC_ACHSDCR_$JUSTIFY("",10)
+18 ;
+19 SET PMFF=^ACHSTXPD(ACHSRCT)
DO ^ACHSTX99
+20 ;
+21 SET X=$PIECE(ACHSDOCR,U,9)
SET X=$PIECE(X,".",1)_$EXTRACT($PIECE(X,".",2)_"00",1,2)
SET ACHSOAMT=$EXTRACT(X+100000000,2,9)
+22 DO IPA^ACHSTX8
+23 SET ACHSIPA=$EXTRACT(ACHSIPA,5,12)
SET ACHSFULP=$SELECT($PIECE(ACHSTRAN,U,5)="P":2,1:1)
SET X=$PIECE(ACHSTRAN,U,3)
+24 IF +X<1
GOTO A3
IF $DATA(^DPT(X))
GOTO A4
A3 ;
+1 SET ACHSLNAM=$JUSTIFY("",20)
SET ACHSFNAM=$JUSTIFY("",10)
+2 GOTO A5
+3 ;
A4 ;
+1 SET ACHSLNAM=$EXTRACT($PIECE($PIECE(^DPT(X,0),U),",")_$JUSTIFY("",20),1,20)
SET ACHSFNAM=$EXTRACT($PIECE($PIECE(^DPT(X,0),U),",",2)_$JUSTIFY("",10),1,10)
A5 ;
+1 ;S ACHSWKLD=$E(+$P(ACHSTRAN,U,9)+1000,2,4),ACHSDOS=$P(ACHSTRAN,U,10),ACHSDOS=$E(ACHSDOS,4,7)_$E(ACHSDOS,2,3),ACHSDOS=$E(ACHSDOS,1,6),ACHSDOS=$J(ACHSDOS,6) ;ACHS*3*9 IV&V DATE FIX
+2 ;ACHS*3*9 IV&V DATE FIX
SET ACHSWKLD=$EXTRACT(+$PIECE(ACHSTRAN,U,9)+1000,2,4)
SET ACHSDOS=$PIECE(ACHSTRAN,U,10)
IF ACHSDOS=""
SET ACHSDOS=" "
+3 SET X=$PIECE(ACHSTRAN,U,8)
SET X=$PIECE(X,".",1)_$EXTRACT($PIECE(X,".",2)_"00",1,2)
SET ACHSTHRD=$EXTRACT(X+100000000,2,9)
+4 SET ACHSRCT=ACHSRCT+1
+5 SET ^ACHSTXPD(ACHSRCT)="6B"_ACHSOAMT_ACHSIPA_ACHSFULP_ACHSLNAM_ACHSFNAM_ACHSDOS_ACHSWKLD_ACHSTHRD_$JUSTIFY("",14)
+6 ;
+7 SET PMFF=^ACHSTXPD(ACHSRCT)
DO ^ACHSTX99
+8 ;
+9 SET ACHSRTYP(6)=ACHSRTYP(6)+1
+10 SET RET=0
+11 ;
+12 QUIT