BDMFDIC.m

BDMFDIC ; IHS/CMI/LAB - FILEMAN INTERFACE UTILITY ; [ 02/02/2009 10:33 AM ]

 ;;2.0;DIABETES MANAGEMENT SYSTEM;**2**;JUN 14, 2007

 ;;UTILITY ROUTINE USED TO MANAGE ALL INTERFACE TO FILEMAN

 ;;WITH FEW EXCEPTIONS, THIS IS THE ONLY PLACE IN ARMS FROM WHICH

 ;;FILEMAN ENTRY POINTS ARE CALLED

DIC ;EP;

 Q:$D(BDMOUT)

 K DTOUT,DUOUT,BDMQUIT,BDMOUT

 D ^DIC

 S:$D(DUOUT) BDMQUIT=""

 S:$D(DTOUT)!(X="^^") (BDMQUIT,BDMOUT)=""

 K DIC,DA,DD,DR,DINUM,D,DLAYGO,DIADD

 Q

MIX ;EP;

 Q:$D(BDMOUT)

 K DTOUT,DUOUT,BDMQUIT,BDMOUT

 D MIX^DIC1

 S:$D(DTOUT)!$D(DUOUT)!(X="^^") (BDMQUIT,BDMOUT)=""

 K DIC,DA,DD,DR,DINUM,D,DLAYGO

 Q

IX ;EP;

 Q:$D(BDMOUT)

 K DTOUT,DUOUT,BDMQUIT,BDMOUT

 D IX^DIC

 S:$D(DTOUT)!$D(DUOUT)!(X="^^") (BDMQUIT,BDMOUT)=""

 K DIC,DA,DD,DR,DINUM,D,DLAYGO

 Q

DIE ;EP;

 Q:$D(BDMOUT)

 Q:'DA

 K DTOUT,DUOUT,BDMQUIT,BDMOUT

 L +@(DIE_DA_")"):4 I '$T S BDMQUIT="" Q:'$D(IOST)#2  W:$E(IOST,1,2)="C-" !!,"Entry being edited by another user.  Please try Later.",! H 3 Q

 S BDMDIEDA=DA

 D ^DIE

 L -@(DIE_BDMDIEDA_")"):0

 I $D(DTOUT)!$D(DUOUT) S (BDMQUIT,BDMOUT)=""

 K DIE,DA,DR,BDMDIEDA

 Q

DDS ;EP;FOR SCREENMAN CALLS

 S DDSFILE=DIE

 D ^DDS

 K DDSFILE,BDMSCREN

 Q

FILE ;EP;

 K DD,DO,DTOUT,DUOUT,BDMQUIT,BDMOUT

 D FILE^DICN

 S:$D(DTOUT)!$D(DUOUT)!(X="^^") (BDMQUIT,BDMOUT)=""

 K DIC,DA,DD,DR,DINUM,DLAYGO

 Q

DIR ;EP;

 I $D(BDMOUT) K DIR S Y="" Q

 K DTOUT,DUOUT,BDMQUIT,BDMOUT

 D ^DIR

 S BDMY=Y

 S:$D(DIRUT)!$D(DIROUT)!$D(DUOUT) BDMQUIT=""

 S:X="^^"!$D(DTOUT) (BDMQUIT,BDMOUT)=""

 K DIR,DIRUT,DIROUT,DUOUT,DTOUT

 Q

DIK ;EP;

 K DTOUT,DUOUT,BDMQUIT,BDMOUT

 D ^DIK

 K DIK

 Q

IX1 ;EP;

 Q:$D(BDMOUT)

 K DTOUT,DUOUT,BDMQUIT,BDMOUT

 D IX1^DIK

 K DIK,DA

 Q

DIQ1 ;EP;

 D EN^DIQ1

 K DIC,DA,DR,DIQ

 Q

WP ;EP;TO BROWSE WORD PROCESSING FIELD

 Q:'$D(BDMFILE)#2!'$D(BDMIEN)#2!'$D(BDMFIELD)

 K BDMSCREN

 D WP^DDBR(BDMFILE,BDMIEN,BDMFIELD,"N",$G(BDMTITLE))

 Q

DICS() ;EP TO SET DIC("S") FOR CAN LOOKUP FOR SUPPLIES/SERVICES

 S DIC("S")="Q:'$G(BDMLBDA)!'$G(BDMDOCDA)  I $D(^BDMLOCB(""DCAN"",+Y,BDMLBDA))!$D(^BDMLOCB(""OCAN"",+Y,BDMLBDA))!($P($G(^BDMDOC(BDMDOCDA,0)),U,4)=36!($P($G(^(0)),U,4)=37)&($D(^BDMLOCB(""DCAN"",+Y))))"

 Q DIC("S")

QUIT() ;EP;TO CHECK FOR PROGRAM QUIT AND OUT CONTROL VARIABLES

 I $D(BDMQUIT)!$D(BDMOUT)

 Q $T

BDMFDIC   ; IHS/CMI/LAB - FILEMAN INTERFACE UTILITY ; [ 02/02/2009 10:33 AM ]

 +1       ;;2.0;DIABETES MANAGEMENT SYSTEM;**2**;JUN 14, 2007

 +2       ;;UTILITY ROUTINE USED TO MANAGE ALL INTERFACE TO FILEMAN

 +3       ;;WITH FEW EXCEPTIONS, THIS IS THE ONLY PLACE IN ARMS FROM WHICH

 +4       ;;FILEMAN ENTRY POINTS ARE CALLED

