ACHSCPTE.m

ACHSCPTE ; IHS/ITSC/PMF - COMPILE CHS CPT CODE REPORT-BY VENDOR/SUMMARY ;   [ 10/16/2001   8:16 AM ]

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

 ;

 S C=0,ACHSFAC=DUZ(2),ACHSDAT=ACHSBEG-1

GETDATE ;

 S ACHSDAT=$O(^ACHSF(ACHSFAC,"PDOS",ACHSDAT))

 I (ACHSDAT>ACHSEND)!(ACHSDAT="") D

 . I $D(ACHSVNDR(0)),'$D(^TMP("ACHSCPT",$J)) S ^TMP("ACHSCPT",$J,0)=""

 . I '$D(ACHSVNDR(0)),'$D(^TMP("ACHSCPT",$J)) S ^TMP("ACHSCPT",$J,ACHSVEN,0)=""

 .Q

 G:ACHSDAT="" ^ACHSCPTF

 S ACHSDIEN=""

GETDIEN ;

 S ACHSDIEN=$O(^ACHSF(ACHSFAC,"PDOS",ACHSDAT,ACHSDIEN))

 G GETDATE:ACHSDIEN=""

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

GETVNDR ;

 S ACHSVEND=$P($G(^ACHSF(ACHSFAC,"D",ACHSDIEN,0)),U,8)

 I $D(ACHSVNDR(0)) G GETCODE

 I ACHSVEND'=ACHSVEN G GETDIEN

GETCODE ;

 S (I,ACHS43,ACHS57,ACHS64)=0

 F  S I=$O(^ACHSF(ACHSFAC,"D",ACHSDIEN,11,I)) Q:'I  D

 .S ACHSCODE=$P($P($G(^ACHSF(ACHSFAC,"D",ACHSDIEN,11,I,0)),U),";",1)

 .I '$D(ACHSCODE(0))&'$D(ACHSCODE(ACHSCODE)) Q

 .I '$D(^TMP("ACHSCPT",$J,ACHSVEND,ACHSCODE)) S ^TMP("ACHSCPT",$J,ACHSVEND,ACHSCODE)="0^0^0"_U_ACHS43_U_ACHS57_U_ACHS64

 .S ACHSCHB=$P($G(^ACHSF(ACHSFAC,"D",ACHSDIEN,11,I,0)),U,5)

 .S ACHSCHA=$P($G(^ACHSF(ACHSFAC,"D",ACHSDIEN,11,I,0)),U,6)

 .S $P(^TMP("ACHSCPT",$J,ACHSVEND,ACHSCODE),U,1)=$P($G(^TMP("ACHSCPT",$J,ACHSVEND,ACHSCODE)),U)+1

 .S $P(^TMP("ACHSCPT",$J,ACHSVEND,ACHSCODE),U,2)=$P($G(^TMP("ACHSCPT",$J,ACHSVEND,ACHSCODE)),U,2)+ACHSCHB

 .S $P(^TMP("ACHSCPT",$J,ACHSVEND,ACHSCODE),U,3)=$P($G(^TMP("ACHSCPT",$J,ACHSVEND,ACHSCODE)),U,3)+ACHSCHA

 .S ACHSSERV=$P($G(^ACHSF(ACHSFAC,"D",ACHSDIEN,0)),U,4)

 .I ACHSSERV=1 S $P(^TMP("ACHSCPT",$J,ACHSVEND,ACHSCODE),U,4)=$P($G(^TMP("ACHSCPT",$J,ACHSVEND,ACHSCODE)),U,4)+1

 .I ACHSSERV=2 S $P(^TMP("ACHSCPT",$J,ACHSVEND,ACHSCODE),U,5)=$P($G(^TMP("ACHSCPT",$J,ACHSVEND,ACHSCODE)),U,5)+1

 .I ACHSSERV=3 S $P(^TMP("ACHSCPT",$J,ACHSVEND,ACHSCODE),U,6)=$P($G(^TMP("ACHSCPT",$J,ACHSVEND,ACHSCODE)),U,6)+1

 .S ACHSDEN=ACHSDIEN

 .Q

 G GETDIEN

 ;

ACHSCPTE  ; IHS/ITSC/PMF - COMPILE CHS CPT CODE REPORT-BY VENDOR/SUMMARY ;   [ 10/16/2001   8:16 AM ]

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

 +2       ;

 +3        SET C=0

           SET ACHSFAC=DUZ(2)

           SET ACHSDAT=ACHSBEG-1

