BMCFACE.m

BMCFACE ; IHS/PHXAO/TMJ - print face sheet ffrom screenman ;

 ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006

 ;

START ;

 K BMCQUIT

 W:$D(IOF) @IOF

 D DIR

 G:$D(BMCQUIT) XIT

 S DFN=BMCDFN

 D ZIS

 D XIT

 D REFRESH

 Q

DIR ;call to XBDBQUE

 NEW DDS,DIR0,DA,DIE

 K BMCOPT

 W ! S DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen",DIR("A")="Do you wish to",DIR("B")="P" K DA D ^DIR K DIR

 I $D(DIRUT) S BMCQUIT="" Q

 S BMCOPT=Y

 Q

ZIS ;

 NEW DDS,DIR0,DA,DIE

 I $G(BMCOPT)="B" D BROWSE Q

 S XBRP="START^AGFACE",XBRC="PROC^BMCFACE",XBRX="XIT^BMCFACE",XBNS="DFN"

 D ^XBDBQUE

 Q

BROWSE ;

 S XBRP="VIEWR^XBLM(""START^AGFACE"")"

 S XBRC="PROC^BMCFACE",XBRX="XIT^BMCFACE",XBIOP=0 D ^XBDBQUE

 Q

XIT ;

 K AGOPT

 Q

REFRESH ;

 S X=0 X ^%ZOSF("RM")

 W $P(DDGLVID,DDGLDEL,8)

 D REFRESH^DDSUTL

PROC ;

 Q

BMCFACE   ; IHS/PHXAO/TMJ - print face sheet ffrom screenman ;

 +1       ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006

 +2       ;

START     ;

 +1        KILL BMCQUIT

 +2        IF $DATA(IOF)

               WRITE @IOF

 +3        DO DIR

 +4        IF $DATA(BMCQUIT)

               GOTO XIT

 +5        SET DFN=BMCDFN

 +6        DO ZIS

 +7        DO XIT

 +8        DO REFRESH

 +9        QUIT 

DIR       ;call to XBDBQUE

 +1        NEW DDS,DIR0,DA,DIE

 +2        KILL BMCOPT

 +3        WRITE !

           SET DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen"

           SET DIR("A")="Do you wish to"

           SET DIR("B")="P"

           KILL DA

           DO ^DIR

           KILL DIR

 +4        IF $DATA(DIRUT)

               SET BMCQUIT=""

               QUIT 

 +5        SET BMCOPT=Y

 +6        QUIT 

ZIS       ;

 +1        NEW DDS,DIR0,DA,DIE

 +2        IF $GET(BMCOPT)="B"

               DO BROWSE

               QUIT 

 +3        SET XBRP="START^AGFACE"

           SET XBRC="PROC^BMCFACE"

           SET XBRX="XIT^BMCFACE"

           SET XBNS="DFN"

 +4        DO ^XBDBQUE

 +5        QUIT 

BROWSE    ;

 +1        SET XBRP="VIEWR^XBLM(""START^AGFACE"")"

 +2        SET XBRC="PROC^BMCFACE"

           SET XBRX="XIT^BMCFACE"

           SET XBIOP=0

           DO ^XBDBQUE

 +3        QUIT 

XIT       ;

 +1        KILL AGOPT

 +2        QUIT 

REFRESH   ;

 +1        SET X=0

           XECUTE ^%ZOSF("RM")

 +2        WRITE $PIECE(DDGLVID,DDGLDEL,8)

 +3        DO REFRESH^DDSUTL

PROC      ;

 +1        QUIT