ADEPSUB4.m

ADEPSUB4 ; IHS/HQT/MJL - SUBROUTINE & FUNCTION LIBRARY ;  [ 03/24/1999   9:04 AM ]

 ;;6.0;ADE;**15**;JAN 01, 2004

 ;

 ;^TMP is a transient report global

SETREP3(ADENAM) ;EP - SETS 3-PERIOD TMP FOR PROVIDER ADENAM

 S ADEWK=$S(ADEVDT'>ADEWK1:1,ADEVDT'>ADEWK2:2,1:3)

 S:'$D(^TMP("ADEP",ADEU,ADENAM,ADESER," "_ADECOD)) ^TMP("ADEP",ADEU,ADENAM,ADESER," "_ADECOD)="0^0^0"

 S $P(^TMP("ADEP",ADEU,ADENAM,ADESER," "_ADECOD),U,ADEWK)=$P(^TMP("ADEP",ADEU,ADENAM,ADESER," "_ADECOD),U,ADEWK)+1

 S $P(^TMP("ADEP",ADEU,ADENAM,ADESER," "_ADECOD),U,4)=$P(^TMP("ADEP",ADEU,ADENAM,ADESER," "_ADECOD),U,4)+ADECODM

 ;----- BEGIN IHS MODIFICATIONS ADE*6.0*15

 S $P(^TMP("ADEP",ADEU,ADENAM,ADESER," "_ADECOD),U,8)=$P(^TMP("ADEP",ADEU,ADENAM,ADESER," "_ADECOD),U,8)+ADECODRV

 ;----- END IHS MODIFICATIONS	

 S:'$D(^TMP("ADEP",ADEU,ADENAM,ADESER,"SUBTOTAL")) ^TMP("ADEP",ADEU,ADENAM,ADESER,"SUBTOTAL")="0^0^0"

 S $P(^TMP("ADEP",ADEU,ADENAM,ADESER,"SUBTOTAL"),U,ADEWK)=$P(^TMP("ADEP",ADEU,ADENAM,ADESER,"SUBTOTAL"),U,ADEWK)+1

 S $P(^TMP("ADEP",ADEU,ADENAM,ADESER,"SUBTOTAL"),U,4)=$P(^TMP("ADEP",ADEU,ADENAM,ADESER,"SUBTOTAL"),U,4)+ADECODM

 ;----- BEGIN IHS MODIFICATIONS ADE*6.0*15

 S $P(^TMP("ADEP",ADEU,ADENAM,ADESER,"SUBTOTAL"),U,8)=$P(^TMP("ADEP",ADEU,ADENAM,ADESER,"SUBTOTAL"),U,8)+ADECODRV

 ;----- END IHS MODIFICATIONS

 S:'$D(^TMP("ADEP",ADEU,ADENAM,"8. TOTAL")) ^TMP("ADEP",ADEU,ADENAM,"8. TOTAL")="0^0^0"

 S $P(^TMP("ADEP",ADEU,ADENAM,"8. TOTAL"),U,ADEWK)=$P(^TMP("ADEP",ADEU,ADENAM,"8. TOTAL"),U,ADEWK)+1

 S $P(^TMP("ADEP",ADEU,ADENAM,"8. TOTAL"),U,4)=$P(^TMP("ADEP",ADEU,ADENAM,"8. TOTAL"),U,4)+ADECODM

 ;----- BEGIN IHS MODIFICATIONS ADE*6.0*15

 S $P(^TMP("ADEP",ADEU,ADENAM,"8. TOTAL"),U,8)=$P(^TMP("ADEP",ADEU,ADENAM,"8. TOTAL"),U,8)+ADECODRV

 ;----- END IHS MODIFICATIONS

 Q

 ;

