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

ACRFSS51.m

Go to the documentation of this file.
ACRFSS51 ;IHS/OIRM/DSD/THL,AEF - CONTINUATION OF ACRFSS5; [ 11/01/2001   9:44 AM ]
 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
 ;;CONTINUATION OF ACRFSS5
ADD ;EP;
 F  D ADD1 Q:$D(ACRQUIT)!$D(ACROUT)
 D TMFEEA(ACRDOCDA)
 Q
ADD1 S (ACRJ,X)=ACRJ+1
 S DIC="^ACRAL("
 S DIC(0)="L"
 S DIC("DR")=".02////"_ACRDOCDA_";.03////"_ACRDOCDA
 I ACRJ>1,$D(^ACRAL(+$G(ACRAL(1)),0)) S DIC("DR")=DIC("DR")_";2////"_$P($G(^("DT")),U,2)_";11////"_$P($G(^("DT")),U,11)
 D FILE^ACRFDIC
 S (DA,ACRDA)=+Y
 D EDIT2
 S DA=ACRDA
 S DIR(0)="YO"
 S DIR("A")="Add another flight"
 S DIR("B")="NO"
 W !
 D DIR^ACRFDIC
 I Y'=1 S ACRQUIT=""
 Q
EDIT ;EP;
 S DIR(0)="LO^1:"_ACRJ
 S DIR("A")="Which FLIGHT(S)"
 W !
 D DIR^ACRFDIC
 Q:$D(ACRQUIT)!$D(ACROUT)
 S ACRZ=Y
 F ACRI=1:1 S ACRYY=$P(ACRZ,",",ACRI) Q:'ACRYY  D:$D(ACRAL(ACRYY)) EDIT1
 K ACRZ
 Q
EDIT1 S (DA,ACRDA)=+ACRAL(ACRYY)
EDIT2 S DIE="^ACRAL("
 S DR="[ACR AIRLINE INFO]"
 D DDS^ACRFDIC
 Q:'$D(ACRSCREN)
 K ACRSCREN
 D ^ACRFEAL
 Q
DELETE ;EP;
 S DIR(0)="LO^1:"_ACRJ
 S DIR("A")="Which FLIGHT(S)"
 W !
 D DIR^ACRFDIC
 Q:$D(ACRQUIT)!$D(ACROUT)
 S ACRY=Y
 S:$E(ACRY,$L(ACRY))="," ACRY=$E(ACRY,1,($L(ACRY)-1))
 F ACRI=1:1 S ACRYY=$P(ACRY,",",ACRI) Q:ACRYY=""  D DTV1:$D(ACRAL(ACRYY))
 Q
DTV1 S DA=$P(ACRAL(ACRYY),U)
 S DIK="^ACRAL("
 D DIK^ACRFDIC
 D TMFEED(ACRDOCDA)
 Q
TMFEEA(ACRDOCDA)   ;
 ;----- ADDS TRAVEL MGT FEE WHEN AIRLINE FLIGHT IS ADDED
 ;
 ;      ACRDOCDA = FMS DOCUMENT IEN
 ;
 Q:'$D(^ACRAL("E",ACRDOCDA))
 S DA=$$TMFIEN(ACRDOCDA)
 Q:'DA
 S DIE="^ACRSS("
 S DR="13////"_+$P($G(^ACRSYS(1,400)),U)
 D ^DIE
 Q
TMFEED(ACRDOCDA)   ;
 ;----- DELETES TRAVEL MGT FEE WHEN AIRLINE FLIGHTS ARE DELETED
 ;
 ;      ACRDOCDA = FMS DOCUMENT IEN
 ;
 Q:$D(^ACRAL("E",ACRDOCDA))
 S DA=$$TMFIEN(ACRDOCDA)
 Q:'DA
 S DIE="^ACRSS("
 S DR="13////"_"0"
 D ^DIE
 Q
TMFIEN(ACRDOCDA)   ;
 ;----- EXTRINSIC FUNCTION - FIND FMS SUPPLIES & SERVICES ENTRY
 ;      CONTAINING THE TRAVEL MGT FEE
 ;
 ;      INPUT:
 ;        ACRDOCDA = FMS DOCUMENT IEN
 ;
 ;      OUTPUT:
 ;        Y = FMS SUPPLIES & SERVICES FILE ENTRY IEN
 ;
 N Y
 S Y=0
 F  S Y=$O(^ACRSS("C",ACRDOCDA,Y)) Q:'Y  Q:$P($G(^ACRSS(Y,"NMS")),U,5)="Travel Mgt Fee"
 Q +Y