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

ACRFDEL.m

Go to the documentation of this file. 
  1. ACRFDEL ;IHS/OIRM/DSD/THL,AEF - CANCEL A REQUEST;  [ 11/01/2001   9:44 AM ]
  1.  ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
  1.  ;;ROUTINE USED TO MANAGE TRANSFER OF REQUEST FROM ONE ACCOUNT TO
  1.  ;;ANOTHER AND TO CANCEL OR DELETE A REQUEST
  1. EN ;EP;TO CANCEL OR TRANSFER A REQUEST
  1.  D EN1
  1. EXIT K ACRDOCDA,ACRDOCDA,DA,ACRDOC,ACRID,ACRFDNO,ACRTDEL,ACRLBDA,ACRTREQ,ACRTOBL,ACRREQ,ACROBL
  1.  Q
  1. EN1 ;SELECT TO CANCEL OR TRANSFER REQUEST
  1.  I $D(ACRJVOD) D JVOD Q
  1.  S DIR(0)="SO^1:Delete "_ACRDOC_" ("_ACRID_")"_";2:Transfer "_ACRDOC_" ("_ACRID_")"
  1.  D DIR^ACRFDIC
  1.  I Y=1 D EN2 Q
  1.  I Y=2 D T
  1.  Q
  1. EN2 ;EP;CANCEL A REQUEST
  1.  S DIR(0)="YO"
  1.  S DIR("A")="Are you certain you want to "_$S('$D(ACRCANCL):"delete",1:"cancel")_" "_ACRDOC_"  ("_ACRID_")"
  1.  S DIR("B")="NO"
  1.  W !
  1.  D DIR^ACRFDIC
  1.  I Y'=1 K ACGQUIT Q
  1.  I ACRREF=103!(ACRREF=210&($P($G(^ACROBL(ACRDOCDA,"APV")),U,8)="A")) D CANPO
  1. EN3 ;EP;
  1.  D WAIT^DICD:$E($G(IOST),1,2)="C-"
  1.  D DHR:$P($G(^ACROBL(ACRDOCDA,"APV")),U)="A"
  1.  D SS
  1.  D APPROVE
  1.  D REQ
  1.  D DOC
  1.  W !!,*7,*7,$G(ACRDOC),"  (",$G(ACRID),")  has been "
  1.  W $S($G(ACRAPDAS)="D":"disapproved.",'$D(ACRCANCL):"deleted.",1:"cancelled.")
  1.  D PAUSE^ACRFWARN
  1.  Q
  1. SS ;ZERO OUT ALL ASSOCIATED ITEMS ON REQUEST
  1.  N ACRDA
  1.  S ACRDA=0
  1.  F  S ACRDA=$O(^ACRSS("C",ACRDOCDA,ACRDA)) Q:'ACRDA  D
  1.  .S DA=ACRDA
  1.  .S DIE="^ACRSS("
  1.  .S DR="13////0;16////0;16.1////0;18////0"
  1.  .D DIE^ACRFDIC
  1.  Q:'$D(^ACRAL("E",ACRDOCDA))
  1.  N ACRALDA
  1.  S ACRALDA=0
  1.  F  S ACRALDA=$O(^ACRAL("E",ACRDOCDA,ACRALDA)) Q:'ACRALDA  D
  1.  .S DA=ACRALDA
  1.  .S DIE="^ACRAL("
  1.  .S DR="9////0"
  1.  .D DIE^ACRFDIC
  1.  Q
  1. APPROVE ;INVALIDATE ALL ASSOCIATED APPROVALS
  1.  S ACRDA=0
  1.  F  S ACRDA=$O(^ACRAPVS("AB",ACRDOCDA,ACRDA)) Q:'ACRDA  D
  1.  .I $P(^ACRAPVS(ACRDA,0),U,3),$D(^("DT")),$P(^("DT"),U,2) K ^ACRAPVS("ANXT",$P(^(0),U,3),$P(^("DT"),U,2),ACRDA)
  1.  .K ^ACRAPVS("AB",ACRDOCDA,ACRDA)
  1.  .S ^ACRAPVS("D",ACRDOCDA,ACRDA)=""
  1.  .S DA=ACRDA
  1.  .S DIE="^ACRAPVS("
  1.  .S DR=".07////"_ACRDOCDA_";.08////"_DT_";.09////"_DUZ
  1.  .D DIE^ACRFDIC
  1.  Q
  1. REQ ;PUT REQUEST IN 'DISAPPROVED' STATUS
  1.  S DA=ACRDOCDA
  1.  S DIE="^ACROBL("
  1.  S DR="903////"_$S('$D(ACRCANCL):"D",1:"C")
  1.  D DIE^ACRFDIC
  1.  Q
  1. DOC ;PUT DOCUMENT IN DISAPPROVED STATUS
  1.  I '$D(^ACRDOC(ACRDOCDA,0)) D
  1.  .S X="CANCELLED"
  1.  .S DIC="^ACRDOC("
  1.  .S DIC(0)="L"
  1.  .S DINUM=ACRDOCDA
  1.  .D FILE^ACRFDIC
  1.  S DA=ACRDOCDA
  1.  S DIE="^ACRDOC("
  1.  S DR=".2///@;.14////"_$S($P($G(^ACRDOC(ACRDOCDA,0)),U,14)'["CANCELLED":"CANCELLED ",1:"")_$P($G(^(0)),U,14)
  1.  D DIE^ACRFDIC
  1.  S ^ACRDOC(ACRDOCDA,"DT")=""
  1.  Q
  1. T ;EP;TO SELECT THE DOCUMENT TO TRANSFER
  1.  K ACRFDNO
  1.  S ACRTDEL=""
  1.  D OBLAMT^ACRFDTPE
  1.  Q
  1. T1 ;EP;TO TRANSFER DOCUMENT FROM ONE FINANCIAL ACCOUNT TO ANOTHER
  1.  I ACRLBDA=ACRFDNO D  Q
  1.  .W !!,"Transfer to the same account is unnecessary."
  1.  .H 2
  1.  .K ACRTDEL,ACRFDNO
  1.  .S ACRQUIT=""
  1.  W !!,@ACRON,ACRDOC," (",ACRID,")",@ACROF," will be transferred to the"
  1.  W !,@ACRON,$P(^ACRLOCB(ACRFDNO,0),U,12),@ACROF," account."
  1.  S DIR(0)="YO"
  1.  S DIR("A")="Sure this is what you want"
  1.  S DIR("B")="NO"
  1.  W !
  1.  D DIR^ACRFDIC
  1.  I Y'=1 S ACRQUIT="" Q
  1.  W !
  1.  D:$E($G(IOST),1,2)="C-" WAIT^DICD
  1.  I $D(ACRJVOD) D DHR
  1.  S ACRCANDA=$P(^ACRLOCB(ACRFDNO,"DT"),U,9)
  1.  S DA=ACRDOCDA
  1.  S DIE="^ACROBL("
  1.  S DR=".03////"_ACRFDNO_";.04////"_ACRCANDA
  1.  D DIE^ACRFDIC
  1.  S DA=ACRDOCDA
  1.  S DIE="^ACRDOC("
  1.  S DR=".06////"_ACRFDNO_";113100////"_ACRCANDA
  1.  D DIE^ACRFDIC
  1.  S (ACRDA,ACRTREQ,ACRTOBL)=0
  1.  F  S ACRDA=$O(^ACRSS("C",ACRDOCDA,ACRDA)) Q:'ACRDA  D
  1.  .S DA=ACRDA
  1.  .S DIE="^ACRSS("
  1.  .S DR=".06////"_ACRFDNO_";.05////"_ACRCANDA
  1.  .D DIE^ACRFDIC
  1.  .N X
  1.  .S X=$G(^ACRSS(ACRDA,"DT"))
  1.  .S ACRTREQ=ACRTREQ+$P(X,U,4)
  1.  .S ACRTOBL=ACRTOBL+$P(X,U,9)
  1.  I ACRTREQ!ACRTOBL D
  1.  .N X
  1.  .S X=$G(^ACRLOCB(ACRFDNO,"BA"))
  1.  .S ACRREQ=$P(X,U,2)+ACRTREQ
  1.  .S ACROBL=$P(X,U,5)+ACRTOBL
  1.  .S DA=ACRFDNO
  1.  .S DIE="^ACRLOCB("
  1.  .S DR="2////"_ACRREQ_";7////"_ACROBL
  1.  .D DIE^ACRFDIC
  1.  .S X=$G(^ACRLOCB(ACRLBDA,"BA"))
  1.  .S ACRREQ=$P(X,U,2)-ACRTREQ
  1.  .S ACROBL=$P(X,U,5)-ACRTOBL
  1.  .S DA=ACRLBDA
  1.  .S DIE="^ACRLOCB("
  1.  .S DR="2////"_ACRREQ_";7////"_ACROBL
  1.  .D DIE^ACRFDIC
  1.  K DIE,DA,DR
  1.  N X
  1.  S X=^ACRDOC(ACRDOCDA,0)
  1.  S ACRDOCX=$P(X,U)
  1.  S ACRREFDA=$P(X,U,13)
  1.  S ACRTXDA=$P(X,U,4)
  1.  S (ACRREF,ACRREFX)=$P(^AUTTDOCR(ACRREFDA,0),U)
  1.  I ACRREF'=130,ACRREF'=600 D  I 1
  1.  .S ACRREFX=$S(ACRREF'=148:116,1:ACRREF)
  1.  .S ACRREFDA=$O(^AUTTDOCR("B",ACRREFX,0))
  1.  .D DOC^ACRFDOCN
  1.  E  D TO^ACRFDOCN
  1.  S DA=ACRDOCDA
  1.  S DIE="^ACRDOC("
  1.  S DR=".01///"_ACRDOC_";.17////"_ACRDOCX
  1.  D DIE^ACRFDIC
  1.  D:'$D(ACRJVOD) ^ACRFAPVS
  1.  W !!,@ACRON,ACRDOCX," (",ACRID,")",@ACROF," has been transferred to the"
  1.  W !,@ACRON,$P(^ACRLOCB(ACRFDNO,0),U,12),@ACROF," account (ID NO.: ",ACRFDNO,")."
  1.  W !,"The new document number is ",@ACRON,ACRDOC,@ACROF," (ID NO.: ",ACRDOCDA,")."
  1.  D PAUSE^ACRFWARN
  1.  S ACRQUIT=""
  1.  Q
  1. JVOD ;EP;TO JOURNAL VOUCHER OBLIGATED DOCUMENT
  1.  D T
  1.  Q
  1. CANYO ;EP;TO CANCEL/DELETE YOUR OWN REQUEST
  1.  S DIC="^ACRDOC("
  1.  S DIC(0)="QEALM"
  1.  S DIC("A")="Requisition/Travel Order NO.: "
  1.  S D="B^C^G^J"
  1.  S DIC("S")="S ACRREFDA=$P(^ACRDOC(+Y,0),U,13),ACRREQ=$P(^(""REQ2""),U,8),ACRTO=$P($G(^(""TO"")),U,9),ACRAPV=$P($G(^ACROBL(+Y,""APV"")),U,8),ACRREF=$P(^AUTTDOCR(ACRREFDA,0),U),ACRYO=$S(""^116^204^103^210^""[(U_ACRREF_U):ACRREQ,1:ACRTO)"
  1.  S DIC("S")=DIC("S")_" I ACRYO=DUZ,ACRREF'=103,ACRAPV'=""A"""
  1.  W !,"Select the document you want to DELETE/CANCEL"
  1.  W !!
  1.  D MIX^ACRFDIC
  1.  Q:+Y<1
  1.  S ACRDOCDA=+Y
  1.  D SETDOC^ACRFEA1
  1. CANYO1 ;EP;AFTER DOCUMENT HAS BEEN SELECTED
  1.  I ACRREF=600 S ACRCANCL=""
  1.  D EN2
  1.  K ACRCANCL
  1.  Q
  1. CANPO Q
  1.  S DA=ACRDOCDA
  1.  S DIE="^ACRDOC("
  1.  S DR="1901T"
  1.  W !
  1.  D DIE^ACRFDIC
  1.  S ACRFDNO=ACRLBDA
  1.  S ACRCANDA=$P(^ACRLOCB(ACRLBDA,"DT"),U)
  1.  S ACRAMEND=""
  1.  D EN1^ACRFAUTO
  1.  Q
  1. DHR ;
  1.  N X,Y
  1.  S X=0
  1.  F  S X=$O(^ACRDHR("E",ACRDOCDA,X)) Q:'X  S Y=$G(^ACRDHR(X,1)) I $P(Y,U,3,4)="050^1" S ACRQUIT="" Q
  1.  Q:'$D(ACRQUIT)
  1.  K ACRQUIT
  1.  S ACRTCODE="050"
  1.  S ACRRCODE=2
  1.  S ACRMCODE=$S($G(ACRMCODE):ACRMCODE,1:5)
  1.  D ^ACRFDHR
  1.  K ACRTCODE,ACRRCODE,ACRMCODE
  1.  Q