ACRFSS1.m

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