- ACRFSYS ;IHS/OIRM/DSD/AEF/MRS - VARIOUS ARMS SYSTEM UTILITY SUBROUTINES [ 10/27/2004 4:18 PM ]
- ;;2.1;ADMIN RESOURCE MGT SYSTEM;**13**;NOV 05, 2001
- ;NEW ROUTINE ACR*2.1*13.06
- AREA(X) ;EP -- RETURNS INTERNAL AREA SYSTEM FOR FMS SUPPLIES AND SERVICES FILE
- ;
- ; Used by Function ACRFSSAREA, which is used by trigger on
- ; COMMON ACCOUNTING NUMBER field of FMS Supplies and Services file
- ; to trigger the AREA SYSTEM field.
- ;
- ; Input:
- ; X = IEN OF FMS SUPPLIES AND SERVICES FILE ENTRY
- ;
- ; Output:
- ; X = INTERNAL AREA IN FMS SYSTEM DEFAULTS FILE
- ;
- I $P($G(^ACRSS(X,0)),U,5)="" S X="" Q X
- I $P($G(^ACRCAN($P($G(^ACRSS(X,0)),U,5),0)),U,7)="" S X="" Q X
- I $P($G(^AUTTLCOD($P($G(^ACRCAN($P($G(^ACRSS(X,0)),U,5),0)),U,7),0)),U,3)="" S X="" Q X
- S X=$P($G(^AUTTACPT($P($G(^AUTTLCOD($P($G(^ACRCAN($P($G(^ACRSS(X,0)),U,5),0)),U,7),0)),U,3),0)),U,2)
- S X=$O(^ACRSYS("B",X,0))
- I 'X S X=""
- Q X
- ;
- SYS(X) ;EP -- RETURNS FMS SYSTEM DEFAULTS ENTRY IEN FOR PURCHASING OFFICE
- ;
- ; X = FMS PURCHASING OFFICE IEN
- ;
- N Y
- S Y=1
- I 'X Q Y
- I '$P($G(^ACRPO(X,0)),U,19) Q Y
- S Y=$P(^ACRPO(X,0),U,19)
- Q Y
- ;
- ARMSDIR(X) ;EP;
- ;----- EXTRINSIC FUNCTION TO RETURN ARMS DEFAULT DIRECTORY FROM
- ; FMS SYSTEMS DEFAULTS FILE
- ; X= SYSTEM NUMBER IN FMS SYSTEM DEFAULT FILE CURRENTLY ALWAYS 1
- ; UNTIL SYSTEM BECOMES FULLY MULTIREGIONAL
- ; WRITES ERROR MESSAGE WHEN DIRECTORY PATH IS UNDEFINED IN
- ; ^ACRSYS(X,402),U,3)
- ;
- N Y
- S Y=$P($G(^ACRSYS(X,402)),U,3)
- I Y']"" D
- .W !?5,*7,"ARMS DIRECTORY IS UNDEFINED IN THE FMS SYSTEM DEFAULTS,"
- .W ?5,"FILE, PLEASE NOTIFY ARMS MANAGER"
- Q Y
- ;
- ODDPATH(X) ;EP; EXTRINSIC FUNCTION
- ;RETURNS OPEN DOCUMENT EXPORT/IMPORT PATH NAME
- ; X= SYSTEM NUMBER IN FMS SYSTEM DEFAULT FILE
- ; CURRENTLY ALWAYS 1
- ; UNTIL SYSTEM BECOMES FULLY MULTIREGIONAL
- ;
- N Y,Z
- S Z=$P($G(^ACRSYS(X,301)),U)
- I Z']"" D Q Z
- .W !?5,*7,"OPEN DOCUMENT DOWNLOAD DIRECTORY IS UNDEFINED IN THE"
- .W !?5,"FMS SYSTEM DEFAULTS FILE, PLEASE NOTIFY ARMS MANAGER"
- D JCMD^ACRFUTL("cd "_Z,.Y)
- I Y D
- . W !,"No such directory "_Z
- . S Z=""
- . D PAUSE^ACRFWARN
- Q Z
- ACRFSYS ;IHS/OIRM/DSD/AEF/MRS - VARIOUS ARMS SYSTEM UTILITY SUBROUTINES [ 10/27/2004 4:18 PM ]
- +1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**13**;NOV 05, 2001
- +2 ;NEW ROUTINE ACR*2.1*13.06
- AREA(X) ;EP -- RETURNS INTERNAL AREA SYSTEM FOR FMS SUPPLIES AND SERVICES FILE
- +1 ;
- +2 ; Used by Function ACRFSSAREA, which is used by trigger on
- +3 ; COMMON ACCOUNTING NUMBER field of FMS Supplies and Services file
- +4 ; to trigger the AREA SYSTEM field.
- +5 ;
- +6 ; Input:
- +7 ; X = IEN OF FMS SUPPLIES AND SERVICES FILE ENTRY
- +8 ;
- +9 ; Output:
- +10 ; X = INTERNAL AREA IN FMS SYSTEM DEFAULTS FILE
- +11 ;
- +12 IF $PIECE($GET(^ACRSS(X,0)),U,5)=""
- SET X=""
- QUIT X
- +13 IF $PIECE($GET(^ACRCAN($PIECE($GET(^ACRSS(X,0)),U,5),0)),U,7)=""
- SET X=""
- QUIT X
- +14 IF $PIECE($GET(^AUTTLCOD($PIECE($GET(^ACRCAN($PIECE($GET(^ACRSS(X,0)),U,5),0)),U,7),0)),U,3)=""
- SET X=""
- QUIT X
- +15 SET X=$PIECE($GET(^AUTTACPT($PIECE($GET(^AUTTLCOD($PIECE($GET(^ACRCAN($PIECE($GET(^ACRSS(X,0)),U,5),0)),U,7),0)),U,3),0)),U,2)
- +16 SET X=$ORDER(^ACRSYS("B",X,0))
- +17 IF 'X
- SET X=""
- +18 QUIT X
- +19 ;
- SYS(X) ;EP -- RETURNS FMS SYSTEM DEFAULTS ENTRY IEN FOR PURCHASING OFFICE
- +1 ;
- +2 ; X = FMS PURCHASING OFFICE IEN
- +3 ;
- +4 NEW Y
- +5 SET Y=1
- +6 IF 'X
- QUIT Y
- +7 IF '$PIECE($GET(^ACRPO(X,0)),U,19)
- QUIT Y
- +8 SET Y=$PIECE(^ACRPO(X,0),U,19)
- +9 QUIT Y
- +10 ;
- ARMSDIR(X) ;EP;
- +1 ;----- EXTRINSIC FUNCTION TO RETURN ARMS DEFAULT DIRECTORY FROM
- +2 ; FMS SYSTEMS DEFAULTS FILE
- +3 ; X= SYSTEM NUMBER IN FMS SYSTEM DEFAULT FILE CURRENTLY ALWAYS 1
- +4 ; UNTIL SYSTEM BECOMES FULLY MULTIREGIONAL
- +5 ; WRITES ERROR MESSAGE WHEN DIRECTORY PATH IS UNDEFINED IN
- +6 ; ^ACRSYS(X,402),U,3)
- +7 ;
- +8 NEW Y
- +9 SET Y=$PIECE($GET(^ACRSYS(X,402)),U,3)
- +10 IF Y']""
- Begin DoDot:1
- +11 WRITE !?5,*7,"ARMS DIRECTORY IS UNDEFINED IN THE FMS SYSTEM DEFAULTS,"
- +12 WRITE ?5,"FILE, PLEASE NOTIFY ARMS MANAGER"
- End DoDot:1
- +13 QUIT Y
- +14 ;
- ODDPATH(X) ;EP; EXTRINSIC FUNCTION
- +1 ;RETURNS OPEN DOCUMENT EXPORT/IMPORT PATH NAME
- +2 ; X= SYSTEM NUMBER IN FMS SYSTEM DEFAULT FILE
- +3 ; CURRENTLY ALWAYS 1
- +4 ; UNTIL SYSTEM BECOMES FULLY MULTIREGIONAL
- +5 ;
- +6 NEW Y,Z
- +7 SET Z=$PIECE($GET(^ACRSYS(X,301)),U)
- +8 IF Z']""
- Begin DoDot:1
- +9 WRITE !?5,*7,"OPEN DOCUMENT DOWNLOAD DIRECTORY IS UNDEFINED IN THE"
- +10 WRITE !?5,"FMS SYSTEM DEFAULTS FILE, PLEASE NOTIFY ARMS MANAGER"
- End DoDot:1
- QUIT Z
- +11 DO JCMD^ACRFUTL("cd "_Z,.Y)
- +12 IF Y
- Begin DoDot:1
- +13 WRITE !,"No such directory "_Z
- +14 SET Z=""
- +15 DO PAUSE^ACRFWARN
- End DoDot:1
- +16 QUIT Z
