ACHSCPTB.m

ACHSCPTB ; IHS/ITSC/PMF - COMPILE CHS CPT CODE REPORT-SUMMARY ONLY ;   [ 10/31/2003  11:36 AM ]

 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**7**;JUNE 11,2001

 ;ITSC/SET/JVK ACHS*3.1*7 8/5/2003 - MODIFIED TO GET CODE NOT IEN

 ;

 S C=0

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

GETDATE ;

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

 I ACHSDATE="",'$D(^TMP("ACHSCPT",$J,ACHSFAC)) S ^TMP("ACHSCPT",$J,ACHSFAC,0)=""

 G:ACHSDATE="" NEXTRTN

 I ACHSDATE<ACHSBEG!(ACHSDATE>ACHSEND) G GETDATE

 S ACHSDIEN=""

GETDIEN ;

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

 G GETDATE:ACHSDIEN=""

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

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

GETCODE ;

 S (I,ACHSCPTA,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)

 .;IHS/ITSC/JVK ACHS*3.1*7 ADD LINE BELOW TO GET CODE NOT IEN

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

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

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

 .;IHS/ITSC/JVK ACHS*3.1*7 ADD LINE BELOW TO GET IEN FOR CORRECT DIC

 . S ^TMP("ACHSINDX",$J,ACHSCODE,ACHSCDIC)=""

 . 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,ACHSFAC,ACHSCODE),U,1)=$P($G(^TMP("ACHSCPT",$J,ACHSFAC,ACHSCODE)),U)+1

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

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

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

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

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

 .Q

 G GETDIEN

 ;

NEXTRTN ;

 K I

 G ^ACHSCPTC

 ;

ACHSCPTB  ; IHS/ITSC/PMF - COMPILE CHS CPT CODE REPORT-SUMMARY ONLY ;   [ 10/31/2003  11:36 AM ]

 +1       ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**7**;JUNE 11,2001

 +2       ;ITSC/SET/JVK ACHS*3.1*7 8/5/2003 - MODIFIED TO GET CODE NOT IEN

 +3       ;

 +4        SET C=0

 +5        SET ACHSFAC=DUZ(2)

           SET ACHSDATE=""

GETDATE   ;

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

 +2        IF ACHSDATE=""

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

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

 +3        IF ACHSDATE=""

               GOTO NEXTRTN

 +4        IF ACHSDATE<ACHSBEG!(ACHSDATE>ACHSEND)

               GOTO GETDATE

 +5        SET ACHSDIEN=""

GETDIEN   ;

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

 +2        IF ACHSDIEN=""

               GOTO GETDATE

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

               GOTO GETDIEN

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

GETCODE   ;

 +1        SET (I,ACHSCPTA,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       ;IHS/ITSC/JVK ACHS*3.1*7 ADD LINE BELOW TO GET CODE NOT IEN

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

 +6                IF '$DATA(ACHSCODE(0))

                       IF '$DATA(ACHSCODE(ACHSCODE))

                           QUIT 

 +7                IF '$DATA(^TMP("ACHSCPT",$JOB,ACHSFAC,ACHSCODE))

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

 +8       ;IHS/ITSC/JVK ACHS*3.1*7 ADD LINE BELOW TO GET IEN FOR CORRECT DIC

 +9                SET ^TMP("ACHSINDX",$JOB,ACHSCODE,ACHSCDIC)=""

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

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

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

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

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

 +15               IF ACHSSERV=1

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

 +16               IF ACHSSERV=2

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

 +17               IF ACHSSERV=3

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

 +18               QUIT 

               End DoDot:1

 +19       GOTO GETDIEN

 +20      ;

NEXTRTN   ;

 +1        KILL I

 +2        GOTO ^ACHSCPTC

 +3       ;