ACHSOCV2.m

ACHSOCV2 ; IHS/ITSC/PMF - COMPILE CHS SERVICE CLASS CODES BY VENDOR - DETAILED ;  [ 10/16/2001   8:16 AM ]

 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001

 ;

 S ACHSFAC=DUZ(2),ACHSFY1=""

GETFY ;

 S ACHSFY1=$O(^ACHSF(ACHSFAC,"D","B",ACHSFY1))

 I ACHSFY1="",'$D(^TMP("ACHSOCV",$J,ACHSFAC)) S ^TMP("ACHSOCV",$J,ACHSFAC,0)=""

 G:ACHSFY1="" ^ACHSOCVD

 S ACHSFYA=$E(ACHSFY1,2),ACHSFYB=$E(ACHSFY,4) I ACHSFYA'=ACHSFYB G GETFY

 S ACHSDIEN=""

GETDEN ;

 S ACHSDIEN=$O(^ACHSF(ACHSFAC,"D","B",ACHSFY1,ACHSDIEN))

 G:ACHSDIEN="" GETFY

 I '$D(^ACHSF(ACHSFAC,"D",ACHSDIEN,0)) G GETDEN

 I $P(^ACHSF(ACHSFAC,"D",ACHSDIEN,0),U,9)'>0 G GETDEN

GETCODE ;

 S ACHSOC=$P(^ACHSF(ACHSFAC,"D",ACHSDIEN,0),U,7)

 I '$D(^ACHS(3,ACHSFAC,1,ACHSOC,0)) G GETDEN

GETDOC ;

 S D=$P(^ACHSF(ACHSFAC,"D",ACHSDIEN,0),U,1),ACHSDOC=$P(^ACHSF(ACHSFAC,"D",ACHSDIEN,0),U,14)_"-"_$P(^AUTTAREA($P(^AUTTLOC(ACHSFAC,0),U,4),0),U,3)_$E($P(^AUTTLOC(ACHSFAC,0),U,17),2,3)_"-"_D

 S ACHSHRN=$P(^ACHSF(ACHSFAC,"D",ACHSDIEN,0),U,21),ACHSPAT=$P(^ACHSF(ACHSFAC,"D",ACHSDIEN,0),U,22)

GETVNR ;

 S ACHSVEN=$P(^ACHSF(ACHSFAC,"D",ACHSDIEN,0),U,8),ACHSVNDR=$S($D(^AUTTVNDR(ACHSVEN,0)):$P(^(0),U,1),1:"NOT ON FILE")

GETOBL ;

 S ACHSOBL=$P(^ACHSF(ACHSFAC,"D",ACHSDIEN,0),U,9)

GETPMT ;

 S ACHSPMT=$S($D(^ACHSF(ACHSFAC,"D",ACHSDIEN,"PA")):$P(^("PA"),U,1),1:0)

 I $D(^ACHSF(ACHSFAC,"D",ACHSDIEN,"ZA")) S ACHSADJ=$S($P(^ACHSF(ACHSFAC,"D",ACHSDIEN,"ZA"),U,2):$P(^("ZA"),U,2),1:0) S ACHSPMT=ACHSPMT+ACHSADJ

 S ^TMP("ACHSOCV",$J,ACHSFAC,ACHSVNDR,ACHSOC,ACHSDOC)=ACHSPAT_U_ACHSHRN_U_ACHSOBL_U_ACHSPMT_U_ACHSVEN

 G GETDEN

 ;

ACHSOCV2  ; IHS/ITSC/PMF - COMPILE CHS SERVICE CLASS CODES BY VENDOR - DETAILED ;  [ 10/16/2001   8:16 AM ]

 +1       ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001

 +2       ;

 +3        SET ACHSFAC=DUZ(2)

           SET ACHSFY1=""

GETFY     ;

 +1        SET ACHSFY1=$ORDER(^ACHSF(ACHSFAC,"D","B",ACHSFY1))

 +2        IF ACHSFY1=""

               IF '$DATA(^TMP("ACHSOCV",$JOB,ACHSFAC))

                   SET ^TMP("ACHSOCV",$JOB,ACHSFAC,0)=""

 +3        IF ACHSFY1=""

               GOTO ^ACHSOCVD

 +4        SET ACHSFYA=$EXTRACT(ACHSFY1,2)

           SET ACHSFYB=$EXTRACT(ACHSFY,4)

           IF ACHSFYA'=ACHSFYB

               GOTO GETFY

 +5        SET ACHSDIEN=""

GETDEN    ;

 +1        SET ACHSDIEN=$ORDER(^ACHSF(ACHSFAC,"D","B",ACHSFY1,ACHSDIEN))

 +2        IF ACHSDIEN=""

               GOTO GETFY

 +3        IF '$DATA(^ACHSF(ACHSFAC,"D",ACHSDIEN,0))

               GOTO GETDEN

 +4        IF $PIECE(^ACHSF(ACHSFAC,"D",ACHSDIEN,0),U,9)'>0

               GOTO GETDEN

GETCODE   ;

 +1        SET ACHSOC=$PIECE(^ACHSF(ACHSFAC,"D",ACHSDIEN,0),U,7)

 +2        IF '$DATA(^ACHS(3,ACHSFAC,1,ACHSOC,0))

               GOTO GETDEN

GETDOC    ;

 +1        SET D=$PIECE(^ACHSF(ACHSFAC,"D",ACHSDIEN,0),U,1)

           SET ACHSDOC=$PIECE(^ACHSF(ACHSFAC,"D",ACHSDIEN,0),U,14)_"-"_$PIECE(^AUTTAREA($PIECE(^AUTTLOC(ACHSFAC,0),U,4),0),U,3)_$EXTRACT($PIECE(^AUTTLOC(ACHSFAC,0),U,17),2,3)_"-"_D

 +2        SET ACHSHRN=$PIECE(^ACHSF(ACHSFAC,"D",ACHSDIEN,0),U,21)

           SET ACHSPAT=$PIECE(^ACHSF(ACHSFAC,"D",ACHSDIEN,0),U,22)

GETVNR    ;

 +1        SET ACHSVEN=$PIECE(^ACHSF(ACHSFAC,"D",ACHSDIEN,0),U,8)

           SET ACHSVNDR=$SELECT($DATA(^AUTTVNDR(ACHSVEN,0)):$PIECE(^(0),U,1),1:"NOT ON FILE")

GETOBL    ;

 +1        SET ACHSOBL=$PIECE(^ACHSF(ACHSFAC,"D",ACHSDIEN,0),U,9)

GETPMT    ;

 +1        SET ACHSPMT=$SELECT($DATA(^ACHSF(ACHSFAC,"D",ACHSDIEN,"PA")):$PIECE(^("PA"),U,1),1:0)

 +2        IF $DATA(^ACHSF(ACHSFAC,"D",ACHSDIEN,"ZA"))

               SET ACHSADJ=$SELECT($PIECE(^ACHSF(ACHSFAC,"D",ACHSDIEN,"ZA"),U,2):$PIECE(^("ZA"),U,2),1:0)

               SET ACHSPMT=ACHSPMT+ACHSADJ

 +3        SET ^TMP("ACHSOCV",$JOB,ACHSFAC,ACHSVNDR,ACHSOC,ACHSDOC)=ACHSPAT_U_ACHSHRN_U_ACHSOBL_U_ACHSPMT_U_ACHSVEN

 +4        GOTO GETDEN

 +5       ;