BMCURMD.m

BMCURMD ; IHS/PHXAO/TMJ - ; 

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

 ;4.0 IHS/OIT/FCJ REMOVED DATE LOOP AND ADDED SELECT OF INDIVIDUAL REFERRALS

 ;

 ;

 W !!,"This option is used for utilization review.",!

GETREF ;Screens out closed Referrals

 ;S BMCQ=1,BMCCURFY=1

 S BMCQ=1,BMCCURFY=0  ;BMC*4.0*12 5/23/17 IHS/OIT/FCJ ALLOW ALL FY

 W !

 S DIC="^BMCREF(",DIC("S")="I $$FILTER^BMCFLTR(0,BMCCURFY,2)",DIC(0)="AEMQ",DIC("A")="Select RCIS REFERRAL by Patient or by Referral Date or #: "

 D DIC^BMCFMC

 Q:Y<1

 S BMCRIEN=+Y

 S BMCQ=0

 D PROCR

 ;

 K BMCODAT,BMCURQ,BMCSD,BMCBD,BMCURC,BMCVI,BMCVFLE

 Q

PROCR ;

 Q:$P($G(^BMCREF(BMCRIEN,11)),U,25)]""

PROCR1 ;

 D BROWSE

 W !! S DA=BMCRIEN,DIE="^BMCREF(",DR="[BMC UTIL/MGD CARE]" D DIE^BMCFMC

 D XIT

 Q

 ;

BROWSE ;

 S XBRP="DISP^BMCRD1"

 S XBRC="",XBRX="",XBIOP=0 D ^XBDBQUE

 ;D VIEWR^XBLM("^BMCVLP")

 Q

XIT ;EP

 D ^BMCKILL

 K ^TMP("BMCRDSP",$J)

 Q

DISP ;EP

 D EN^VALM("BMC RECORD DISPLAY")

 D CLEAR^VALM1

 Q

HDR ; -- header code

 S VALMHDR(1)="User:  "_$P(^VA(200,DUZ,0),U)

 Q

 ;

INIT ; -- init variables and list array

 D EP^BMCRD(BMCRIEN)

 S VALMCNT=$O(^TMP("BMCRDSP",$J,""),-1)

 Q

 ;

HELP ; -- help code

 S X="?" D DISP^XQORM1 W !!

 Q

 ;

EXIT ; -- exit code

 Q

BMCURMD   ; IHS/PHXAO/TMJ - ; 

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

 +2       ;4.0 IHS/OIT/FCJ REMOVED DATE LOOP AND ADDED SELECT OF INDIVIDUAL REFERRALS

 +3       ;

 +4       ;

 +5        WRITE !!,"This option is used for utilization review.",!

GETREF    ;Screens out closed Referrals

 +1       ;S BMCQ=1,BMCCURFY=1

 +2       ;BMC*4.0*12 5/23/17 IHS/OIT/FCJ ALLOW ALL FY

           SET BMCQ=1

           SET BMCCURFY=0

 +3        WRITE !

 +4        SET DIC="^BMCREF("

           SET DIC("S")="I $$FILTER^BMCFLTR(0,BMCCURFY,2)"

           SET DIC(0)="AEMQ"

           SET DIC("A")="Select RCIS REFERRAL by Patient or by Referral Date or #: "

 +5        DO DIC^BMCFMC

 +6        IF Y<1

               QUIT 

 +7        SET BMCRIEN=+Y

 +8        SET BMCQ=0

 +9        DO PROCR

 +10      ;

 +11       KILL BMCODAT,BMCURQ,BMCSD,BMCBD,BMCURC,BMCVI,BMCVFLE

 +12       QUIT 

PROCR     ;

 +1        IF $PIECE($GET(^BMCREF(BMCRIEN,11)),U,25)]""

               QUIT 

PROCR1    ;

 +1        DO BROWSE

 +2        WRITE !!

           SET DA=BMCRIEN

           SET DIE="^BMCREF("

           SET DR="[BMC UTIL/MGD CARE]"

           DO DIE^BMCFMC

 +3        DO XIT

 +4        QUIT 

 +5       ;

BROWSE    ;

 +1        SET XBRP="DISP^BMCRD1"

 +2        SET XBRC=""

           SET XBRX=""

           SET XBIOP=0

           DO ^XBDBQUE

 +3       ;D VIEWR^XBLM("^BMCVLP")

 +4        QUIT 

XIT       ;EP

 +1        DO ^BMCKILL

 +2        KILL ^TMP("BMCRDSP",$JOB)

 +3        QUIT 

DISP      ;EP

 +1        DO EN^VALM("BMC RECORD DISPLAY")

 +2        DO CLEAR^VALM1

 +3        QUIT 

HDR       ; -- header code

 +1        SET VALMHDR(1)="User:  "_$PIECE(^VA(200,DUZ,0),U)

 +2        QUIT 

 +3       ;

INIT      ; -- init variables and list array

 +1        DO EP^BMCRD(BMCRIEN)

 +2        SET VALMCNT=$ORDER(^TMP("BMCRDSP",$JOB,""),-1)

 +3        QUIT 

 +4       ;

HELP      ; -- help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT 

 +3       ;

EXIT      ; -- exit code

 +1        QUIT