Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACRFDIC

ACRFDIC.m

Go to the documentation of this file. 
  1. 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
  1.  ;;UTILITY ROUTINE USED TO MANAGE ALL INTERFACE TO FILEMAN
  1.  ;;WITH FEW EXCEPTIONS, THIS IS THE ONLY PLACE IN ARMS FROM WHICH
  1.  ;;FILEMAN ENTRY POINTS ARE CALLED
  1. DIC ;EP;
  1.  Q:$D(ACROUT)
  1.  K DTOUT,DUOUT,ACRQUIT,ACROUT
  1.  D ^DIC
  1.  S:$D(DUOUT) ACRQUIT=""
  1.  S:$D(DTOUT)!(X="^^") (ACRQUIT,ACROUT)=""
  1.  K DIC,DA,DD,DR,DINUM,D,DLAYGO
  1.  Q
  1. MIX ;EP;
  1.  Q:$D(ACROUT)
  1.  K DTOUT,DUOUT,ACRQUIT,ACROUT
  1.  D MIX^DIC1
  1.  S:$D(DTOUT)!$D(DUOUT)!(X="^^") (ACRQUIT,ACROUT)=""
  1.  K DIC,DA,DD,DR,DINUM,D,DLAYGO
  1.  Q
  1. IX ;EP;
  1.  Q:$D(ACROUT)
  1.  K DTOUT,DUOUT,ACRQUIT,ACROUT
  1.  D IX^DIC
  1.  S:$D(DTOUT)!$D(DUOUT)!(X="^^") (ACRQUIT,ACROUT)=""
  1.  K DIC,DA,DD,DR,DINUM,D,DLAYGO
  1.  Q
  1. DIE ;EP;
  1.  Q:$D(ACROUT)
  1.  Q:'DA
  1.  K DTOUT,DUOUT,ACRQUIT,ACROUT
  1.  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
  1.  S ACRDIEDA=DA
  1.  D ^DIE
  1.  L -@(DIE_ACRDIEDA_")"):0
  1.  I $D(DTOUT)!$D(DUOUT) S (ACRQUIT,ACROUT)=""
  1.  K DIE,DA,DR,ACRDIEDA
  1.  Q
  1. DDS ;EP;FOR SCREENMAN CALLS
  1.  D SCREEN^ACRFAU
  1.  I '$D(ACRSCREN)!'$D(^DIST(.403,"B",$TR(DR,"[]",""))) S ACRSCREN="" Q
  1.  S DDSFILE=DIE
  1.  D ^DDS
  1.  K DDSFILE,ACRSCREN
  1.  Q
  1. FILE ;EP;
  1.  K DD,DO,DTOUT,DUOUT,ACRQUIT,ACROUT
  1.  D FILE^DICN
  1.  S:$D(DTOUT)!$D(DUOUT)!(X="^^") (ACRQUIT,ACROUT)=""
  1.  K DIC,DA,DD,DR,DINUM,DLAYGO
  1.  Q
  1. DIR ;EP;
  1.  I $D(ACROUT) K DIR S Y="" Q
  1.  K DTOUT,DUOUT,ACRQUIT,ACROUT
  1.  D ^DIR
  1.  S ACRY=Y
  1.  S:$D(DIRUT)!$D(DIROUT)!$D(DUOUT) ACRQUIT=""
  1.  S:X="^^"!$D(DTOUT) (ACRQUIT,ACROUT)=""
  1.  K DIR,DIRUT,DIROUT,DUOUT,DTOUT
  1.  Q
  1. DIK ;EP;
  1.  K DTOUT,DUOUT,ACRQUIT,ACROUT
  1.  D ^DIK
  1.  K DIK
  1.  Q
  1. IX1 ;EP;
  1.  Q:$D(ACROUT)
  1.  K DTOUT,DUOUT,ACRQUIT,ACROUT
  1.  D IX1^DIK
  1.  K DIK,DA
  1.  Q
  1. DIQ1 ;EP;
  1.  D EN^DIQ1
  1.  K DIC,DA,DR,DIQ
  1.  Q
  1. WP ;EP;TO BROWSE WORD PROCESSING FIELD
  1.  Q:'$D(ACRFILE)#2!'$D(ACRIEN)#2!'$D(ACRFIELD)
  1.  D SCREEN^ACRFAU
  1.  I '$D(ACRSCREN) S ACRSCREN="" Q
  1.  K ACRSCREN
  1.  D WP^DDBR(ACRFILE,ACRIEN,ACRFIELD,"N",$G(ACRTITLE))
  1.  Q
  1. OBJ ;EP;TO SCREEN OBJECT CODES BY TYPE OF TRANSACTION
  1.  Q:'$D(ACRLBDA)
  1.  Q:'$D(ACRDOCDA)
  1.  I $P($G(^AUTTOBJC(+$G(Y),0)),U,12)=1
  1.  E  Q
  1.  N ACRTXDA
  1.  S ACRTXDA=$P(^ACRDOC(ACRDOCDA,0),U,4)
  1.  Q:'ACRTXDA
  1.  Q:ACRTXDA=11
  1.  S ACRGREF="^AUTTOBJC"
  1.  G OBJ3:$D(ACRSTOCK)
  1. OBJ1 I $D(^ACRTXTYP(ACRTXDA,10,+Y))
  1.  Q
  1. OBJ3 I $P(^AUTTOBJC(+Y,0),U,8)="S" Q
  1.  Q
  1. CAN Q:$G(ACRLBDA)<1
  1.  I $D(^ACRLOCB("CAN",+Y,ACRLBDA))!$D(^ACRLOCB("DCAN",+Y,ACRLBDA))
  1.  Q
  1. DICS() ;EP TO SET DIC("S") FOR CAN LOOKUP FOR SUPPLIES/SERVICES
  1.  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))))"
  1.  Q DIC("S")
  1. LBCAN() ;EP TO WRITE THE DEFAULT CAN FOR THE DEPARTMENT ACCOUNT
  1.  S Y=$P($G(^AUTTCAN(+$P($G(^ACRLOCB(+$G(D0),"DT")),U,9),0)),U)
  1.  Q ""
  1. SSDA() ;EP TO WRITE DEPARTMENT ACCOUNT CAN
  1.  S Y=$P($G(^AUTTCAN(+$P($G(^ACRLOCB(+$P($G(^ACRSS(+$G(DA),0)),U,6),"DT")),U,9),0)),U)
  1.  Q ""