GETDATE   ;

 +1        SET ACHSDAT=$ORDER(^ACHSF(ACHSFAC,"PDOS",ACHSDAT))

 +2        IF (ACHSDAT>ACHSEND)!(ACHSDAT="")

               Begin DoDot:1

 +3                IF $DATA(ACHSVNDR(0))

                       IF '$DATA(^TMP("ACHSCPT",$JOB))

                           SET ^TMP("ACHSCPT",$JOB,0)=""

 +4                IF '$DATA(ACHSVNDR(0))

                       IF '$DATA(^TMP("ACHSCPT",$JOB))

                           SET ^TMP("ACHSCPT",$JOB,ACHSVEN,0)=""

 +5                QUIT 

               End DoDot:1

 +6        IF ACHSDAT=""

               GOTO ^ACHSCPTF

 +7        SET ACHSDIEN=""

GETDIEN   ;

 +1        SET ACHSDIEN=$ORDER(^ACHSF(ACHSFAC,"PDOS",ACHSDAT,ACHSDIEN))

 +2        IF ACHSDIEN=""

               GOTO GETDATE

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

               GOTO GETDIEN

GETVNDR   ;

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

 +2        IF $DATA(ACHSVNDR(0))

               GOTO GETCODE

 +3        IF ACHSVEND'=ACHSVEN

               GOTO GETDIEN

GETCODE   ;

 +1        SET (I,ACHS43,ACHS57,ACHS64)=0

 +2        FOR 

               SET I=$ORDER(^ACHSF(ACHSFAC,"D",ACHSDIEN,11,I))

               IF 'I

                   QUIT 

               Begin DoDot:1

 +3                SET ACHSCODE=$PIECE($PIECE($GET(^ACHSF(ACHSFAC,"D",ACHSDIEN,11,I,0)),U),";",1)

 +4                IF '$DATA(ACHSCODE(0))&'$DATA(ACHSCODE(ACHSCODE))

                       QUIT 

 +5                IF '$DATA(^TMP("ACHSCPT",$JOB,ACHSVEND,ACHSCODE))

                       SET ^TMP("ACHSCPT",$JOB,ACHSVEND,ACHSCODE)="0^0^0"_U_ACHS43_U_ACHS57_U_ACHS64

 +6                SET ACHSCHB=$PIECE($GET(^ACHSF(ACHSFAC,"D",ACHSDIEN,11,I,0)),U,5)

 +7                SET ACHSCHA=$PIECE($GET(^ACHSF(ACHSFAC,"D",ACHSDIEN,11,I,0)),U,6)

 +8                SET $PIECE(^TMP("ACHSCPT",$JOB,ACHSVEND,ACHSCODE),U,1)=$PIECE($GET(^TMP("ACHSCPT",$JOB,ACHSVEND,ACHSCODE)),U)+1

 +9                SET $PIECE(^TMP("ACHSCPT",$JOB,ACHSVEND,ACHSCODE),U,2)=$PIECE($GET(^TMP("ACHSCPT",$JOB,ACHSVEND,ACHSCODE)),U,2)+ACHSCHB

 +10               SET $PIECE(^TMP("ACHSCPT",$JOB,ACHSVEND,ACHSCODE),U,3)=$PIECE($GET(^TMP("ACHSCPT",$JOB,ACHSVEND,ACHSCODE)),U,3)+ACHSCHA

 +11               SET ACHSSERV=$PIECE($GET(^ACHSF(ACHSFAC,"D",ACHSDIEN,0)),U,4)

 +12               IF ACHSSERV=1

                       SET $PIECE(^TMP("ACHSCPT",$JOB,ACHSVEND,ACHSCODE),U,4)=$PIECE($GET(^TMP("ACHSCPT",$JOB,ACHSVEND,ACHSCODE)),U,4)+1

 +13               IF ACHSSERV=2

                       SET $PIECE(^TMP("ACHSCPT",$JOB,ACHSVEND,ACHSCODE),U,5)=$PIECE($GET(^TMP("ACHSCPT",$JOB,ACHSVEND,ACHSCODE)),U,5)+1

 +14               IF ACHSSERV=3

                       SET $PIECE(^TMP("ACHSCPT",$JOB,ACHSVEND,ACHSCODE),U,6)=$PIECE($GET(^TMP("ACHSCPT",$JOB,ACHSVEND,ACHSCODE)),U,6)+1

 +15               SET ACHSDEN=ACHSDIEN

 +16               QUIT 

               End DoDot:1

 +17       GOTO GETDIEN

 +18      ;