SETREP4(ADENAM) ;EP - Sets 4-period TMP for provider ADENAM

 S ADEWK=$S(ADEVDT'>ADEWK1:1,ADEVDT'>ADEWK2:2,ADEVDT'>ADEWK3:3,1:4)

 S:'$D(^TMP("ADEP",ADEU,ADENAM,ADESER," "_ADECOD)) ^TMP("ADEP",ADEU,ADENAM,ADESER," "_ADECOD)="0^0^0^0"

 S $P(^TMP("ADEP",ADEU,ADENAM,ADESER," "_ADECOD),U,ADEWK)=$P(^TMP("ADEP",ADEU,ADENAM,ADESER," "_ADECOD),U,ADEWK)+1

 S $P(^TMP("ADEP",ADEU,ADENAM,ADESER," "_ADECOD),U,5)=$P(^TMP("ADEP",ADEU,ADENAM,ADESER," "_ADECOD),U,5)+ADECODM

 ;----- BEGIN IHS MODIFICATIONS ADE*6.0*15

 S $P(^TMP("ADEP",ADEU,ADENAM,ADESER," "_ADECOD),U,8)=$P(^TMP("ADEP",ADEU,ADENAM,ADESER," "_ADECOD),U,8)+ADECODRV

 ;----- END IHS MODIFICATIONS

 S:'$D(^TMP("ADEP",ADEU,ADENAM,ADESER,"SUBTOTAL")) ^TMP("ADEP",ADEU,ADENAM,ADESER,"SUBTOTAL")="0^0^0^0"

 S $P(^TMP("ADEP",ADEU,ADENAM,ADESER,"SUBTOTAL"),U,ADEWK)=$P(^TMP("ADEP",ADEU,ADENAM,ADESER,"SUBTOTAL"),U,ADEWK)+1

 S $P(^TMP("ADEP",ADEU,ADENAM,ADESER,"SUBTOTAL"),U,5)=$P(^TMP("ADEP",ADEU,ADENAM,ADESER,"SUBTOTAL"),U,5)+ADECODM

 ;----- BEGIN IHS MODIFICATIONS ADE*6.0*15

 S $P(^TMP("ADEP",ADEU,ADENAM,ADESER,"SUBTOTAL"),U,8)=$P(^TMP("ADEP",ADEU,ADENAM,ADESER,"SUBTOTAL"),U,8)+ADECODRV

 ;----- END IHS MODIFICATIONS

 S:'$D(^TMP("ADEP",ADEU,ADENAM,"8. TOTAL")) ^TMP("ADEP",ADEU,ADENAM,"8. TOTAL")="0^0^0^0"

 S $P(^TMP("ADEP",ADEU,ADENAM,"8. TOTAL"),U,ADEWK)=$P(^TMP("ADEP",ADEU,ADENAM,"8. TOTAL"),U,ADEWK)+1

 S $P(^TMP("ADEP",ADEU,ADENAM,"8. TOTAL"),U,5)=$P(^TMP("ADEP",ADEU,ADENAM,"8. TOTAL"),U,5)+ADECODM

 ;----- BEGIN IHS MODIFICATIONS ADE*6.0*15

 S $P(^TMP("ADEP",ADEU,ADENAM,"8. TOTAL"),U,8)=$P(^TMP("ADEP",ADEU,ADENAM,"8. TOTAL"),U,8)+ADECODRV

 ;----- END IHS MODIFICATIONS

 Q

 ;

END ;EP - END PROCESSING

 I $D(ADEU) L -^TMP("ADEP",ADEU)

 K ADEBEG,ADECNOD,ADECNT,ADECOD,ADECODM,ADED0,ADED1,ADED2,ADED3

 K ADEDATE,ADEDDS,ADEDESC,ADEDFN,ADEDHD,ADEDNAM,ADEHNAM,ADEHYG

 K ADEIOP,ADEJ,ADEK,ADEL,ADEMO,ADENAM,ADEND,ADENDY,ADENOD,ADEPER

 K ADEREP,ADERTN,ADESER,ADESUBM,ADETMP,ADETOTM,ADEU,ADEVDT

 K ADEWK,ADEWK1,ADEWK2,ADEWK3,ADEX,ADEZTSK,ADEIOPAR

 Q

 ;

RD(ADESTR) ;EP -

 N ADEX,ADEY

 S ADEX="Z;D;U"

 S ADEY=$P(ADEX,";",2)_$P(ADEX,";",3)_$P(ADEX,";")_"(0)"

 S @ADEY=ADESTR

 K ADEX,ADEY,ADESTR

 Q

ADEPSUB4  ; IHS/HQT/MJL - SUBROUTINE & FUNCTION LIBRARY ;  [ 03/24/1999   9:04 AM ]

 +1       ;;6.0;ADE;**15**;JAN 01, 2004

 +2       ;

 +3       ;^TMP is a transient report global

SETREP3(ADENAM) ;EP - SETS 3-PERIOD TMP FOR PROVIDER ADENAM

 +1        SET ADEWK=$SELECT(ADEVDT'>ADEWK1:1,ADEVDT'>ADEWK2:2,1:3)

 +2        IF '$DATA(^TMP("ADEP",ADEU,ADENAM,ADESER," "_ADECOD))

               SET ^TMP("ADEP",ADEU,ADENAM,ADESER," "_ADECOD)="0^0^0"

 +3        SET $PIECE(^TMP("ADEP",ADEU,ADENAM,ADESER," "_ADECOD),U,ADEWK)=$PIECE(^TMP("ADEP",ADEU,ADENAM,ADESER," "_ADECOD),U,ADEWK)+1

 +4        SET $PIECE(^TMP("ADEP",ADEU,ADENAM,ADESER," "_ADECOD),U,4)=$PIECE(^TMP("ADEP",ADEU,ADENAM,ADESER," "_ADECOD),U,4)+ADECODM

 +5       ;----- BEGIN IHS MODIFICATIONS ADE*6.0*15

 +6        SET $PIECE(^TMP("ADEP",ADEU,ADENAM,ADESER," "_ADECOD),U,8)=$PIECE(^TMP("ADEP",ADEU,ADENAM,ADESER," "_ADECOD),U,8)+ADECODRV

 +7       ;----- END IHS MODIFICATIONS	

 +8        IF '$DATA(^TMP("ADEP",ADEU,ADENAM,ADESER,"SUBTOTAL"))

               SET ^TMP("ADEP",ADEU,ADENAM,ADESER,"SUBTOTAL")="0^0^0"

 +9        SET $PIECE(^TMP("ADEP",ADEU,ADENAM,ADESER,"SUBTOTAL"),U,ADEWK)=$PIECE(^TMP("ADEP",ADEU,ADENAM,ADESER,"SUBTOTAL"),U,ADEWK)+1

 +10       SET $PIECE(^TMP("ADEP",ADEU,ADENAM,ADESER,"SUBTOTAL"),U,4)=$PIECE(^TMP("ADEP",ADEU,ADENAM,ADESER,"SUBTOTAL"),U,4)+ADECODM

 +11      ;----- BEGIN IHS MODIFICATIONS ADE*6.0*15

 +12       SET $PIECE(^TMP("ADEP",ADEU,ADENAM,ADESER,"SUBTOTAL"),U,8)=$PIECE(^TMP("ADEP",ADEU,ADENAM,ADESER,"SUBTOTAL"),U,8)+ADECODRV

 +13      ;----- END IHS MODIFICATIONS

 +14       IF '$DATA(^TMP("ADEP",ADEU,ADENAM,"8. TOTAL"))

               SET ^TMP("ADEP",ADEU,ADENAM,"8. TOTAL")="0^0^0"

 +15       SET $PIECE(^TMP("ADEP",ADEU,ADENAM,"8. TOTAL"),U,ADEWK)=$PIECE(^TMP("ADEP",ADEU,ADENAM,"8. TOTAL"),U,ADEWK)+1

 +16       SET $PIECE(^TMP("ADEP",ADEU,ADENAM,"8. TOTAL"),U,4)=$PIECE(^TMP("ADEP",ADEU,ADENAM,"8. TOTAL"),U,4)+ADECODM

 +17      ;----- BEGIN IHS MODIFICATIONS ADE*6.0*15

 +18       SET $PIECE(^TMP("ADEP",ADEU,ADENAM,"8. TOTAL"),U,8)=$PIECE(^TMP("ADEP",ADEU,ADENAM,"8. TOTAL"),U,8)+ADECODRV

 +19      ;----- END IHS MODIFICATIONS

 +20       QUIT 

 +21      ;

SETREP4(ADENAM) ;EP - Sets 4-period TMP for provider ADENAM

 +1        SET ADEWK=$SELECT(ADEVDT'>ADEWK1:1,ADEVDT'>ADEWK2:2,ADEVDT'>ADEWK3:3,1:4)

 +2        IF '$DATA(^TMP("ADEP",ADEU,ADENAM,ADESER," "_ADECOD))

               SET ^TMP("ADEP",ADEU,ADENAM,ADESER," "_ADECOD)="0^0^0^0"

 +3        SET $PIECE(^TMP("ADEP",ADEU,ADENAM,ADESER," "_ADECOD),U,ADEWK)=$PIECE(^TMP("ADEP",ADEU,ADENAM,ADESER," "_ADECOD),U,ADEWK)+1

 +4        SET $PIECE(^TMP("ADEP",ADEU,ADENAM,ADESER," "_ADECOD),U,5)=$PIECE(^TMP("ADEP",ADEU,ADENAM,ADESER," "_ADECOD),U,5)+ADECODM

 +5       ;----- BEGIN IHS MODIFICATIONS ADE*6.0*15

 +6        SET $PIECE(^TMP("ADEP",ADEU,ADENAM,ADESER," "_ADECOD),U,8)=$PIECE(^TMP("ADEP",ADEU,ADENAM,ADESER," "_ADECOD),U,8)+ADECODRV

 +7       ;----- END IHS MODIFICATIONS

 +8        IF '$DATA(^TMP("ADEP",ADEU,ADENAM,ADESER,"SUBTOTAL"))

               SET ^TMP("ADEP",ADEU,ADENAM,ADESER,"SUBTOTAL")="0^0^0^0"

 +9        SET $PIECE(^TMP("ADEP",ADEU,ADENAM,ADESER,"SUBTOTAL"),U,ADEWK)=$PIECE(^TMP("ADEP",ADEU,ADENAM,ADESER,"SUBTOTAL"),U,ADEWK)+1

 +10       SET $PIECE(^TMP("ADEP",ADEU,ADENAM,ADESER,"SUBTOTAL"),U,5)=$PIECE(^TMP("ADEP",ADEU,ADENAM,ADESER,"SUBTOTAL"),U,5)+ADECODM

 +11      ;----- BEGIN IHS MODIFICATIONS ADE*6.0*15

 +12       SET $PIECE(^TMP("ADEP",ADEU,ADENAM,ADESER,"SUBTOTAL"),U,8)=$PIECE(^TMP("ADEP",ADEU,ADENAM,ADESER,"SUBTOTAL"),U,8)+ADECODRV

 +13      ;----- END IHS MODIFICATIONS

 +14       IF '$DATA(^TMP("ADEP",ADEU,ADENAM,"8. TOTAL"))

               SET ^TMP("ADEP",ADEU,ADENAM,"8. TOTAL")="0^0^0^0"

 +15       SET $PIECE(^TMP("ADEP",ADEU,ADENAM,"8. TOTAL"),U,ADEWK)=$PIECE(^TMP("ADEP",ADEU,ADENAM,"8. TOTAL"),U,ADEWK)+1

 +16       SET $PIECE(^TMP("ADEP",ADEU,ADENAM,"8. TOTAL"),U,5)=$PIECE(^TMP("ADEP",ADEU,ADENAM,"8. TOTAL"),U,5)+ADECODM

 +17      ;----- BEGIN IHS MODIFICATIONS ADE*6.0*15

 +18       SET $PIECE(^TMP("ADEP",ADEU,ADENAM,"8. TOTAL"),U,8)=$PIECE(^TMP("ADEP",ADEU,ADENAM,"8. TOTAL"),U,8)+ADECODRV

 +19      ;----- END IHS MODIFICATIONS

 +20       QUIT 

 +21      ;

END       ;EP - END PROCESSING

 +1        IF $DATA(ADEU)

               LOCK -^TMP("ADEP",ADEU)

 +2        KILL ADEBEG,ADECNOD,ADECNT,ADECOD,ADECODM,ADED0,ADED1,ADED2,ADED3

 +3        KILL ADEDATE,ADEDDS,ADEDESC,ADEDFN,ADEDHD,ADEDNAM,ADEHNAM,ADEHYG

 +4        KILL ADEIOP,ADEJ,ADEK,ADEL,ADEMO,ADENAM,ADEND,ADENDY,ADENOD,ADEPER

 +5        KILL ADEREP,ADERTN,ADESER,ADESUBM,ADETMP,ADETOTM,ADEU,ADEVDT

 +6        KILL ADEWK,ADEWK1,ADEWK2,ADEWK3,ADEX,ADEZTSK,ADEIOPAR

 +7        QUIT 

 +8       ;

RD(ADESTR) ;EP -

 +1        NEW ADEX,ADEY

 +2        SET ADEX="Z;D;U"

 +3        SET ADEY=$PIECE(ADEX,";",2)_$PIECE(ADEX,";",3)_$PIECE(ADEX,";")_"(0)"

 +4        SET @ADEY=ADESTR

 +5        KILL ADEX,ADEY,ADESTR

 +6        QUIT