ANSDIC ;IHS/OIRM/DSD/CSC - FILEMAN INTERFACE UTILITY; [ 02/25/98 10:32 AM ]
;;3.0;NURSING PATIENT ACUITY;;APR 01, 1996
;;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(ANSOUT)
K DTOUT,DUOUT,ANSQUIT,ANSOUT
D ^DIC
S:$D(DUOUT) ANSQUIT=""
S:$D(DTOUT)!(X="^^") (ANSQUIT,ANSOUT)=""
K DIC,DA,DD,DR,DINUM,D,DLAYGO
Q
MIX ;EP;
Q:$D(ANSOUT)
K DTOUT,DUOUT,ANSQUIT,ANSOUT
D MIX^DIC1
S:$D(DTOUT)!$D(DUOUT)!(X="^^") (ANSQUIT,ANSOUT)=""
K DIC,DA,DD,DR,DINUM,D,DLAYGO
Q
IX ;EP;
Q:$D(ANSOUT)
K DTOUT,DUOUT,ANSQUIT,ANSOUT
D IX^DIC
S:$D(DTOUT)!$D(DUOUT)!(X="^^") (ANSQUIT,ANSOUT)=""
K DIC,DA,DD,DR,DINUM,D,DLAYGO
Q
DIE ;EP;
Q:$D(ANSOUT)
Q:'DA
K DTOUT,DUOUT,ANSQUIT,ANSOUT
L +@(DIE_DA_")"):4 I '$T S ANSQUIT="" Q:'$D(IOST)#2 W:$E(IOST,1,2)="C-" !!,"Entry being edited by another user. Please try Later.",! H 3 Q
S ANSDIEDA=DA
D ^DIE
L -@(DIE_ANSDIEDA_")"):0
I $D(DTOUT)!$D(DUOUT) S (ANSQUIT,ANSOUT)=""
K DIE,DA,DR,ANSDIEDA
Q
FILE ;EP;
K DD,DO,DTOUT,DUOUT,ANSQUIT,ANSOUT
D FILE^DICN
S:$D(DTOUT)!$D(DUOUT)!(X="^^") (ANSQUIT,ANSOUT)=""
K DIC,DA,DD,DR,DINUM,DLAYGO
Q
DIR ;EP;
I $D(ANSOUT) K DIR S Y="" Q
K DTOUT,DUOUT,ANSQUIT,ANSOUT
D ^DIR
S ANSY=Y
S:$D(DIRUT)!$D(DIROUT)!$D(DUOUT) ANSQUIT=1
S:X="^^"!$D(DTOUT) (ANSQUIT,ANSOUT)=1
K DIR,DIRUT,DIROUT
Q
DIK ;EP;
K DTOUT,DUOUT,ANSQUIT,ANSOUT
D ^DIK
K DIK
Q
IX1 ;EP;
Q:$D(ANSOUT)
K DTOUT,DUOUT,ANSQUIT,ANSOUT
D IX1^DIK
K DIK,DA
Q
DIQ1 ;EP;
D EN^DIQ1
K DIC,DA,DR,DIQ
Q
OBJ ;EP;TO SCREEN OBJECT CODES BY TYPE OF TRANSACTION
I $P(^AUTTOBJC(+Y,0),U,12)=1
E Q
Q:'$D(ANSLBDA)
Q:'$D(ANSDOCDA)
N ANSTXDA
S ANSTXDA=$P(^ANSDOC(ANSDOCDA,0),U,4)
Q:'ANSTXDA
Q:ANSTXDA=11
S ANSGREF="^AUTTOBJC"
G OBJ3:$D(ANSSTOCK)
OBJ1 I $D(^ANSTXTYP(ANSTXDA,10,+Y))
G OBJ4:ANSTXDA=1
Q
OBJ3 I $P(^AUTTOBJC(+Y,0),U,8)="S" Q
Q
OBJ4 ;
Q
CAN Q:ANSLBDA<1
I $D(^ANSLOCB("CAN",+Y,ANSLBDA))!$D(^ANSLOCB("DCAN",+Y,ANSLBDA))
Q
PAUSE ;EP;
Q:$E(IOST,1,2)'="C-"
K DIR
P1 ;EP;
W !
S DIR(0)="EOA",DIR("A")="Press RETURN to continue or '^' to exit. "
S:X="^" DN=0,ANSOUT=""
D DIR^ANSDIC
Q
ANSDIC ;IHS/OIRM/DSD/CSC - FILEMAN INTERFACE UTILITY; [ 02/25/98 10:32 AM ]
+1 ;;3.0;NURSING PATIENT ACUITY;;APR 01, 1996
+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(ANSOUT)
QUIT
+2 KILL DTOUT,DUOUT,ANSQUIT,ANSOUT
+3 DO ^DIC
+4 IF $DATA(DUOUT)
SET ANSQUIT=""
+5 IF $DATA(DTOUT)!(X="^^")
SET (ANSQUIT,ANSOUT)=""
+6 KILL DIC,DA,DD,DR,DINUM,D,DLAYGO
+7 QUIT
MIX ;EP;
+1 IF $DATA(ANSOUT)
QUIT
+2 KILL DTOUT,DUOUT,ANSQUIT,ANSOUT
+3 DO MIX^DIC1
+4 IF $DATA(DTOUT)!$DATA(DUOUT)!(X="^^")
SET (ANSQUIT,ANSOUT)=""
+5 KILL DIC,DA,DD,DR,DINUM,D,DLAYGO
+6 QUIT
IX ;EP;
+1 IF $DATA(ANSOUT)
QUIT
+2 KILL DTOUT,DUOUT,ANSQUIT,ANSOUT
+3 DO IX^DIC
+4 IF $DATA(DTOUT)!$DATA(DUOUT)!(X="^^")
SET (ANSQUIT,ANSOUT)=""
+5 KILL DIC,DA,DD,DR,DINUM,D,DLAYGO
+6 QUIT
DIE ;EP;
+1 IF $DATA(ANSOUT)
QUIT
+2 IF 'DA
QUIT
+3 KILL DTOUT,DUOUT,ANSQUIT,ANSOUT
+4 LOCK +@(DIE_DA_")"):4
IF '$TEST
SET ANSQUIT=""
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 ANSDIEDA=DA
+6 DO ^DIE
+7 LOCK -@(DIE_ANSDIEDA_")"):0
+8 IF $DATA(DTOUT)!$DATA(DUOUT)
SET (ANSQUIT,ANSOUT)=""
+9 KILL DIE,DA,DR,ANSDIEDA
+10 QUIT
FILE ;EP;
+1 KILL DD,DO,DTOUT,DUOUT,ANSQUIT,ANSOUT
+2 DO FILE^DICN
+3 IF $DATA(DTOUT)!$DATA(DUOUT)!(X="^^")
SET (ANSQUIT,ANSOUT)=""
+4 KILL DIC,DA,DD,DR,DINUM,DLAYGO
+5 QUIT
DIR ;EP;
+1 IF $DATA(ANSOUT)
KILL DIR
SET Y=""
QUIT
+2 KILL DTOUT,DUOUT,ANSQUIT,ANSOUT
+3 DO ^DIR
+4 SET ANSY=Y
+5 IF $DATA(DIRUT)!$DATA(DIROUT)!$DATA(DUOUT)
SET ANSQUIT=1
+6 IF X="^^"!$DATA(DTOUT)
SET (ANSQUIT,ANSOUT)=1
+7 KILL DIR,DIRUT,DIROUT
+8 QUIT
DIK ;EP;
+1 KILL DTOUT,DUOUT,ANSQUIT,ANSOUT
+2 DO ^DIK
+3 KILL DIK
+4 QUIT
IX1 ;EP;
+1 IF $DATA(ANSOUT)
QUIT
+2 KILL DTOUT,DUOUT,ANSQUIT,ANSOUT
+3 DO IX1^DIK
+4 KILL DIK,DA
+5 QUIT
DIQ1 ;EP;
+1 DO EN^DIQ1
+2 KILL DIC,DA,DR,DIQ
+3 QUIT
OBJ ;EP;TO SCREEN OBJECT CODES BY TYPE OF TRANSACTION
+1 IF $PIECE(^AUTTOBJC(+Y,0),U,12)=1
+2 IF '$TEST
QUIT
+3 IF '$DATA(ANSLBDA)
QUIT
+4 IF '$DATA(ANSDOCDA)
QUIT
+5 NEW ANSTXDA
+6 SET ANSTXDA=$PIECE(^ANSDOC(ANSDOCDA,0),U,4)
+7 IF 'ANSTXDA
QUIT
+8 IF ANSTXDA=11
QUIT
+9 SET ANSGREF="^AUTTOBJC"
+10 IF $DATA(ANSSTOCK)
GOTO OBJ3
OBJ1 IF $DATA(^ANSTXTYP(ANSTXDA,10,+Y))
+1 IF ANSTXDA=1
GOTO OBJ4
+2 QUIT
OBJ3 IF $PIECE(^AUTTOBJC(+Y,0),U,8)="S"
QUIT
+1 QUIT
OBJ4 ;
+1 QUIT
CAN IF ANSLBDA<1
QUIT
+1 IF $DATA(^ANSLOCB("CAN",+Y,ANSLBDA))!$DATA(^ANSLOCB("DCAN",+Y,ANSLBDA))
+2 QUIT
PAUSE ;EP;
+1 IF $EXTRACT(IOST,1,2)'="C-"
QUIT
+2 KILL DIR
P1 ;EP;
+1 WRITE !
+2 SET DIR(0)="EOA"
SET DIR("A")="Press RETURN to continue or '^' to exit. "
+3 IF X="^"
SET DN=0
SET ANSOUT=""
+4 DO DIR^ANSDIC
+5 QUIT
