ACRFSS1 ;IHS/OIRM/DSD/THL,AEF - ACRFSS CON'T; [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
;;CONTINUATION OF ACRFSS
EDIT ;EP;TO SELECT REQUEST ITEM TO EDIT
N ACRI,ACRY
I ACRJ=1 D Q
.S Y=1
.D EDIT1
S DIR(0)="LO^1:"_ACRSJ
S DIR("A")="Which Item(s)"
W !
D DIR^ACRFDIC
I $D(ACRQUIT)!$D(ACROUT) K ACRQUIT Q
EDIT1 S ACRY=Y
F ACRI=1:1 S X=$P(ACRY,",",ACRI) Q:X="" D ED1:$D(ACRSS(X))
K ACR25
Q
ED1 W !!?21,"Item NO. ",X
S ACRSSDA=+ACRSS(X)
I $P(^ACRSS(ACRSSDA,0),U,12),$P($G(^ACRITEM($P(^(0),U,12),"DT")),U,9) S ACRSTOCK=""
N ACRDR
S ACRDR="[ACR NON-STANDARD ITEM-2]"
I ACRREFX=116,$P(^ACRDOC(ACRDOCDA,0),U,4)=36!($P(^(0),U,4)=37) D
.S ACRDR="[ACR SUPPLY/SERVICES-CONTRACT]"
I $G(ACRAPVT)=31!($G(ACRAPVT)=6) S ACRSSDR="[ACR PROPERTY CLEARANCE]"
D EDIE
D CHECK1^ACRFWARN:$D(ACRTXLIM)&$D(ACRCHK)
K ACRSTOCK
Q
ADD ;EP;TO ADD NEW ITEM TO REQUEST
D FILE^ACRFDIC
S ACRSSDA=+Y
S ACRNEWSS=""
S DIE("NO^")=""
I $D(ACRSSDR) N ACRDR S ACRDR=ACRSSDR
D EDIE
K ACRNEWSS
Q:'$D(ACRSSDA)
S ACRVENDA=+$G(^ACRSS(ACRSSDA,"VND"))
Q
ADD2 ;EP;
S ACRCANDA=$P(^ACRLOCB($P(ACRDOC0,U,6),"DT"),U,9)
S ACROCDA=$P(ACROBLDT,U,3)
S X=ACRJ+1
S (DIC,DIE)="^ACRSS("
S DIC(0)="AELQZ"
S DIC("DR")=".02////"_ACRDOCDA_";.03////"_ACRDOCDA_";.04////"_$S(ACROCDA:ACROCDA,1:"")_";.05////"_ACRCANDA_";.2////"_ACRDOCDA_";20////"_ACRDOCVN
I $G(ACRCANDA),'$D(ACRFDNCA) S ACRFDNCA=$P(^AUTTCAN(ACRCANDA,0),U)
I $D(ACRXX) D
.S DIC("DR")=DIC("DR")_";1////"_ACRXX
.S ACRCAN=$S($D(ACRCAN):ACRCAN,1:ACRFDNCA)
N ACRDR
S ACRDR=".05T;.04T"
I ACRREFX=116,$P(^ACRDOC(ACRDOCDA,0),U,4)=36!($P(^(0),U,4)=37) D
.S ACRDR=".06T;.04T"
D ADD
Q
ADD1 ;EP;
S ACRCANDA=$P(^ACRLOCB($P(ACRDOC0,U,6),"DT"),U,9)
S X=ACRJ
S ACRITMNO=Y(0,0)
N ACRY
S ACRY=^ACRITEM(ACRITMDA,"DT")
S ACRDSC=$G(^ACRITEM(ACRITMDA,"DT2"))
S ACRDSC1=$P(ACRY,U)
S ACRDSC2=$P(ACRY,U,2)
S ACRNSN=$P(ACRY,U,4)
S ACROCDA=$P(ACRY,U,6)
S ACRVENON=$P($G(^ACRITEM(ACRITMDA,"DT1")),U,2)
S ACRNDC=$P($G(^ACRITEM(ACRITMDA,"DT1")),U,4)
S ACRUI=$P(ACRY,U,12)
S ACRUC=$P(ACRY,U,13)
S ACRVENDA=$P(ACRY,U,14)
S:ACRDSC1[";" ACRDSC1=$TR(ACRDSC1,";",",")
S:ACRDSC2[";" ACRDSC2=$TR(ACRDSC2,";",",")
S:$P(ACRY,U,17)="8" ACRUC=ACRUC*1.035,ACRSC="8"
S ACRNEW=""
S DIC="^ACRSS("
S DIC(0)="L"
S DIC("DR")=".02////"_ACRDOCDA_";.03////"_ACRDOCDA_";.04////"_ACROCDA_";.05////"_ACRCANDA_";.12////"_ACRITMDA_";.2////"_ACRDOCDA
S DIC("DR")=DIC("DR")_";1////"_ACRVENON_";2////"_ACRNSN_";3////"_ACRNDC_";11////"_ACRUI_";12////"_ACRUC_";21////"_ACRVENON_";20////"_ACRVENDA_";100////"_ACRDSC1_";101////"_ACRDSC2
S:$P(ACRY,U,17)="C" DIC("DR")=DIC("DR")_";19////"_ACRSC
I $G(ACRCANDA),'$D(ACRFDNCA) S ACRFDNCA=$P(^AUTTCAN(ACRCANDA,0),U)
S ACRCAN=$S($D(ACRCAN):ACRCAN,1:ACRFDNCA)
D ADD
Q
EDIE ;EP;TO EDIT AN ITEM ON A REQUEST
S ACRTXDA=$P(ACRDOC0,U,4)
I $P(^ACRSS(ACRSSDA,0),U,12)]"" D
.W @IOF
.W !?20,"INFORMATION FOR SELECTED "
.W !?20,@ACRON,"SERVICE OR SUPPLY",@ACROF
.W !!
.D SSDISP
D NOW^%DTC
S ACRNOW=%
I $D(ACRNEW) D I $D(ACRQUIT) K ACRQUIT Q
.K ACRNEW
.W !!?10,ACRX," ",@ACRON,"ARE",@ACROF," on file."
.S DIR(0)="YO"
.S DIR("A")=" Add it to this request"
.S DIR("B")="YES"
.W !
.D DIR^ACRFDIC
.I Y'=1 D
..S DA=ACRSSDA
..S DIK="^ACRSS("
..D DIK^ACRFDIC
..K ACRSSDA
..S ACRQUIT=""
I $G(ACRCANDA),'$D(ACRFDNCA) S ACRFDNCA=$P(^AUTTCAN(ACRCANDA,0),U)
S ACRCAN=$S($D(ACRCAN):ACRCAN,1:ACRFDNCA)
S DA=ACRSSDA
S DIE="^ACRSS("
S DR=$S($D(ACRSSDR):ACRSSDR,1:ACRDR)
DIE1 S:$D(ACRNEWSS) DIE("NO^")=""
S ACRDDIE="SSDISP^ACRFSS1"
S ACRMESS="ITEM NO. "_$P(^ACRSS(DA,0),U)
D SCREEN^ACRFAU:DR'="[ACR PROPERTY CLEARANCE]"
D:'$D(ACRSCREN) DIE^ACRFDIC
I '$D(ACRSSDR) D
.S DA=ACRSSDA
.S DIE="^ACRSS("
.S DR=$S(ACRTXDA=36!(ACRTXDA=37):"[ACR SUPPLY/SERVICES-CONTRACT]",ACRTXDA'=35:"[ACR SUPPLY/SERVICES INFO-2]",1:"[ACR CREDIT CARD ITEM]")
.F D ^ACRFESS Q:$D(ACRQUIT)!$D(ACROUT)
.K ACRQUIT
K ACRSSDR,ACRDDIE,ACRMESS
D SSCHK^ACRFSSA
S:'$D(ACRSSTOT) ACRSSTOT=0
S ACRSSTOT=ACRSSTOT+$P(^ACRSS(ACRSSDA,"DT"),U,4)
S DA=ACRSSDA
S DIE="^ACRSS("
S DR="14////"_$P(^ACRSS(ACRSSDA,"DT"),U)
D DIE^ACRFDIC
I $G(ACRITMDA),'$P($G(^ACRDOC(ACRDOCDA,"PO")),U,5),+$G(^ACRITEM(ACRITMDA,"DT1")) D
.S DIE="^ACRDOC("
.S DA=ACRDOCDA
.S DR="103070////"_+^ACRITEM(ACRITMDA,"DT1")
.D DIE^ACRFDIC
Q
SSDISP W @IOF
N DXS,DIP,DC,D0,DN
S D0=ACRSSDA
D ^ACRPII
Q
ACRFSS1 ;IHS/OIRM/DSD/THL,AEF - ACRFSS CON'T; [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
+2 ;;CONTINUATION OF ACRFSS
EDIT ;EP;TO SELECT REQUEST ITEM TO EDIT
+1 NEW ACRI,ACRY
+2 IF ACRJ=1
Begin DoDot:1
+3 SET Y=1
+4 DO EDIT1
End DoDot:1
QUIT
+5 SET DIR(0)="LO^1:"_ACRSJ
+6 SET DIR("A")="Which Item(s)"
+7 WRITE !
+8 DO DIR^ACRFDIC
+9 IF $DATA(ACRQUIT)!$DATA(ACROUT)
KILL ACRQUIT
QUIT
EDIT1 SET ACRY=Y
+1 FOR ACRI=1:1
SET X=$PIECE(ACRY,",",ACRI)
IF X=""
QUIT
IF $DATA(ACRSS(X))
DO ED1
+2 KILL ACR25
+3 QUIT
ED1 WRITE !!?21,"Item NO. ",X
+1 SET ACRSSDA=+ACRSS(X)
+2 IF $PIECE(^ACRSS(ACRSSDA,0),U,12)
IF $PIECE($GET(^ACRITEM($PIECE(^(0),U,12),"DT")),U,9)
SET ACRSTOCK=""
+3 NEW ACRDR
+4 SET ACRDR="[ACR NON-STANDARD ITEM-2]"
+5 IF ACRREFX=116
IF $PIECE(^ACRDOC(ACRDOCDA,0),U,4)=36!($PIECE(^(0),U,4)=37)
Begin DoDot:1
+6 SET ACRDR="[ACR SUPPLY/SERVICES-CONTRACT]"
End DoDot:1
+7 IF $GET(ACRAPVT)=31!($GET(ACRAPVT)=6)
SET ACRSSDR="[ACR PROPERTY CLEARANCE]"
+8 DO EDIE
+9 IF $DATA(ACRTXLIM)&$DATA(ACRCHK)
DO CHECK1^ACRFWARN
+10 KILL ACRSTOCK
+11 QUIT
ADD ;EP;TO ADD NEW ITEM TO REQUEST
+1 DO FILE^ACRFDIC
+2 SET ACRSSDA=+Y
+3 SET ACRNEWSS=""
+4 SET DIE("NO^")=""
+5 IF $DATA(ACRSSDR)
NEW ACRDR
SET ACRDR=ACRSSDR
+6 DO EDIE
+7 KILL ACRNEWSS
+8 IF '$DATA(ACRSSDA)
QUIT
+9 SET ACRVENDA=+$GET(^ACRSS(ACRSSDA,"VND"))
+10 QUIT
ADD2 ;EP;
+1 SET ACRCANDA=$PIECE(^ACRLOCB($PIECE(ACRDOC0,U,6),"DT"),U,9)
+2 SET ACROCDA=$PIECE(ACROBLDT,U,3)
+3 SET X=ACRJ+1
+4 SET (DIC,DIE)="^ACRSS("
+5 SET DIC(0)="AELQZ"
+6 SET DIC("DR")=".02////"_ACRDOCDA_";.03////"_ACRDOCDA_";.04////"_$SELECT(ACROCDA:ACROCDA,1:"")_";.05////"_ACRCANDA_";.2////"_ACRDOCDA_";20////"_ACRDOCVN
+7 IF $GET(ACRCANDA)
IF '$DATA(ACRFDNCA)
SET ACRFDNCA=$PIECE(^AUTTCAN(ACRCANDA,0),U)
+8 IF $DATA(ACRXX)
Begin DoDot:1
+9 SET DIC("DR")=DIC("DR")_";1////"_ACRXX
+10 SET ACRCAN=$SELECT($DATA(ACRCAN):ACRCAN,1:ACRFDNCA)
End DoDot:1
+11 NEW ACRDR
+12 SET ACRDR=".05T;.04T"
+13 IF ACRREFX=116
IF $PIECE(^ACRDOC(ACRDOCDA,0),U,4)=36!($PIECE(^(0),U,4)=37)
Begin DoDot:1
+14 SET ACRDR=".06T;.04T"
End DoDot:1
+15 DO ADD
+16 QUIT
ADD1 ;EP;
+1 SET ACRCANDA=$PIECE(^ACRLOCB($PIECE(ACRDOC0,U,6),"DT"),U,9)
+2 SET X=ACRJ
+3 SET ACRITMNO=Y(0,0)
+4 NEW ACRY
+5 SET ACRY=^ACRITEM(ACRITMDA,"DT")
+6 SET ACRDSC=$GET(^ACRITEM(ACRITMDA,"DT2"))
+7 SET ACRDSC1=$PIECE(ACRY,U)
+8 SET ACRDSC2=$PIECE(ACRY,U,2)
+9 SET ACRNSN=$PIECE(ACRY,U,4)
+10 SET ACROCDA=$PIECE(ACRY,U,6)
+11 SET ACRVENON=$PIECE($GET(^ACRITEM(ACRITMDA,"DT1")),U,2)
+12 SET ACRNDC=$PIECE($GET(^ACRITEM(ACRITMDA,"DT1")),U,4)
+13 SET ACRUI=$PIECE(ACRY,U,12)
+14 SET ACRUC=$PIECE(ACRY,U,13)
+15 SET ACRVENDA=$PIECE(ACRY,U,14)
+16 IF ACRDSC1[";"
SET ACRDSC1=$TRANSLATE(ACRDSC1,";",",")
+17 IF ACRDSC2[";"
SET ACRDSC2=$TRANSLATE(ACRDSC2,";",",")
+18 IF $PIECE(ACRY,U,17)="8"
SET ACRUC=ACRUC*1.035
SET ACRSC="8"
+19 SET ACRNEW=""
+20 SET DIC="^ACRSS("
+21 SET DIC(0)="L"
+22 SET DIC("DR")=".02////"_ACRDOCDA_";.03////"_ACRDOCDA_";.04////"_ACROCDA_";.05////"_ACRCANDA_";.12////"_ACRITMDA_";.2////"_ACRDOCDA
+23 SET DIC("DR")=DIC("DR")_";1////"_ACRVENON_";2////"_ACRNSN_";3////"_ACRNDC_";11////"_ACRUI_";12////"_ACRUC_";21////"_ACRVENON_";20////"_ACRVENDA_";100////"_ACRDSC1_";101////"_ACRDSC2
+24 IF $PIECE(ACRY,U,17)="C"
SET DIC("DR")=DIC("DR")_";19////"_ACRSC
+25 IF $GET(ACRCANDA)
IF '$DATA(ACRFDNCA)
SET ACRFDNCA=$PIECE(^AUTTCAN(ACRCANDA,0),U)
+26 SET ACRCAN=$SELECT($DATA(ACRCAN):ACRCAN,1:ACRFDNCA)
+27 DO ADD
+28 QUIT
EDIE ;EP;TO EDIT AN ITEM ON A REQUEST
+1 SET ACRTXDA=$PIECE(ACRDOC0,U,4)
+2 IF $PIECE(^ACRSS(ACRSSDA,0),U,12)]""
Begin DoDot:1
+3 WRITE @IOF
+4 WRITE !?20,"INFORMATION FOR SELECTED "
+5 WRITE !?20,@ACRON,"SERVICE OR SUPPLY",@ACROF
+6 WRITE !!
+7 DO SSDISP
End DoDot:1
+8 DO NOW^%DTC
+9 SET ACRNOW=%
+10 IF $DATA(ACRNEW)
Begin DoDot:1
+11 KILL ACRNEW
+12 WRITE !!?10,ACRX," ",@ACRON,"ARE",@ACROF," on file."
+13 SET DIR(0)="YO"
+14 SET DIR("A")=" Add it to this request"
+15 SET DIR("B")="YES"
+16 WRITE !
+17 DO DIR^ACRFDIC
+18 IF Y'=1
Begin DoDot:2
+19 SET DA=ACRSSDA
+20 SET DIK="^ACRSS("
+21 DO DIK^ACRFDIC
+22 KILL ACRSSDA
+23 SET ACRQUIT=""
End DoDot:2
End DoDot:1
IF $DATA(ACRQUIT)
KILL ACRQUIT
QUIT
+24 IF $GET(ACRCANDA)
IF '$DATA(ACRFDNCA)
SET ACRFDNCA=$PIECE(^AUTTCAN(ACRCANDA,0),U)
+25 SET ACRCAN=$SELECT($DATA(ACRCAN):ACRCAN,1:ACRFDNCA)
+26 SET DA=ACRSSDA
+27 SET DIE="^ACRSS("
+28 SET DR=$SELECT($DATA(ACRSSDR):ACRSSDR,1:ACRDR)
DIE1 IF $DATA(ACRNEWSS)
SET DIE("NO^")=""
+1 SET ACRDDIE="SSDISP^ACRFSS1"
+2 SET ACRMESS="ITEM NO. "_$PIECE(^ACRSS(DA,0),U)
+3 IF DR'="[ACR PROPERTY CLEARANCE]"
DO SCREEN^ACRFAU
+4 IF '$DATA(ACRSCREN)
DO DIE^ACRFDIC
+5 IF '$DATA(ACRSSDR)
Begin DoDot:1
+6 SET DA=ACRSSDA
+7 SET DIE="^ACRSS("
+8 SET DR=$SELECT(ACRTXDA=36!(ACRTXDA=37):"[ACR SUPPLY/SERVICES-CONTRACT]",ACRTXDA'=35:"[ACR SUPPLY/SERVICES INFO-2]",1:"[ACR CREDIT CARD ITEM]")
+9 FOR
DO ^ACRFESS
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+10 KILL ACRQUIT
End DoDot:1
+11 KILL ACRSSDR,ACRDDIE,ACRMESS
+12 DO SSCHK^ACRFSSA
+13 IF '$DATA(ACRSSTOT)
SET ACRSSTOT=0
+14 SET ACRSSTOT=ACRSSTOT+$PIECE(^ACRSS(ACRSSDA,"DT"),U,4)
+15 SET DA=ACRSSDA
+16 SET DIE="^ACRSS("
+17 SET DR="14////"_$PIECE(^ACRSS(ACRSSDA,"DT"),U)
+18 DO DIE^ACRFDIC
+19 IF $GET(ACRITMDA)
IF '$PIECE($GET(^ACRDOC(ACRDOCDA,"PO")),U,5)
IF +$GET(^ACRITEM(ACRITMDA,"DT1"))
Begin DoDot:1
+20 SET DIE="^ACRDOC("
+21 SET DA=ACRDOCDA
+22 SET DR="103070////"_+^ACRITEM(ACRITMDA,"DT1")
+23 DO DIE^ACRFDIC
End DoDot:1
+24 QUIT
SSDISP WRITE @IOF
+1 NEW DXS,DIP,DC,D0,DN
+2 SET D0=ACRSSDA
+3 DO ^ACRPII
+4 QUIT
