ACRFEA42 ;IHS/OIRM/DSD/THL,AEF - EDIT FINANCIAL DATA - CON'T; [ 03/28/2007 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**22**;NOV 05, 2001
;;UTILITY ROUTINE WITH MULTIPLE ENRY POINTS FOR VARIOUS DOCUMENT
;;EDITING AND PROCESSING FUNCTIONS
PR ;EP;TO PRINT DOCUMENT DURING DATA ENTRY/EDIT
I ACRENTRY["OBL"!(ACRENTRY="PO"),'$D(ACRSS6),'$D(ACROUT) D
.S ACRTXDA=$P(ACROBLAP,U,4)
.I ACRTXDA=11 D Q:$D(ACROUT)
..S DIR("A")="Include Purchase Order Terms and Conditions? "
..D OUT^ACRFEA2
..Q:$D(ACROUT)!$D(ACRQUIT)
..S:ACRY=1 ACRPOTC=""
.D PRINT^ACRFSHIP
.D PSC^ACRFPO1:ACRREFX=103!(ACRREFX=349)!(ACRREFX=326)
.Q:$D(ACROUT)
.K ACRQUIT
.S (ACRPRT,ACRREQST)=""
.I $D(ACRREV),ACRREF=103!(ACRREF=349)!(ACRREF=326)!(ACRREF=210) D
..S ACRREF=116
..S ACRREFDA=$O(^AUTTDOCR("B",ACRREF,0))
.N ACRREV
.S ACRREFX=$S(ACRENTRY'="PO":ACRREF,1:ACRREFX)
.D REQ^ACRFQ
.K ACRPRT,ACRREQST
K ACRQUIT
Q
NJ ;EP;EDIT NARRATIVE OR JUSTIFICATION
I ACRREF=148 D COURSE^ACRFSS3 Q
I "^103^349^326^116^204^210^"[(U_ACRREFX_U),'$D(ACRDIE)!($G(ACRDR)="") S ACRDIE="^ACROBL(",ACRDR="[ACR REQUEST INFO]"
D SCREEN^ACRFAU
D:'$D(ACRSCREN) DISP
N ACRI
I '$D(ACRZDA)#2,$D(ACRDOCDA)#2 S ACRZDA=ACRDOCDA
S:'$D(ACRENTRY)#2 ACRENTRY=""
I $D(ACRSCREN) D EDIE1^ACRFEA2 Q
D EDIE^ACRFEA2
Q
QD ;EP;EDIT QUANTITY DISCOUNT INFO
S DA=ACRDOCDA
S DIE="^ACRDOC("
S DR="[ACR QUANTITY DISCOUNT]"
D DIE^ACRFDIC
Q
AP ;EP;SEND DOCUMENT FOR APPROVAL
I '$D(ACRPRCS),'$D(ACRREV),$D(^ACRSS("C",ACRDOCDA)) D APPROVE^ACRFEA21
K ACRQUIT,ACRPRT,ACROUT
Q
ASUM ;EP;TO PRINT ACCOUNT SUMMARY
S ACRENTR1="LOCBAMT"
S ACRDISDX=""
S ACRGREF="^ACRLOCB"
S ACRY="DEPARTMENT",DA=$P(ACRDOC0,U,6)
W !!?5,"ACCOUNT SUMMARY YEAR-TO-DATE:"
W !,"----------------------------------"
D EN^ACRFDTP2
D SUBSET^ACRFDTP2
N ACRX
F ACRX=ACR0,ACR2,ACR16,ACR5,ACR17 W @ACRX
I $E(IOST,1,2)="C-",$D(ACRREV) D PAUSE^ACRFWARN
Q
CR ;EP;CHANGE TYPE OF REQUEST
S DIR("A")=" Change Type of Request? "
D OUT^ACRFEA2
Q:$D(ACROUT)!$D(ACRQUIT)
Q:ACRY'=1
CR1 S DA=ACRDOCDA,DR="907 Type of Request"
S DIE="^ACROBL("
D DIE^ACRFDIC
S ACRTXDA=$P(ACROBLAP,U,4)
S DA=ACRDOCDA
S DIE="^ACRDOC("
S DR=".04////"_ACRTXDA_";.07////"_ACRTXDA
D DIE^ACRFDIC
S DA=ACRDOCDA
S DIE="^ACROBL("
S DR="907////"_ACRTXDA
D DIE^ACRFDIC
Q
BP ;EP;
D BAPPEND^ACRFBOIL
S DIR("A")="Add Boiler Plate Statement? "
D OUT^ACRFEA2
Q:$D(ACROUT)!$D(ACRQUIT)
Q:ACRY'=1
BP1 D DOCBOIL^ACRFBOIL
Q
RV ;EP;TO ENTER REQUESTED VENDOR DATA
F D RV2 Q:$D(ACRQUIT)!$D(ACROUT)
K ACRQUIT
Q
RV2 ;S DIR("A")="Enter/Edit Requested Vendor? " ;ACR*2.1*22.11l
;D ADD^ACRFVLK ;ACR*2.1*22.11l
;Q:$D(ACRQUIT) ;ACR*2.1*22.11l
;Q:$D(ACROUT) ;ACR*2.1*22.11l
W !
;I $P(^ACRDOC(ACRDOCDA,0),U,4)=30,'$P($G(^ACRDOC(ACRDOCDA,"PO")),U,5) S ACRY=1 ;ACR*2.1*22.11l
;E D OUT^ACRFEA2 ;ACR*2.1*22.11l
;Q:$D(ACROUT)!$D(ACRQUIT) ;ACR*2.1*22.11l
;Q:ACRY'=1 ;ACR*2.1*22.11l
RV1 ;EP;TO ENTER REQUESTED VENDOR DATA ;HEAVILY MODIFIED TO ALLOW SELECTION ONLY;ACR*2.1*22.11l
;THE CODE BELOW WILL CHECK TO SEE IF THE VENDOR IS ACTIVE
;AND WILL NOT ALLOW USER TO CHOOSE AN INACTIVE VENDOR
D FINDVND ; ACR*2.1*22.11l
Q:ACRQUIT=1 ; ACR*2.1*22.11l
;
S DA=ACRDOCDA
S DIE="^ACRDOC("
S DR=$S(ACRREF'=148:"103070",1:"148181") ;CONTRACTOR OR TRAINING PAY FIELDS
;S DR=DR_"///"_ACRVND ; ACR*2.1*22.11l
S DR=DR_"////"_+ACRVND ;STUFF POINTER; ACR*2.1*22.11l
;W !!?21,"|==============================|"
D DIE^ACRFDIC
D DISP^ACRFVLK ; ACR*2.1*22.11l
S ACRQUIT="" ; ACR*2.1*22.11l
S ACRDOC0=^ACRDOC(ACRDOCDA,0) ;REFRESH VARIABLE ACR*2.1*22.11l
I ACRREF'=148,$P($G(^ACRDOC(ACRDOCDA,"PO")),U,5) Q
I ACRREF=148,+$G(^ACRDOC(ACRDOCDA,"TRNG3")) Q
I $P(^ACRDOC(ACRDOCDA,0),U,4)=30,'$P($G(^ACRDOC(ACRDOCDA,"PO")),U,5) D Q
.W !!,"You must enter a vendor from the STANDARD Vendor list"
.W !,"before the OBLIGATE/PAY transaction can be completed."
.D PAUSE^ACRFWARN
;.G RV1 ;ACR*2.1*22.11l
;S DA=ACRDOCDA ;ACR*2.1*22.11l
;S DIE="^ACRDOC(" ;ACR*2.1*22.11l
;S DR="[ACR TMP VENDOR DATA]" ;ACR*2.1*22.11l
;D DDS^ACRFDIC ;ACR*2.1*22.11l
Q:'$D(ACRSCREN)
K ACRSCREN
W !!,"You did not select a Vendor from the Standard Vendor table."
W !,"You may enter data on the requested Vendor."
W !
D DIE^ACRFDIC
Q
DISP ;EP;TO DISPLAY FINANCIAL ACCOUNT DATA
W @IOF
W ?20,"Current data:"
W !
N DXS,DIP,DC,DN
I $D(ACRREF),ACRREF=130!(ACRREF=600) S ACRRTN="^ACRTVL"
S D0=$S($D(ACRZDA):ACRZDA,1:ACRDOCDA)
D:$G(ACRRTN)]"" @ACRRTN
Q
ATTACH ;EP;TO INDICATE NUMBER OF ATTACHMENTS
S DA=ACRDOCDA
S DIE="^ACRDOC("
S DR="13T;S:X<1 Y=""@1"";13.1;@1"
W !
D DIE^ACRFDIC
Q
RS ;EP;TO REVIEW STATUS OF DOCUMENT
S D0=ACRDOCDA
D SETDOC^ACRFEA1
S:'$D(ACRREFX) ACRREFX=ACRREF
S ACRCSI=""
D ^ACRFPAPV
K ACRCSI
Q
DOCSTAT ;EP;TO EDIT THE STATUS OF THE DOCUMENT IN PROCUREMENT PROCESSING
W !!,"Describe below the current status of this document in procurement."
W !
S DA=ACRDOCDA
S DIE="^ACRDOC("
S DR=1201
D DIE^ACRFDIC
Q
PDOCSTAT ;EP;TO PRINT DOCUMENT STATUS REPORT
Q:'$D(ACRDOCDA)
Q:'ACRDOCDA!'$D(^ACRDOC(+ACRDOCDA,12,1))
W !!,"Procurement status report:"
N DXS,DIP,DC,DN
S D0=ACRDOCDA
D ^ACRPDS
Q
FINDVND ; Ask / Lookup Vendor ;ACR*2.1*22.11l NEW SUBROUTINE
W:$D(IOF) @IOF
K DD,DO,X,Y,DIC,DA,DR,DINUM,D,DLAYGO
S ACRQUIT=0
S DIC="^AUTTVNDR("
S DIC(0)="AEMQZ"
S DIC("A")="Which Vendor? "
S ACRVND=$$VENDOR^ACRFUFMU(ACRDOCDA)
S DIC("B")=$S(ACRVND>0:ACRVND,1:"") ;SET DEFAULT TO CURRENT VENDOR
S DIC("S")="I '$$IDATE^ACRFUFMU(+Y)" ;DO NOT ALLOW SELECTION OF INACTIVE
D ^DIC
I +Y<1 S ACRQUIT=1 Q
S ACRVND=Y
S ACRVND(0)=Y(0)
Q
ACRFEA42 ;IHS/OIRM/DSD/THL,AEF - EDIT FINANCIAL DATA - CON'T; [ 03/28/2007 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**22**;NOV 05, 2001
+2 ;;UTILITY ROUTINE WITH MULTIPLE ENRY POINTS FOR VARIOUS DOCUMENT
+3 ;;EDITING AND PROCESSING FUNCTIONS
PR ;EP;TO PRINT DOCUMENT DURING DATA ENTRY/EDIT
+1 IF ACRENTRY["OBL"!(ACRENTRY="PO")
IF '$DATA(ACRSS6)
IF '$DATA(ACROUT)
Begin DoDot:1
+2 SET ACRTXDA=$PIECE(ACROBLAP,U,4)
+3 IF ACRTXDA=11
Begin DoDot:2
+4 SET DIR("A")="Include Purchase Order Terms and Conditions? "
+5 DO OUT^ACRFEA2
+6 IF $DATA(ACROUT)!$DATA(ACRQUIT)
QUIT
+7 IF ACRY=1
SET ACRPOTC=""
End DoDot:2
IF $DATA(ACROUT)
QUIT
+8 DO PRINT^ACRFSHIP
+9 IF ACRREFX=103!(ACRREFX=349)!(ACRREFX=326)
DO PSC^ACRFPO1
+10 IF $DATA(ACROUT)
QUIT
+11 KILL ACRQUIT
+12 SET (ACRPRT,ACRREQST)=""
+13 IF $DATA(ACRREV)
IF ACRREF=103!(ACRREF=349)!(ACRREF=326)!(ACRREF=210)
Begin DoDot:2
+14 SET ACRREF=116
+15 SET ACRREFDA=$ORDER(^AUTTDOCR("B",ACRREF,0))
End DoDot:2
+16 NEW ACRREV
+17 SET ACRREFX=$SELECT(ACRENTRY'="PO":ACRREF,1:ACRREFX)
+18 DO REQ^ACRFQ
+19 KILL ACRPRT,ACRREQST
End DoDot:1
+20 KILL ACRQUIT
+21 QUIT
NJ ;EP;EDIT NARRATIVE OR JUSTIFICATION
+1 IF ACRREF=148
DO COURSE^ACRFSS3
QUIT
+2 IF "^103^349^326^116^204^210^"[(U_ACRREFX_U)
IF '$DATA(ACRDIE)!($GET(ACRDR)="")
SET ACRDIE="^ACROBL("
SET ACRDR="[ACR REQUEST INFO]"
+3 DO SCREEN^ACRFAU
+4 IF '$DATA(ACRSCREN)
DO DISP
+5 NEW ACRI
+6 IF '$DATA(ACRZDA)#2
IF $DATA(ACRDOCDA)#2
SET ACRZDA=ACRDOCDA
+7 IF '$DATA(ACRENTRY)#2
SET ACRENTRY=""
+8 IF $DATA(ACRSCREN)
DO EDIE1^ACRFEA2
QUIT
+9 DO EDIE^ACRFEA2
+10 QUIT
QD ;EP;EDIT QUANTITY DISCOUNT INFO
+1 SET DA=ACRDOCDA
+2 SET DIE="^ACRDOC("
+3 SET DR="[ACR QUANTITY DISCOUNT]"
+4 DO DIE^ACRFDIC
+5 QUIT
AP ;EP;SEND DOCUMENT FOR APPROVAL
+1 IF '$DATA(ACRPRCS)
IF '$DATA(ACRREV)
IF $DATA(^ACRSS("C",ACRDOCDA))
DO APPROVE^ACRFEA21
+2 KILL ACRQUIT,ACRPRT,ACROUT
+3 QUIT
ASUM ;EP;TO PRINT ACCOUNT SUMMARY
+1 SET ACRENTR1="LOCBAMT"
+2 SET ACRDISDX=""
+3 SET ACRGREF="^ACRLOCB"
+4 SET ACRY="DEPARTMENT"
SET DA=$PIECE(ACRDOC0,U,6)
+5 WRITE !!?5,"ACCOUNT SUMMARY YEAR-TO-DATE:"
+6 WRITE !,"----------------------------------"
+7 DO EN^ACRFDTP2
+8 DO SUBSET^ACRFDTP2
+9 NEW ACRX
+10 FOR ACRX=ACR0,ACR2,ACR16,ACR5,ACR17
WRITE @ACRX
+11 IF $EXTRACT(IOST,1,2)="C-"
IF $DATA(ACRREV)
DO PAUSE^ACRFWARN
+12 QUIT
CR ;EP;CHANGE TYPE OF REQUEST
+1 SET DIR("A")=" Change Type of Request? "
+2 DO OUT^ACRFEA2
+3 IF $DATA(ACROUT)!$DATA(ACRQUIT)
QUIT
+4 IF ACRY'=1
QUIT
CR1 SET DA=ACRDOCDA
SET DR="907 Type of Request"
+1 SET DIE="^ACROBL("
+2 DO DIE^ACRFDIC
+3 SET ACRTXDA=$PIECE(ACROBLAP,U,4)
+4 SET DA=ACRDOCDA
+5 SET DIE="^ACRDOC("
+6 SET DR=".04////"_ACRTXDA_";.07////"_ACRTXDA
+7 DO DIE^ACRFDIC
+8 SET DA=ACRDOCDA
+9 SET DIE="^ACROBL("
+10 SET DR="907////"_ACRTXDA
+11 DO DIE^ACRFDIC
+12 QUIT
BP ;EP;
+1 DO BAPPEND^ACRFBOIL
+2 SET DIR("A")="Add Boiler Plate Statement? "
+3 DO OUT^ACRFEA2
+4 IF $DATA(ACROUT)!$DATA(ACRQUIT)
QUIT
+5 IF ACRY'=1
QUIT
BP1 DO DOCBOIL^ACRFBOIL
+1 QUIT
RV ;EP;TO ENTER REQUESTED VENDOR DATA
+1 FOR
DO RV2
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+2 KILL ACRQUIT
+3 QUIT
RV2 ;S DIR("A")="Enter/Edit Requested Vendor? " ;ACR*2.1*22.11l
+1 ;D ADD^ACRFVLK ;ACR*2.1*22.11l
+2 ;Q:$D(ACRQUIT) ;ACR*2.1*22.11l
+3 ;Q:$D(ACROUT) ;ACR*2.1*22.11l
+4 WRITE !
+5 ;I $P(^ACRDOC(ACRDOCDA,0),U,4)=30,'$P($G(^ACRDOC(ACRDOCDA,"PO")),U,5) S ACRY=1 ;ACR*2.1*22.11l
+6 ;E D OUT^ACRFEA2 ;ACR*2.1*22.11l
+7 ;Q:$D(ACROUT)!$D(ACRQUIT) ;ACR*2.1*22.11l
+8 ;Q:ACRY'=1 ;ACR*2.1*22.11l
RV1 ;EP;TO ENTER REQUESTED VENDOR DATA ;HEAVILY MODIFIED TO ALLOW SELECTION ONLY;ACR*2.1*22.11l
+1 ;THE CODE BELOW WILL CHECK TO SEE IF THE VENDOR IS ACTIVE
+2 ;AND WILL NOT ALLOW USER TO CHOOSE AN INACTIVE VENDOR
+3 ; ACR*2.1*22.11l
DO FINDVND
+4 ; ACR*2.1*22.11l
IF ACRQUIT=1
QUIT
+5 ;
+6 SET DA=ACRDOCDA
+7 SET DIE="^ACRDOC("
+8 ;CONTRACTOR OR TRAINING PAY FIELDS
SET DR=$SELECT(ACRREF'=148:"103070",1:"148181")
+9 ;S DR=DR_"///"_ACRVND ; ACR*2.1*22.11l
+10 ;STUFF POINTER; ACR*2.1*22.11l
SET DR=DR_"////"_+ACRVND
+11 ;W !!?21,"|==============================|"
+12 DO DIE^ACRFDIC
+13 ; ACR*2.1*22.11l
DO DISP^ACRFVLK
+14 ; ACR*2.1*22.11l
SET ACRQUIT=""
+15 ;REFRESH VARIABLE ACR*2.1*22.11l
SET ACRDOC0=^ACRDOC(ACRDOCDA,0)
+16 IF ACRREF'=148
IF $PIECE($GET(^ACRDOC(ACRDOCDA,"PO")),U,5)
QUIT
+17 IF ACRREF=148
IF +$GET(^ACRDOC(ACRDOCDA,"TRNG3"))
QUIT
+18 IF $PIECE(^ACRDOC(ACRDOCDA,0),U,4)=30
IF '$PIECE($GET(^ACRDOC(ACRDOCDA,"PO")),U,5)
Begin DoDot:1
+19 WRITE !!,"You must enter a vendor from the STANDARD Vendor list"
+20 WRITE !,"before the OBLIGATE/PAY transaction can be completed."
+21 DO PAUSE^ACRFWARN
End DoDot:1
QUIT
+22 ;.G RV1 ;ACR*2.1*22.11l
+23 ;S DA=ACRDOCDA ;ACR*2.1*22.11l
+24 ;S DIE="^ACRDOC(" ;ACR*2.1*22.11l
+25 ;S DR="[ACR TMP VENDOR DATA]" ;ACR*2.1*22.11l
+26 ;D DDS^ACRFDIC ;ACR*2.1*22.11l
+27 IF '$DATA(ACRSCREN)
QUIT
+28 KILL ACRSCREN
+29 WRITE !!,"You did not select a Vendor from the Standard Vendor table."
+30 WRITE !,"You may enter data on the requested Vendor."
+31 WRITE !
+32 DO DIE^ACRFDIC
+33 QUIT
DISP ;EP;TO DISPLAY FINANCIAL ACCOUNT DATA
+1 WRITE @IOF
+2 WRITE ?20,"Current data:"
+3 WRITE !
+4 NEW DXS,DIP,DC,DN
+5 IF $DATA(ACRREF)
IF ACRREF=130!(ACRREF=600)
SET ACRRTN="^ACRTVL"
+6 SET D0=$SELECT($DATA(ACRZDA):ACRZDA,1:ACRDOCDA)
+7 IF $GET(ACRRTN)]""
DO @ACRRTN
+8 QUIT
ATTACH ;EP;TO INDICATE NUMBER OF ATTACHMENTS
+1 SET DA=ACRDOCDA
+2 SET DIE="^ACRDOC("
+3 SET DR="13T;S:X<1 Y=""@1"";13.1;@1"
+4 WRITE !
+5 DO DIE^ACRFDIC
+6 QUIT
RS ;EP;TO REVIEW STATUS OF DOCUMENT
+1 SET D0=ACRDOCDA
+2 DO SETDOC^ACRFEA1
+3 IF '$DATA(ACRREFX)
SET ACRREFX=ACRREF
+4 SET ACRCSI=""
+5 DO ^ACRFPAPV
+6 KILL ACRCSI
+7 QUIT
DOCSTAT ;EP;TO EDIT THE STATUS OF THE DOCUMENT IN PROCUREMENT PROCESSING
+1 WRITE !!,"Describe below the current status of this document in procurement."
+2 WRITE !
+3 SET DA=ACRDOCDA
+4 SET DIE="^ACRDOC("
+5 SET DR=1201
+6 DO DIE^ACRFDIC
+7 QUIT
PDOCSTAT ;EP;TO PRINT DOCUMENT STATUS REPORT
+1 IF '$DATA(ACRDOCDA)
QUIT
+2 IF 'ACRDOCDA!'$DATA(^ACRDOC(+ACRDOCDA,12,1))
QUIT
+3 WRITE !!,"Procurement status report:"
+4 NEW DXS,DIP,DC,DN
+5 SET D0=ACRDOCDA
+6 DO ^ACRPDS
+7 QUIT
FINDVND ; Ask / Lookup Vendor ;ACR*2.1*22.11l NEW SUBROUTINE
+1 IF $DATA(IOF)
WRITE @IOF
+2 KILL DD,DO,X,Y,DIC,DA,DR,DINUM,D,DLAYGO
+3 SET ACRQUIT=0
+4 SET DIC="^AUTTVNDR("
+5 SET DIC(0)="AEMQZ"
+6 SET DIC("A")="Which Vendor? "
+7 SET ACRVND=$$VENDOR^ACRFUFMU(ACRDOCDA)
+8 ;SET DEFAULT TO CURRENT VENDOR
SET DIC("B")=$SELECT(ACRVND>0:ACRVND,1:"")
+9 ;DO NOT ALLOW SELECTION OF INACTIVE
SET DIC("S")="I '$$IDATE^ACRFUFMU(+Y)"
+10 DO ^DIC
+11 IF +Y<1
SET ACRQUIT=1
QUIT
+12 SET ACRVND=Y
+13 SET ACRVND(0)=Y(0)
+14 QUIT
