BMCRDSP.m

BMCRDSP ; IHS/PHXAO/TMJ - OPTION TO DISPLAY REFERRAL ;      [ 09/27/2006  2:03 PM ]

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

 ;

START ;

 D GETREF

 Q:BMCQ

 ;

START2 ;EP To Display a Referral Record

 D BROWSE

 D XIT

 Q

 ;

GETREF ; GET REFERRAL

 S BMCQ=1

 W !

 ;BMC*4.0*1 4.15.06 IHS/OIT/FCJ CHANGED NXT SECTION TO DSP LIFO

 ;S DIC="^BMCREF(",DIC(0)="AEMQ",DIC("A")="Select RCIS REFERRAL by Patient or by Referral Date or #: "

 ;D DIC^BMCFMC

 ;Q:Y<1

 ;S BMCRIEN=+Y

 D START^BMCLKID2

 Q:'$G(BMCRIEN)

 Q:'$D(^BMCREF(BMCRIEN))  ;BMC*4.0*8

 S ^DISV(DUZ,"^BMCREF(")=BMCRIEN

 ;BMC*4.0*1 4.15.06 IHS/OIT/FCJ END OF CHANGES

 S BMCQ=0

 Q

 ;

BROWSE ;

 S XBRP="DISP^BMCRD1"

 S XBRC="",XBRX="XIT^BMCRD1",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

BMCRDSP   ; IHS/PHXAO/TMJ - OPTION TO DISPLAY REFERRAL ;      [ 09/27/2006  2:03 PM ]

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

 +2       ;

START     ;

 +1        DO GETREF

 +2        IF BMCQ

               QUIT 

 +3       ;

START2    ;EP To Display a Referral Record

 +1        DO BROWSE

 +2        DO XIT

 +3        QUIT 

 +4       ;

GETREF    ; GET REFERRAL

 +1        SET BMCQ=1

 +2        WRITE !

 +3       ;BMC*4.0*1 4.15.06 IHS/OIT/FCJ CHANGED NXT SECTION TO DSP LIFO

 +4       ;S DIC="^BMCREF(",DIC(0)="AEMQ",DIC("A")="Select RCIS REFERRAL by Patient or by Referral Date or #: "

 +5       ;D DIC^BMCFMC

 +6       ;Q:Y<1

 +7       ;S BMCRIEN=+Y

 +8        DO START^BMCLKID2

 +9        IF '$GET(BMCRIEN)

               QUIT 

 +10      ;BMC*4.0*8

           IF '$DATA(^BMCREF(BMCRIEN))

               QUIT 

 +11       SET ^DISV(DUZ,"^BMCREF(")=BMCRIEN

 +12      ;BMC*4.0*1 4.15.06 IHS/OIT/FCJ END OF CHANGES

 +13       SET BMCQ=0

 +14       QUIT 

 +15      ;

BROWSE    ;

 +1        SET XBRP="DISP^BMCRD1"

 +2        SET XBRC=""

           SET XBRX="XIT^BMCRD1"

           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