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
