ACHSOCV1.m

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

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

 ;

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

GETFY ;

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

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

 G:ACHSFY1="" ^ACHSOCVS

 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

GETVDR ;

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

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

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 $P(^TMP("ACHSOCV",$J,ACHSFAC,ACHSVNDR,ACHSOC),U,1)=$P(^TMP("ACHSOCV",$J,ACHSFAC,ACHSVNDR,ACHSOC),U,1)+1

 S $P(^TMP("ACHSOCV",$J,ACHSFAC,ACHSVNDR,ACHSOC),U,2)=$P(^TMP("ACHSOCV",$J,ACHSFAC,ACHSVNDR,ACHSOC),U,2)+ACHSOBL

 S $P(^TMP("ACHSOCV",$J,ACHSFAC,ACHSVNDR,ACHSOC),U,3)=$P(^TMP("ACHSOCV",$J,ACHSFAC,ACHSVNDR,ACHSOC),U,3)+ACHSPMT

 G GETDEN

 ;

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

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

 +2       ;

 +3        SET ACHSFY1=""

           SET ACHSFAC=DUZ(2)

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 ^ACHSOCVS

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

           SET ACHSFYB=$EXTRACT(ACHSFY,4)

 +5        IF ACHSFYA'=ACHSFYB

               GOTO GETFY

 +6        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

GETVDR    ;

 +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")

 +2        IF '$DATA(^TMP("ACHSOCV",$JOB,ACHSFAC,ACHSVNDR,ACHSOC))

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

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 $PIECE(^TMP("ACHSOCV",$JOB,ACHSFAC,ACHSVNDR,ACHSOC),U,1)=$PIECE(^TMP("ACHSOCV",$JOB,ACHSFAC,ACHSVNDR,ACHSOC),U,1)+1

 +4        SET $PIECE(^TMP("ACHSOCV",$JOB,ACHSFAC,ACHSVNDR,ACHSOC),U,2)=$PIECE(^TMP("ACHSOCV",$JOB,ACHSFAC,ACHSVNDR,ACHSOC),U,2)+ACHSOBL

 +5        SET $PIECE(^TMP("ACHSOCV",$JOB,ACHSFAC,ACHSVNDR,ACHSOC),U,3)=$PIECE(^TMP("ACHSOCV",$JOB,ACHSFAC,ACHSVNDR,ACHSOC),U,3)+ACHSPMT

 +6        GOTO GETDEN

 +7       ;