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

ENFAXFR.m

Go to the documentation of this file. 
  1. ENFAXFR ;WCIOFO/KLD,SAB; EQUIPMENT TRANSFERS ;11/29/2000
  1.  ;;7.0;ENGINEERING;**29,33,39,57,60,66**;Aug 17, 1993
  1.  ;This routine should not be modified.
  1. ST ;
  1.  D SETUP
  1.  D:ENDO ASKEQ
  1.  D:ENDO ADDFR
  1. EDIT D:ENDO ASKDATA
  1.  D:ENDO CVTDATA
  1.  D:ENDO VALFR I $D(ENREEDIT) K ENREEDIT G EDIT
  1.  K ENAV I ENDO D  I $G(ENUT) S ENDO=0 K ENUT
  1.  . S ENAV=$$AVP^ENFAAV("6915.6",ENFR("DA"))
  1.  . I 'ENAV W !,"Adjustment voucher was NOT created."
  1.  D:ENDO ASKOK
  1.  D:'ENDO DEL
  1.  D:ENDO UPDATE
  1.  D:ENDO PSEQED
  1.  D WRAPUP
  1.  Q
  1. SETUP ;
  1.  S ENDO=1
  1.  S (ENEQ("DA"),ENFA("DA"),ENFR("DA"))=""
  1.  Q
  1. ASKEQ ; ask for equipment item
  1.  D GETEQ^ENUTL I Y'>0 S ENDO=0 Q
  1.  L +^ENG(6914,+Y):5 I '$T D  S ENDO=0 Q
  1.  . W !!,"Someone else is editing this Equipment Record."
  1.  . W !,"Please try again later."
  1.  S ENEQ("DA")=+Y
  1.  I '$D(^ENG(6915.2,"B",ENEQ("DA"))) D  S ENDO=0 Q
  1.  . W !!,"There is no FA document on file for this asset."
  1.  . W !,"Nothing to change."
  1.  S X=$$CHKFA^ENFAUTL(ENEQ("DA")) I +X=0 D  S ENDO=0 Q
  1.  . S Y=$P(X,U,3) D DD^%DT
  1.  . W !!,"An FD document for ENTRY #",ENEQ("DA")," was processed on ",Y,"."
  1.  . W !,"No action taken."
  1.  S ENFA("DA")=$P(X,U,4)
  1.  F I=1,2,3,8,9 S ENEQ(I)=$G(^ENG(6914,ENEQ("DA"),I))
  1.  Q
  1. ADDFR ; create entry for FR code sheet
  1.  S DIC="^ENG(6915.6,",DIC(0)="L",DLAYGO=6915.6
  1.  S X=ENEQ("DA"),DIC("DR")="1///NOW;1.5////^S X=DUZ"
  1.  K DD,DO D FILE^DICN K DIC,DLAYGO
  1.  I Y'>0 D  S ENDO=0 Q
  1.  . I $D(ENBAT("SILENT")) D BAD("Can't add to FR DOCUMENT LOG") Q
  1.  . W !!,"Can't update FR document log. Better contact IRM."
  1.  S ENFR("DA")=+Y
  1.  L +^ENG(6915.6,+Y):0 I '$T D  S ENDO=0 Q
  1.  . I $D(ENBAT("SILENT")) D BAD("Can't lock FR Document") Q
  1.  . W !!,"The FR document that you just created is being edited"
  1.  . W !,"by someone else. Please notify IRM."
  1.  ; populate non-editable fields from FA
  1.  S X=$G(^ENG(6915.2,ENFA("DA"),3))
  1.  S $P(^ENG(6915.6,ENFR("DA"),3),U,11)=$P(X,U,12) ; owning station
  1.  S $P(^ENG(6915.6,ENFR("DA"),3),U,17)=$P(X,U,30) ; satellite station
  1.  K X
  1.  ; save current asset value on FR
  1.  S $P(^ENG(6915.6,ENFR("DA"),100),U,8)=$$GET1^DIQ(6914,ENEQ("DA"),12)
  1.  Q
  1. ASKDATA ;ask data for FR document
  1.  S DIE="^ENG(6915.6,",DA=ENFR("DA"),DR="[ENFA XFR]"
  1.  S DIE("NO^")="BACKOUTOK"
  1.  W ! D ^DIE K DIE("NO^")
  1.  I $D(DTOUT) W !!,"Timeout" S ENDO=0 Q
  1.  Q
  1. CVTDATA ; convert user-entered pseudo field data into exported data
  1.  S ENFAP(100)=$G(^ENG(6915.6,ENFR("DA"),100))
  1.  ;
  1.  ; populate required fields (send even when not changed)
  1.  K DR S DR=""
  1.  I $P(ENFAP(100),U,2)]"" D
  1.  . S DR=";28///^S X=$$GET1^DIQ(6915.6,ENFR(""DA""),101)"
  1.  I $P(ENFAP(100),U,3)]"" D
  1.  . S DR=DR_";29///^S X=$$GET1^DIQ(6915.6,ENFR(""DA""),102)"
  1.  S:$E(DR)=";" DR=$E(DR,2,200)
  1.  I DR]"" S DIE="^ENG(6915.6,",DA=ENFR("DA") D ^DIE
  1.  ;
  1.  S ENFAP("BUDFY")="" ; default budget fiscal year
  1.  S X=$P(ENFAP(100),U,2) I X]"" D
  1.  . I $$GET1^DIQ(6914.6,X,.01)="4539" S ENFAP("BUDFY")=2000 Q  ; EN*7*66
  1.  . I $$GET1^DIQ(6914.6,X,2,"I") S ENFAP("BUDFY")=1994 Q  ; rev. funds
  1.  . I $E($$GET1^DIQ(6914.6,X,.01),1,4)="AMAF" S ENFAP("BUDFY")=1995 Q
  1.  . S ENFAP("BUDFY")=$E(DT,1,3)+1700+$E(DT,4)
  1.  . ;S ENFAP("BUDFY")=$E($P(ENEQ(2),U,4),1,3)+1700+$E($P(ENEQ(2),U,4),4)
  1.  S $P(^ENG(6915.6,ENFR("DA"),3),U,8)=$E(ENFAP("BUDFY"),3,4)
  1.  ;
  1.  S ENACC="000000000" ; default xprogram
  1.  ;I $P(ENFAP(100),U,4)]"" D  ;Get ACC - don't send per Bob Landrum
  1.  ;. N ENDOCFY,ENY
  1.  ;. S X="PRC0C" X ^%ZOSF("TEST") D:$T
  1.  ;. . S ENFAP("STATION")=$P(^ENG(6915.2,ENFA("DA"),3),U,12)
  1.  ;. . S ENY=$G(^ENG(6915.2,ENFA("DA"),3))
  1.  ;. . S ENDOCFY=$E($P(ENY,U,16)+$E($P(ENY,U,17)),3,4)
  1.  ;. . S X=$$ACC^PRC0C(ENFAP("STATION"),$P(ENFAP(100),U,4)_U_ENDOCFY_U_ENFAP("BUDFY"))
  1.  ;. . I $P(X,U,3)?9AN S ENACC=$P(X,U,3)
  1.  S $P(^ENG(6915.6,ENFR("DA"),3),U,12)=ENACC
  1.  K ENACC
  1.  ;
  1.  ; populate optional fields (recompute cost center when CMR specified)
  1.  K DR S DR=""
  1.  I $P(ENFAP(100),U,5)]"" S DR=";32///^S X=$$GET1^DIQ(6915.6,ENFR(""DA""),104)"
  1.  I $P(ENFAP(100),U,6)]"" D
  1.  . S ENFAP("CMR")=$E($$GET1^DIQ(6915.6,ENFR("DA"),105),1,5)
  1.  . S DR=DR_";37///^S X=ENFAP(""CMR"")"
  1.  . S DR=DR_";33///^S X=$$LOC^ENFAVAL(ENFAP(""CMR""))"
  1.  . S ENFAP("CC")=$$GET1^DIQ(6914.1,$P(ENFAP(100),U,6),10)
  1.  . I ENFAP("CC")]"" S DR=DR_";34///^S X=ENFAP(""CC"")"
  1.  S:$E(DR)=";" DR=$E(DR,2,200)
  1.  I DR]"" S DIE="^ENG(6915.6,",DA=ENFR("DA") D ^DIE
  1.  K DR
  1.  ;
  1.  F I=0,3,100 S ENFAP(I)=^ENG(6915.6,ENFR("DA"),I)
  1.  Q
  1. VALFR ; validate FR document
  1.  K ENREEDIT
  1.  S ENFAP("DOC")="FR" K ^TMP($J) D ^ENFAVAL
  1.  I $D(^TMP($J)) D LISTP^ENFAXMTM D
  1.  . S DIR(0)="Y",DIR("A")="Re-edit this transaction",DIR("B")="YES"
  1.  . D ^DIR K DIR
  1.  . I 'Y W !!,"Sorry, I must then delete this FR document!" S ENDO=0 Q
  1.  . S ENREEDIT=1
  1.  . ; initialize derived values
  1.  . S $P(ENFAP(3),U,7,10)="^^^",$P(ENFAP(3),U,12,15)="^^^"
  1.  . S $P(ENFAP(3),U,18)=""
  1.  . S ^ENG(6915.6,ENFR("DA"),3)=ENFAP(3)
  1.  Q
  1. ASKOK ;
  1.  S DIR(0)="Y",DIR("A")="Sure you want to process these changes"
  1.  S DIR("B")="YES" D ^DIR K DIR I 'Y!($D(DIRUT)) S ENDO=0
  1.  Q
  1.  ;
  1. DEL ;
  1.  I $G(ENFR("DA"))]"" D
  1.  . S DA=ENFR("DA"),DIK="^ENG(6915.6," D ^DIK K DIK
  1.  . W !,"FR Document deleted."
  1.  W $C(7),!,"No action taken. Database unchanged."
  1.  Q
  1. UPDATE ; update
  1.  ;update FAP Balance if fund changed
  1.  I $P(ENFAP(100),U,2)]"",$P(ENFAP(100),U,2)'=$P(ENEQ(9),U,7) D
  1.  . D ADJBAL^ENFABAL($P(ENEQ(9),U,5),$P(ENEQ(9),U,7),$P(ENEQ(8),U,6),$P($P(ENFAP(0),U,2),"."),-$P(ENEQ(2),U,3)) ; remove from old
  1.  . D ADJBAL^ENFABAL($P(ENEQ(9),U,5),$P(ENFAP(100),U,2),$P(ENEQ(8),U,6),$P($P(ENFAP(0),U,2),"."),$P(ENEQ(2),U,3)) ; add to new
  1.  W:'$D(ENBAT("SILENT")) !!,"Updating the AEMS/MERS Equipment File."
  1.  S ENEQ("XCMR")="" ; initialize CMR changed flag
  1.  S DIE="^ENG(6914,",DA=ENEQ("DA"),DR=""
  1.  I $P(ENFAP(100),U,2)]"",$P(ENFAP(100),U,2)'=$P(ENEQ(9),U,7) S DR=DR_";62////^S X=$P(ENFAP(100),U,2)"
  1.  I $P(ENFAP(100),U,3)]"",$P(ENFAP(100),U,3)'=$P(ENEQ(9),U,8) S DR=DR_";63////^S X=$P(ENFAP(100),U,3)"
  1.  I $P(ENFAP(100),U,4)]"",$P(ENFAP(100),U,4)'=$P(ENEQ(8),U,3) S DR=DR_";35////^S X=$P(ENFAP(100),U,4)"
  1.  I $P(ENFAP(100),U,5)]"",$P(ENFAP(100),U,5)'=$P(ENEQ(9),U,6) S DR=DR_";61////^S X=$P(ENFAP(100),U,5)"
  1.  I $P(ENFAP(100),U,6)]"",$P(ENFAP(100),U,6)'=$P(ENEQ(2),U,9) S DR=DR_";19////^S X=$P(ENFAP(100),U,6)",ENEQ("XCMR")=1
  1.  I $E(DR)=";" S DR=$E(DR,2,200)
  1.  D ^DIE
  1.  ; transmit document
  1.  W:'$D(ENBAT("SILENT")) !!,"Sending FR document to FAP."
  1.  D ^ENFAXMT
  1.  ; save adjustment voucher
  1.  I $G(ENAV) D
  1.  . S DIE="^ENG(6915.6,",DR="301///NOW",DA=ENFR("DA") D ^DIE
  1.  . W !,"Adjustment Voucher was created.",!
  1.  Q
  1.  ;
  1. PSEQED ; Post FR Equipment Edit (selected fields)
  1.  N ENX
  1.  S DIE="^ENG(6914,",DA=ENEQ("DA"),DR=""
  1.  ; edit Service when CMR changes and new CMR's service is different
  1.  I $G(ENEQ("XCMR"))]"" D
  1.  . S ENX=$$GET1^DIQ(6914,ENEQ("DA"),"19:.5") ; get CMR's service
  1.  . Q:ENX=""  ; CMR's service not specified
  1.  . Q:ENX=$$GET1^DIQ(6914,ENEQ("DA"),21)  ; already equals using svc
  1.  . ; include in user edit
  1.  . S DR=";21USING SERVICE"
  1.  . W !!,"This FR Document changed the equipment's CMR value."
  1.  . W !,"The service accountable for the new CMR is ",ENX,"."
  1.  . W !,"You can update the equipment's Using Service if appropriate."
  1.  . W !,"Just press <ENTER> to leave it unchanged."
  1.  S:$E(DR)=";" DR=$E(DR,2,999)
  1.  I DR]"" W !!,"Editing Equipment ENTRY # ",DA D ^DIE
  1.  Q
  1.  ;
  1. WRAPUP ;
  1.  I $G(ENEQ("DA"))]"" L -^ENG(6914,ENEQ("DA"))
  1.  I $G(ENFR("DA"))]"" L -^ENG(6915.6,ENFR("DA"))
  1.  K DA,DIC,DIE,DR,DIR,I,X,Y
  1.  K ENAV,ENDO,ENEQ,ENFAP,ENFA,ENFR
  1.  Q
  1.  ;
  1. BAD(X) ; add text to validation problem list
  1.  N I
  1.  S I=$P($G(^TMP($J,"BAD",ENEQ("DA"))),U)+1
  1.  S ^TMP($J,"BAD",ENEQ("DA"),I)=X
  1.  S ^TMP($J,"BAD",ENEQ("DA"))=I
  1.  Q
  1.  ;ENFAXFR