ADEMBA.m

ADEMBA ; IHS/HQT/MJL  - COUNT BA'S IN ^ADEPAT ;  [ 03/24/1999   9:04 AM ]

 ;;6.0;ADE;;APRIL 1999

 ;INPUT (IN X) NUMBER OF DAYS IN PAST TO LOOK FOR BA'S

 ;RETURNS IN X THE NUMBER OF BA'S IN ^ADEPAT DURING PAST X DAYS

 ;(CALLED BY ADEBA FUNCTION)

 ;S X=2 ;REMOVE AFTER TESTING

 S X=-X,X1=DT,X2=X D C^%DTC K X1,X2

 I '$D(^ADEFOL(D0,0)) S X="ERR" G END

 I '+$P(^ADEFOL(D0,0),U) S X="ERR" G END

 I '$D(^ADEPAT($P(^ADEFOL(D0,0),U),"FA")) S X=0 G END

 S (ADER,ADES)=0 F ADEQ=0:0 S ADER=$O(^ADEPAT($P(^ADEFOL(D0,0),U),"FA",ADER)) Q:'+ADER  S:$P(^ADEPAT($P(^ADEFOL(D0,0),U),"FA",ADER,0),U)>X&($P(^(0),U,2)="b") ADES=ADES+1

 S X=ADES

END K ADEQ,ADER,ADES Q

ADEMBA    ; IHS/HQT/MJL  - COUNT BA'S IN ^ADEPAT ;  [ 03/24/1999   9:04 AM ]

 +1       ;;6.0;ADE;;APRIL 1999

 +2       ;INPUT (IN X) NUMBER OF DAYS IN PAST TO LOOK FOR BA'S

 +3       ;RETURNS IN X THE NUMBER OF BA'S IN ^ADEPAT DURING PAST X DAYS

 +4       ;(CALLED BY ADEBA FUNCTION)

 +5       ;S X=2 ;REMOVE AFTER TESTING

 +6        SET X=-X

           SET X1=DT

           SET X2=X

           DO C^%DTC

           KILL X1,X2

 +7        IF '$DATA(^ADEFOL(D0,0))

               SET X="ERR"

               GOTO END

 +8        IF '+$PIECE(^ADEFOL(D0,0),U)

               SET X="ERR"

               GOTO END

 +9        IF '$DATA(^ADEPAT($PIECE(^ADEFOL(D0,0),U),"FA"))

               SET X=0

               GOTO END

 +10       SET (ADER,ADES)=0

           FOR ADEQ=0:0

               SET ADER=$ORDER(^ADEPAT($PIECE(^ADEFOL(D0,0),U),"FA",ADER))

               IF '+ADER

                   QUIT 

               IF $PIECE(^ADEPAT($PIECE(^ADEFOL(D0,0),U),"FA",ADER,0),U)>X&($PIECE(^(0),U,2)="b")

                   SET ADES=ADES+1

 +11       SET X=ADES

END        KILL ADEQ,ADER,ADES

           QUIT