ACRFDIC ;IHS/OIRM/DSD/THL,AEF - FILEMAN INTERFACE UTILITY; [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
;;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(ACROUT)
K DTOUT,DUOUT,ACRQUIT,ACROUT
D ^DIC
S:$D(DUOUT) ACRQUIT=""
S:$D(DTOUT)!(X="^^") (ACRQUIT,ACROUT)=""
K DIC,DA,DD,DR,DINUM,D,DLAYGO
Q
MIX ;EP;
Q:$D(ACROUT)
K DTOUT,DUOUT,ACRQUIT,ACROUT
D MIX^DIC1
S:$D(DTOUT)!$D(DUOUT)!(X="^^") (ACRQUIT,ACROUT)=""
K DIC,DA,DD,DR,DINUM,D,DLAYGO
Q
IX ;EP;
Q:$D(ACROUT)
K DTOUT,DUOUT,ACRQUIT,ACROUT
D IX^DIC
S:$D(DTOUT)!$D(DUOUT)!(X="^^") (ACRQUIT,ACROUT)=""
K DIC,DA,DD,DR,DINUM,D,DLAYGO
Q
DIE ;EP;
Q:$D(ACROUT)
Q:'DA
K DTOUT,DUOUT,ACRQUIT,ACROUT
L +@(DIE_DA_")"):4 I '$T S ACRQUIT="" Q:'$D(IOST)#2 W:$E(IOST,1,2)="C-" !!,"Entry being edited by another user. Please try Later.",! H 3 Q
S ACRDIEDA=DA
D ^DIE
L -@(DIE_ACRDIEDA_")"):0
I $D(DTOUT)!$D(DUOUT) S (ACRQUIT,ACROUT)=""
K DIE,DA,DR,ACRDIEDA
Q
DDS ;EP;FOR SCREENMAN CALLS
D SCREEN^ACRFAU
I '$D(ACRSCREN)!'$D(^DIST(.403,"B",$TR(DR,"[]",""))) S ACRSCREN="" Q
S DDSFILE=DIE
D ^DDS
K DDSFILE,ACRSCREN
Q
FILE ;EP;
K DD,DO,DTOUT,DUOUT,ACRQUIT,ACROUT
D FILE^DICN
S:$D(DTOUT)!$D(DUOUT)!(X="^^") (ACRQUIT,ACROUT)=""
K DIC,DA,DD,DR,DINUM,DLAYGO
Q
DIR ;EP;
I $D(ACROUT) K DIR S Y="" Q
K DTOUT,DUOUT,ACRQUIT,ACROUT
D ^DIR
S ACRY=Y
S:$D(DIRUT)!$D(DIROUT)!$D(DUOUT) ACRQUIT=""
S:X="^^"!$D(DTOUT) (ACRQUIT,ACROUT)=""
K DIR,DIRUT,DIROUT,DUOUT,DTOUT
Q
DIK ;EP;
K DTOUT,DUOUT,ACRQUIT,ACROUT
D ^DIK
K DIK
Q
IX1 ;EP;
Q:$D(ACROUT)
K DTOUT,DUOUT,ACRQUIT,ACROUT
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(ACRFILE)#2!'$D(ACRIEN)#2!'$D(ACRFIELD)
D SCREEN^ACRFAU
I '$D(ACRSCREN) S ACRSCREN="" Q
K ACRSCREN
D WP^DDBR(ACRFILE,ACRIEN,ACRFIELD,"N",$G(ACRTITLE))
Q
OBJ ;EP;TO SCREEN OBJECT CODES BY TYPE OF TRANSACTION
Q:'$D(ACRLBDA)
Q:'$D(ACRDOCDA)
I $P($G(^AUTTOBJC(+$G(Y),0)),U,12)=1
E Q
N ACRTXDA
S ACRTXDA=$P(^ACRDOC(ACRDOCDA,0),U,4)
Q:'ACRTXDA
Q:ACRTXDA=11
S ACRGREF="^AUTTOBJC"
G OBJ3:$D(ACRSTOCK)
OBJ1 I $D(^ACRTXTYP(ACRTXDA,10,+Y))
Q
OBJ3 I $P(^AUTTOBJC(+Y,0),U,8)="S" Q
Q
CAN Q:$G(ACRLBDA)<1
I $D(^ACRLOCB("CAN",+Y,ACRLBDA))!$D(^ACRLOCB("DCAN",+Y,ACRLBDA))
Q
DICS() ;EP TO SET DIC("S") FOR CAN LOOKUP FOR SUPPLIES/SERVICES
S DIC("S")="Q:'$G(ACRLBDA)!'$G(ACRDOCDA) I $D(^ACRLOCB(""DCAN"",+Y,ACRLBDA))!$D(^ACRLOCB(""OCAN"",+Y,ACRLBDA))!($P($G(^ACRDOC(ACRDOCDA,0)),U,4)=36!($P($G(^(0)),U,4)=37)&($D(^ACRLOCB(""DCAN"",+Y))))"
Q DIC("S")
LBCAN() ;EP TO WRITE THE DEFAULT CAN FOR THE DEPARTMENT ACCOUNT
S Y=$P($G(^AUTTCAN(+$P($G(^ACRLOCB(+$G(D0),"DT")),U,9),0)),U)
Q ""
SSDA() ;EP TO WRITE DEPARTMENT ACCOUNT CAN
S Y=$P($G(^AUTTCAN(+$P($G(^ACRLOCB(+$P($G(^ACRSS(+$G(DA),0)),U,6),"DT")),U,9),0)),U)
Q ""
ACRFDIC ;IHS/OIRM/DSD/THL,AEF - FILEMAN INTERFACE UTILITY; [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
+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(ACROUT)
QUIT
+2 KILL DTOUT,DUOUT,ACRQUIT,ACROUT
+3 DO ^DIC
+4 IF $DATA(DUOUT)
SET ACRQUIT=""
+5 IF $DATA(DTOUT)!(X="^^")
SET (ACRQUIT,ACROUT)=""
+6 KILL DIC,DA,DD,DR,DINUM,D,DLAYGO
+7 QUIT
MIX ;EP;
+1 IF $DATA(ACROUT)
QUIT
+2 KILL DTOUT,DUOUT,ACRQUIT,ACROUT
+3 DO MIX^DIC1
+4 IF $DATA(DTOUT)!$DATA(DUOUT)!(X="^^")
SET (ACRQUIT,ACROUT)=""
+5 KILL DIC,DA,DD,DR,DINUM,D,DLAYGO
+6 QUIT
IX ;EP;
+1 IF $DATA(ACROUT)
QUIT
+2 KILL DTOUT,DUOUT,ACRQUIT,ACROUT
+3 DO IX^DIC
+4 IF $DATA(DTOUT)!$DATA(DUOUT)!(X="^^")
SET (ACRQUIT,ACROUT)=""
+5 KILL DIC,DA,DD,DR,DINUM,D,DLAYGO
+6 QUIT
DIE ;EP;
+1 IF $DATA(ACROUT)
QUIT
+2 IF 'DA
QUIT
+3 KILL DTOUT,DUOUT,ACRQUIT,ACROUT
+4 LOCK +@(DIE_DA_")"):4
IF '$TEST
SET ACRQUIT=""
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 ACRDIEDA=DA
+6 DO ^DIE
+7 LOCK -@(DIE_ACRDIEDA_")"):0
+8 IF $DATA(DTOUT)!$DATA(DUOUT)
SET (ACRQUIT,ACROUT)=""
+9 KILL DIE,DA,DR,ACRDIEDA
+10 QUIT
DDS ;EP;FOR SCREENMAN CALLS
+1 DO SCREEN^ACRFAU
+2 IF '$DATA(ACRSCREN)!'$DATA(^DIST(.403,"B",$TRANSLATE(DR,"[]","")))
SET ACRSCREN=""
QUIT
+3 SET DDSFILE=DIE
+4 DO ^DDS
+5 KILL DDSFILE,ACRSCREN
+6 QUIT
FILE ;EP;
+1 KILL DD,DO,DTOUT,DUOUT,ACRQUIT,ACROUT
+2 DO FILE^DICN
+3 IF $DATA(DTOUT)!$DATA(DUOUT)!(X="^^")
SET (ACRQUIT,ACROUT)=""
+4 KILL DIC,DA,DD,DR,DINUM,DLAYGO
+5 QUIT
DIR ;EP;
+1 IF $DATA(ACROUT)
KILL DIR
SET Y=""
QUIT
+2 KILL DTOUT,DUOUT,ACRQUIT,ACROUT
+3 DO ^DIR
+4 SET ACRY=Y
+5 IF $DATA(DIRUT)!$DATA(DIROUT)!$DATA(DUOUT)
SET ACRQUIT=""
+6 IF X="^^"!$DATA(DTOUT)
SET (ACRQUIT,ACROUT)=""
+7 KILL DIR,DIRUT,DIROUT,DUOUT,DTOUT
+8 QUIT
DIK ;EP;
+1 KILL DTOUT,DUOUT,ACRQUIT,ACROUT
+2 DO ^DIK
+3 KILL DIK
+4 QUIT
IX1 ;EP;
+1 IF $DATA(ACROUT)
QUIT
+2 KILL DTOUT,DUOUT,ACRQUIT,ACROUT
+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(ACRFILE)#2!'$DATA(ACRIEN)#2!'$DATA(ACRFIELD)
QUIT
+2 DO SCREEN^ACRFAU
+3 IF '$DATA(ACRSCREN)
SET ACRSCREN=""
QUIT
+4 KILL ACRSCREN
+5 DO WP^DDBR(ACRFILE,ACRIEN,ACRFIELD,"N",$GET(ACRTITLE))
+6 QUIT
OBJ ;EP;TO SCREEN OBJECT CODES BY TYPE OF TRANSACTION
+1 IF '$DATA(ACRLBDA)
QUIT
+2 IF '$DATA(ACRDOCDA)
QUIT
+3 IF $PIECE($GET(^AUTTOBJC(+$GET(Y),0)),U,12)=1
+4 IF '$TEST
QUIT
+5 NEW ACRTXDA
+6 SET ACRTXDA=$PIECE(^ACRDOC(ACRDOCDA,0),U,4)
+7 IF 'ACRTXDA
QUIT
+8 IF ACRTXDA=11
QUIT
+9 SET ACRGREF="^AUTTOBJC"
+10 IF $DATA(ACRSTOCK)
GOTO OBJ3
OBJ1 IF $DATA(^ACRTXTYP(ACRTXDA,10,+Y))
+1 QUIT
OBJ3 IF $PIECE(^AUTTOBJC(+Y,0),U,8)="S"
QUIT
+1 QUIT
CAN IF $GET(ACRLBDA)<1
QUIT
+1 IF $DATA(^ACRLOCB("CAN",+Y,ACRLBDA))!$DATA(^ACRLOCB("DCAN",+Y,ACRLBDA))
+2 QUIT
DICS() ;EP TO SET DIC("S") FOR CAN LOOKUP FOR SUPPLIES/SERVICES
+1 SET DIC("S")="Q:'$G(ACRLBDA)!'$G(ACRDOCDA) I $D(^ACRLOCB(""DCAN"",+Y,ACRLBDA))!$D(^ACRLOCB(""OCAN"",+Y,ACRLBDA))!($P($G(^ACRDOC(ACRDOCDA,0)),U,4)=36!($P($G(^(0)),U,4)=37)&($D(^ACRLOCB(""DCAN"",+Y))))"
+2 QUIT DIC("S")
LBCAN() ;EP TO WRITE THE DEFAULT CAN FOR THE DEPARTMENT ACCOUNT
+1 SET Y=$PIECE($GET(^AUTTCAN(+$PIECE($GET(^ACRLOCB(+$GET(D0),"DT")),U,9),0)),U)
+2 QUIT ""
SSDA() ;EP TO WRITE DEPARTMENT ACCOUNT CAN
+1 SET Y=$PIECE($GET(^AUTTCAN(+$PIECE($GET(^ACRLOCB(+$PIECE($GET(^ACRSS(+$GET(DA),0)),U,6),"DT")),U,9),0)),U)
+2 QUIT ""
