BMCCHS1.m

BMCCHS1 ;IHS/OIT/FCJ - CHS INTERFACE 2 OF 2 RTNS [ 09/22/2006  10:03 AM ]

 ;;4.0;REFERRED CARE INFO SYSTEM;**2**;JAN 09, 2006;Build 101

 ;

 ;

APPEAL(BMCCHS) ;APPEAL INFORMATION

 ; d appeal^bmcchs(.array_name)

 Q:'$D(^BMCREF("CD",BMCCHS(1128)))

 S BMCRIEN="",BMCRIEN=$O(^BMCREF("CD",BMCCHS(1128),BMCRIEN))

 S BMCAPDT=$P($G(^BMCREF(BMCRIEN,61)),U,16)

 Q:BMCAPDT>BMCCHS(6116)

 S DIE="^BMCREF(",DA=BMCRIEN,DR=""

 F BMCCHSX=1112,1113,1122,6116,6117,6118,6119 S:$G(BMCCHS(BMCCHSX))'="" DR=DR_$S(DR="":"",1:";")_BMCCHSX_"///"_BMCCHS(BMCCHSX)

 I $P($G(^BMCPARM(DUZ(2),4100)),U,5)="Y",BMCCHS(1112)="A" D

 .S DR=DR_$S(DR="":"",1:";")_".15///"_"A"

 Q:DR=""

 D DIE^BMCFMC

 Q

BMCCHS1   ;IHS/OIT/FCJ - CHS INTERFACE 2 OF 2 RTNS [ 09/22/2006  10:03 AM ]

 +1       ;;4.0;REFERRED CARE INFO SYSTEM;**2**;JAN 09, 2006;Build 101

 +2       ;

 +3       ;

APPEAL(BMCCHS) ;APPEAL INFORMATION

 +1       ; d appeal^bmcchs(.array_name)

 +2        IF '$DATA(^BMCREF("CD",BMCCHS(1128)))

               QUIT 

 +3        SET BMCRIEN=""

           SET BMCRIEN=$ORDER(^BMCREF("CD",BMCCHS(1128),BMCRIEN))

 +4        SET BMCAPDT=$PIECE($GET(^BMCREF(BMCRIEN,61)),U,16)

 +5        IF BMCAPDT>BMCCHS(6116)

               QUIT 

 +6        SET DIE="^BMCREF("

           SET DA=BMCRIEN

           SET DR=""

 +7        FOR BMCCHSX=1112,1113,1122,6116,6117,6118,6119

               IF $GET(BMCCHS(BMCCHSX))'=""

                   SET DR=DR_$SELECT(DR="":"",1:";")_BMCCHSX_"///"_BMCCHS(BMCCHSX)

 +8        IF $PIECE($GET(^BMCPARM(DUZ(2),4100)),U,5)="Y"

               IF BMCCHS(1112)="A"

                   Begin DoDot:1

 +9                    SET DR=DR_$SELECT(DR="":"",1:";")_".15///"_"A"

                   End DoDot:1

 +10       IF DR=""

               QUIT 

 +11       DO DIE^BMCFMC

 +12       QUIT