DIC       ;EP;

 +1        IF $DATA(BDMOUT)

               QUIT 

 +2        KILL DTOUT,DUOUT,BDMQUIT,BDMOUT

 +3        DO ^DIC

 +4        IF $DATA(DUOUT)

               SET BDMQUIT=""

 +5        IF $DATA(DTOUT)!(X="^^")

               SET (BDMQUIT,BDMOUT)=""

 +6        KILL DIC,DA,DD,DR,DINUM,D,DLAYGO,DIADD

 +7        QUIT 

MIX       ;EP;

 +1        IF $DATA(BDMOUT)

               QUIT 

 +2        KILL DTOUT,DUOUT,BDMQUIT,BDMOUT

 +3        DO MIX^DIC1

 +4        IF $DATA(DTOUT)!$DATA(DUOUT)!(X="^^")

               SET (BDMQUIT,BDMOUT)=""

 +5        KILL DIC,DA,DD,DR,DINUM,D,DLAYGO

 +6        QUIT 

IX        ;EP;

 +1        IF $DATA(BDMOUT)

               QUIT 

 +2        KILL DTOUT,DUOUT,BDMQUIT,BDMOUT

 +3        DO IX^DIC

 +4        IF $DATA(DTOUT)!$DATA(DUOUT)!(X="^^")

               SET (BDMQUIT,BDMOUT)=""

 +5        KILL DIC,DA,DD,DR,DINUM,D,DLAYGO

 +6        QUIT 

DIE       ;EP;

 +1        IF $DATA(BDMOUT)

               QUIT 

 +2        IF 'DA

               QUIT 

 +3        KILL DTOUT,DUOUT,BDMQUIT,BDMOUT

 +4        LOCK +@(DIE_DA_")"):4

           IF '$TEST

               SET BDMQUIT=""

               IF '$DATA(IOST)#2

                   QUIT 

               IF $EXTRACT(IOST,1,2)="C-"

                   WRITE !!,"Entry being edited by another user.  Please try Later.",!

               HANG 3

               QUIT 

 +5        SET BDMDIEDA=DA

 +6        DO ^DIE

 +7        LOCK -@(DIE_BDMDIEDA_")"):0

 +8        IF $DATA(DTOUT)!$DATA(DUOUT)

               SET (BDMQUIT,BDMOUT)=""

 +9        KILL DIE,DA,DR,BDMDIEDA

 +10       QUIT 

DDS       ;EP;FOR SCREENMAN CALLS

 +1        SET DDSFILE=DIE

 +2        DO ^DDS

 +3        KILL DDSFILE,BDMSCREN

 +4        QUIT 

FILE      ;EP;

 +1        KILL DD,DO,DTOUT,DUOUT,BDMQUIT,BDMOUT

 +2        DO FILE^DICN

 +3        IF $DATA(DTOUT)!$DATA(DUOUT)!(X="^^")

               SET (BDMQUIT,BDMOUT)=""

 +4        KILL DIC,DA,DD,DR,DINUM,DLAYGO

 +5        QUIT 

DIR       ;EP;

 +1        IF $DATA(BDMOUT)

               KILL DIR

               SET Y=""

               QUIT 

 +2        KILL DTOUT,DUOUT,BDMQUIT,BDMOUT

 +3        DO ^DIR

 +4        SET BDMY=Y

 +5        IF $DATA(DIRUT)!$DATA(DIROUT)!$DATA(DUOUT)

               SET BDMQUIT=""

 +6        IF X="^^"!$DATA(DTOUT)

               SET (BDMQUIT,BDMOUT)=""

 +7        KILL DIR,DIRUT,DIROUT,DUOUT,DTOUT

 +8        QUIT 

DIK       ;EP;

 +1        KILL DTOUT,DUOUT,BDMQUIT,BDMOUT

 +2        DO ^DIK

 +3        KILL DIK

 +4        QUIT 

IX1       ;EP;

 +1        IF $DATA(BDMOUT)

               QUIT 

 +2        KILL DTOUT,DUOUT,BDMQUIT,BDMOUT

 +3        DO IX1^DIK

 +4        KILL DIK,DA

 +5        QUIT 

DIQ1      ;EP;

 +1        DO EN^DIQ1

 +2        KILL DIC,DA,DR,DIQ

 +3        QUIT 

WP        ;EP;TO BROWSE WORD PROCESSING FIELD

 +1        IF '$DATA(BDMFILE)#2!'$DATA(BDMIEN)#2!'$DATA(BDMFIELD)

               QUIT 

 +2        KILL BDMSCREN

 +3        DO WP^DDBR(BDMFILE,BDMIEN,BDMFIELD,"N",$GET(BDMTITLE))

 +4        QUIT 

DICS()    ;EP TO SET DIC("S") FOR CAN LOOKUP FOR SUPPLIES/SERVICES

 +1        SET DIC("S")="Q:'$G(BDMLBDA)!'$G(BDMDOCDA)  I $D(^BDMLOCB(""DCAN"",+Y,BDMLBDA))!$D(^BDMLOCB(""OCAN"",+Y,BDMLBDA))!($P($G(^BDMDOC(BDMDOCDA,0)),U,4)=36!($P($G(^(0)),U,4)=37)&($D(^BDMLOCB(""DCAN"",+Y))))"

 +2        QUIT DIC("S")

QUIT()    ;EP;TO CHECK FOR PROGRAM QUIT AND OUT CONTROL VARIABLES

 +1        IF $DATA(BDMQUIT)!$DATA(BDMOUT)

 +2        QUIT $TEST