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

ACRFSS3.m

Go to the documentation of this file. 
  1. ACRFSS3 ;IHS/OIRM/DSD/THL,AEF - EDIT TRAVEL OR TRAINING EXPENSES; [ 02/02/2005  10:23 AM ]
  1.  ;;2.1;ADMIN RESOURCE MGT SYSTEM;**16**;NOV 05, 2001
  1.  ;;CONTINUATION OF ACRFSS
  1.  ;;EDIT TRAVEL OR TRAINING EXPENSES
  1. TO F  D EN1 Q:$D(ACRQUIT)!$D(ACROUT)
  1. EXIT K ACRX,ACRQUIT,ACRPF,ACRI,ACRALTOT,ACRSS
  1.  Q
  1. EN1 S ACRTXDA=$P(ACRDOC0,U,4)
  1.  I ACRREF=600!(ACRREF=130) D ^ACRFSS4 I $D(ACRREV) S ACRQUIT="" Q
  1.  Q:$D(ACROUT)
  1.  I $D(ACRNEWOB),$D(^ACRSS("E",ACRDOCDA)),ACRREF=130!(ACRREF=600) D UP
  1.  W !!,$S(ACRREF=130:"TRAVEL ORDER",ACRREF=600:"TRAVEL VOUCHER",1:"TRAINING REQUEST")," BEING PROCESSED."
  1.  W !
  1.  F ACRI=1:1:$S(ACRREF=130!(ACRREF=600):4,1:2) D ADD
  1.  I $D(ACRQUIT) Q
  1.  F  D EN2 Q:$D(ACRQUIT)!$D(ACROUT)
  1.  Q
  1. EN2 ;EP
  1.  D DISPLAY
  1.  D EDIT
  1.  S ACRQUIT=""
  1.  Q
  1. DISPLAY I $E(IOST,1,2)="C-",'$D(ACRPRT) D
  1.  .W @IOF
  1.  .W !?10,@ACRON,$S(ACRREF=130!(ACRREF=600):"TRAVEL",1:"TRAINING")," EXPENSES"
  1.  .W @ACROF," FOR DOCUMENT: ",@ACRON,ACRDOC,@ACROF
  1.  .D OBJ
  1.  W !!,"ITEM"
  1.  W ?6,"TYPE OF"
  1.  W:'$D(ACRPRT) ?22,"OBJ"
  1.  W ?42,"ESTIMATED"
  1.  W !," NO."
  1.  W ?6,"EXPENSE"
  1.  I '$D(ACRPRT) D
  1.  .W ?22,"CODE"
  1.  .W ?28,"CAN NO."
  1.  W ?42,"EXPENSE"
  1.  W !,"----"
  1.  W ?6,"--------------"
  1.  I '$D(ACRPRT) D
  1.  .W ?22,"----"
  1.  .W ?28,"-------"
  1.  W ?42,"----------"
  1.  S ACRSSDA="",(ACRSSTOT,ACRJ)=0
  1.  I ACRREF=130!(ACRREF=600) F ACRI=1:1:4 D
  1.  .S ACRSSDA=$O(^ACRSS("E",ACRDOCDA,ACRI,0))
  1.  .Q:'ACRSSDA
  1.  .S ACRJ=ACRJ+1
  1.  .D DISP1
  1.  I ACRREF=148 F ACRI=1,2 D
  1.  .S ACRSSDA=$O(^ACRSS("E",ACRDOCDA,ACRI,ACRSSDA))
  1.  .Q:'ACRSSDA
  1.  .S ACRJ=ACRJ+1
  1.  .D DISP1
  1.  W !?42,"----------"
  1.  W !?34,"TOTAL"
  1.  W ?42,$J($FN(ACRSSTOT,"P",2),11)
  1.  I $D(ACRPRT),$E(IOST,1,2)["C-" D PAUSE^ACRFWARN W @IOF
  1.  Q
  1. DISP1 S ACRSS=ACRSSDA_"^"_^ACRSS(ACRSSDA,0),ACRSS1=$P($G(^ACRSS(ACRSSDA,"DT")),U,4),ACRITEM=$P(ACRSS,U,2),ACRSSITM=$P($G(^ACRSS(ACRSSDA,"NMS")),U,5),ACRSS(ACRJ)=ACRSS,ACROBJDA=$P(ACRSS,U,5),ACRSSCAN=$P(ACRSS,U,6)
  1.  S ACRCAN=$P($G(^AUTTCAN(+ACRSSCAN,0)),U),ACROBJ=$P($G(^AUTTOBJC(+ACROBJDA,0)),U)
  1.  S:ACRSS1'["." ACRSS1=ACRSS1_".00"
  1.  S:$L($P(ACRSS1,".",2))=1 ACRSS1=ACRSS1_"0"
  1.  S ACRSSTOT=ACRSSTOT+ACRSS1
  1.  S:ACRITEM'=ACRJ&(ACRITEM'=999) $P(^ACRSS(ACRSSDA,0),U)=ACRJ
  1.  W !,$J(ACRJ,3)
  1.  W ?6,ACRSSITM
  1.  I '$D(ACRPRT) D
  1.  .W ?22,$S(ACROBJ]"":ACROBJ,1:"****")
  1.  .W ?28,ACRCAN
  1.  W ?42,$J(ACRSS1,10)
  1.  Q
  1. ADD I $D(^ACRSS("E",ACRDOCDA,ACRI)) D ADD1:ACRREF'=148 Q
  1.  S X=ACRI
  1.  S DIC(0)="L"
  1.  S DIC="^ACRSS("
  1.  I ACRREF=130!(ACRREF=600) S Y(0)=$S(X=1:"Travel-DHHS",X=2:"Per Diem-DHHS",X=3:"Other Exp-DHHS",X=4:"Travel-OTHER",X=5:"Per Diem-OTHER",1:"Other Exp-OTHER")
  1.  E  S Y(0)=$S(X=1:"Tuition & Fees",1:"Books & Other")
  1.  I ACRREF=130!(ACRREF=600),X=4 S Y(0)="Travel Mgt Fee"
  1.  S ACRCANDA=$O(^AUTTCAN("B",ACRFDNCA,0))
  1.  S DIC("DR")=".02////"_$G(ACRDOCDA)_";.03////"_$G(ACRDOCDA)_";.05////"_$G(ACRCANDA)_";.06////"_$G(ACRLBDA)_";5////"_$G(Y(0))
  1.  I ACRI<5,ACRREF=130!(ACRREF=600) S DIC("DR")=DIC("DR")_";13////"_$S(ACRI=1:+$G(ACRALTOT),ACRI=2:$G(ACRPD)+$G(ACRLDG),ACRI=3:$G(ACROTHT)+$G(ACRRC)+$G(ACR4P),ACRI=4&($D(^ACRAL("E",ACRDOCDA))):$P($G(^ACRSYS(1,400)),U),1:0)
  1.  E  S DIC("DR")=DIC("DR")_";13////0"
  1.  I $G(Y(0))="Travel Mgt Fee" D
  1.  . S DIC("DR")=DIC("DR")_";.04////"_$S($P($G(^ACRSYS(1,400)),U,2)]"":$P($G(^ACRSYS(1,400)),U,2),$G(ACROBJ)]"":ACROBJ,+$O(^AUTTOBJC("B",2121_" ",0)):$O(^AUTTOBJC("B",2121_" ",0)),1:"")
  1.  D FILE^ACRFDIC
  1.  S ACRSSDA=+Y
  1.  Q
  1. ADD1 S DA=$O(^ACRSS("E",ACRDOCDA,ACRI,0))
  1.  S DIE="^ACRSS("
  1.  Q:'DA
  1.  ;I ACRREF=130!(ACRREF=600),$P($G(^ACRSS(DA,"DT")),U,4)=$S(ACRI=1:$G(ACRALTOT),ACRI=2:$G(ACRPD)+$G(ACRLDG),ACRI=3:$G(ACROTHT)+$G(ACRRC)+$G(ACR4P),1:0) Q  ;ACR*2.1*16.09 IM13605
  1.  S ACRALTOT=$G(ACRALTOT)                          ;ACR*2.1*16.09 IM13605
  1.  S ACRPD=$G(ACRPD)                                ;ACR*2.1*16.09 IM13605
  1.  S ACRLDG=$G(ACRLDG)                              ;ACR*2.1*16.09 IM13605
  1.  S ACROTHT=$G(ACROTHT)                            ;ACR*2.1*16.09 IM13605
  1.  S ACRRC=$G(ACRRC)                                ;ACR*2.1*16.09 IM13605
  1.  S ACR4P=$G(ACR4P)                                ;ACR*2.1*16.09 IM13605
  1.  I ACRREF=130!(ACRREF=600),$P($G(^ACRSS(DA,"DT")),U,4)=$S(ACRI=1:+ACRALTOT,ACRI=2:ACRPD+ACRLDG,ACRI=3:ACROTHT+ACRRC+ACR4P,1:0) Q  ;ACR*2.1*16.09 IM13605
  1.  I ACRREF=130!(ACRREF=600) Q:ACRI=4&(+$$TMFEE^ACRFSS42(ACRDOCDA))
  1.  I ACRI<5,ACRREF=130!(ACRREF=600) S DR="13////"_$S(ACRI=1:+ACRALTOT,ACRI=2:ACRPD+ACRLDG,ACRI=3:ACROTHT+ACRRC+ACR4P,ACRI=4&($D(^ACRAL("E",ACRDOCDA))):$P($G(^ACRSYS(1,400)),U),1:0)
  1.  E  S DR="13////0"
  1.  I ACRI=4,ACRREF=130!(ACRREF=600) S DR=DR_";4////"_$S($P($G(^ACRSYS(1,400)),U,2):$P($G(^ACRSYS(1,400)),U,2),1:$O(^AUTTOBJC("B",2121_" ",0)))
  1.  Q:ACRREF=148
  1.  D DIE^ACRFDIC
  1.  Q
  1. EDIT ;     
  1.  I $G(ACRREF)=148,$P($G(^ACROBL(ACRDOCDA,"APV")),U)="A" Q   ;PREVENT EDITING EXPENSES ON APPROVED TRAINING REQUEST
  1.  S DIR(0)="LOA^1:"_$S(ACRREF=130!(ACRREF=600):4,1:2)
  1.  S DIR("A")="Item NO(s). ==> "
  1.  I ACRREF=600 S DIR("B")=4
  1.  W !
  1.  K ACRQUIT
  1.  D DIR^ACRFDIC
  1.  Q:$D(ACRQUIT)!$D(ACROUT)!'+Y
  1.  I ACRREF=600 Q:+Y'=4
  1.  F ACRI=1:1 S X=$P(ACRY,",",ACRI) Q:'X  D:+$G(ACRSS(X)) E1
  1.  Q
  1. E1 W !!?22,"Item No. ",X
  1.  S (DA,ACRSSDA)=+ACRSS(X)
  1.  S DIE="^ACRSS("
  1.  S DR="S DIE(""NO^"")="""";.05T//"_$S($L($G(ACRFDNCA))=7:ACRFDNCA,$L($G(ACRCAN))=7:ACRCAN,1:"")_";.04T"_$S(ACRREF'=148:"",X=1:";13TUITION & FEES......",X=2:";13BOOKS & OTHER.......",1:"")
  1.  I $P($G(^ACRSS(ACRSSDA,"NMS")),U,5)="Travel Mgt Fee" S DR=DR_";13T"
  1.  D DIE^ACRFDIC
  1.  Q
  1. COURSE ;EP;TO EDIT TRAINING NEED
  1.  N DXS,DIP,DC,DN
  1.  S (D0,DA)=ACRDOCDA
  1.  S DIE="^ACRDOC("
  1.  S DR="[ACR TRAINING NEED]"
  1.  D DDS^ACRFDIC
  1.  Q:'$D(ACRSCREN)
  1.  K ACRSCREN
  1.  D ^ACR148A
  1.  I $D(^ACRDOC(ACRDOCDA,"TRNGND1")) D  I Y'=1 S ACRQUIT="" Q
  1.  .S DIR(0)="YO"
  1.  .S DIR("A")="            Edit this data"
  1.  .S DIR("B")="NO"
  1.  .W !
  1.  .D DIR^ACRFDIC
  1.  D DIE^ACRFDIC
  1.  Q
  1. UP ;EP;TO UPDATE REQUEST AMOUNT
  1.  Q:$P(^ACRDOC(ACRDOCDA,0),U,14)["CANCELLED"
  1.  S ACRSSDA=0
  1.  F ACRI=1:1:3 D:$D(^ACRSS("E",ACRDOCDA,ACRI))
  1.  .S ACRSSDA=$O(^ACRSS("E",ACRDOCDA,ACRI,ACRSSDA))
  1.  .S DA=ACRSSDA
  1.  .S DIE="^ACRSS("
  1.  .S DR="13////"_$S(ACRI=1:+$G(ACRALTOT),ACRI=2:ACRPD+ACRLDG,1:ACROTHT+ACRRC+ACR4P)
  1.  .D DIE^ACRFDIC
  1.  Q
  1. OBJ ;
  1.  Q:$P($G(^ACROBL(ACRDOCDA,"APV")),U)="A"   ;PREVENT EDITING OF OBJECT CLASS CODE ON APPROVED REQUEST
  1.  I "^130^148^"[(U_ACRREF_U),$G(ACRDOCDA),$D(^ACRSS("C",ACRDOCDA)) S (ACRSSDA,DA)=$O(^ACRSS("C",ACRDOCDA,0)) I DA,$D(^ACRSS(DA,0)) S ACROBJ=$P(^(0),U,4) D
  1.  .S DIE="^ACRSS(",DR="S DIE(""NO^"")="""";.04"_$S(ACRREF=130:"THIS TRAVEL ORDER",1:"THIS TRAINING REQUEST")_"//"_$S(ACRREF=130:"2121",1:"252W")
  1.  .W !!,"OBJECT CODE FOR"
  1.  .D DIE^ACRFDIC
  1.  .Q:ACROBJ=$P(^ACRSS(ACRSSDA,0),U,4)
  1.  .S ACROBJ=$P(^ACRSS(ACRSSDA,0),U,4)
  1.  .F  S ACRSSDA=$O(^ACRSS("C",ACRDOCDA,ACRSSDA)) Q:'ACRSSDA  D
  1.  ..Q:$P(^ACRSS(ACRSSDA,0),U,4)=ACROBJ
  1.  ..S DA=ACRSSDA
  1.  ..S DIE="^ACRSS("
  1.  . . S DR=".04////"_$S($P($G(^ACRSS(ACRSSDA,"NMS")),U,5)="Travel Mgt Fee":$P($G(^ACRSYS(1,400)),U,2),1:ACROBJ)
  1.  ..D DIE^ACRFDIC
  1.  D PUT($G(ACROBJ),$G(ACRDOCDA))
  1.  Q
  1. PUT(ACROBJ,ACRDOCDA)         ;
  1.  ;----- PUT OCC INTO OCC FIELD OF FMS DOCUMENT FILE
  1.  ;
  1.  ;      ACROBJ   = INTERNAL OBJECT CLASS CODE
  1.  ;      ACRDOCDA = INTERNAL DOCUMENT NUMBER
  1.  ;
  1.  I $G(ACROBJ),$G(ACRDOCDA) D
  1.  . S DIE="^ACRDOC("
  1.  . S DA=ACRDOCDA
  1.  . S DR="113060////"_ACROBJ
  1.  . D ^DIE
  1.  Q