ACRF1449 ;IHS/OIRM/DSD/THL,AEF - SOLICITATION FOR COMMERCIAL ITEMS; [ 09/22/2005 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**19**;NOV 05, 2001
EN D ^ACRFSSPO,EN1
EXIT K ACRX,ACR7A,ACR7B,ACR13A,ACR13B,ACR17B,ACR18B,ACR27A,ACR27A1,ACR27B,ACR27B1,ACREFFD
F X=1:1:18 K @("ACR"_X)
Q
EN1 D GATHER
D ^ACRF1441:'$D(ACRORIGF)
D ^ACRF1442:$D(ACRORIGF)
Q
GATHER ;GATHER ALL INFO REQUIRED TO PRINT THE DOCUMENT
D SETDOC^ACRFEA1
S ACRPO=$G(^ACRDOC(ACRDOCDA,"PO"))
S ACR9=$G(^ACRDOC(ACRDOCDA,"POIO"))
S ACR15=$G(^ACRDOC(ACRDOCDA,"POST"))
S ACR18=$G(^ACRDOC(ACRDOCDA,"POMI"))
S ACR26=$G(^ACRDOC(ACRDOCDA,26))
S ACR33=$G(^ACRDOC(ACRDOCDA,33))
S ACR21=$G(^ACRDOC(ACRDOCDA,21))
S ACR17=$P(ACRPO,U,5)
S ACR5=$P(ACR33,U,3)
S X=$P(ACR33,U,2)
S ACR6=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
S X=$P(ACR33,U,11)
S ACR8=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
S X=$G(^AUTTPRG(+ACR9,"DT"))
S ACR9(1)=$P($G(^AUTTPRG(+ACR9,0)),U)
S ACR9(2)=$P(X,U)
S ACR9(3)=$P(X,U,2)
S ACR9(4)=$P(X,U,3)
S ACR9(5)=$P(X,U,4)
S ACR9(6)=$P(X,U,5)
S ACR9(7)=$P(X,U,6)
S ACR9(5)=$P($G(^DIC(5,+ACR9(5),0)),U,2)
DELIVER S X=$G(^AUTTPRG(+ACR15,"DT"))
S ACR15(1)=$P($G(^AUTTPRG(+ACR15,0)),U)
S ACR15(2)=$P(X,U)
S ACR15(3)=$P(X,U,2)
S ACR15(4)=$P(X,U,3)
S ACR15(5)=$P(X,U,4)
S ACR15(6)=$P(X,U,5)
S ACR15(7)=$P(X,U,6)
S ACR15(5)=$P($G(^DIC(5,+ACR15(5),0)),U,2)
ADMIN S X=$G(^AUTTPRG(+$P(ACR26,U,6),"DT"))
S ACR16(1)=$P($G(^AUTTPRG(+$P(ACR26,U,6),0)),U)
S ACR16(2)=$P(X,U)
S ACR16(3)=$P(X,U,2)
S ACR16(4)=$P(X,U,3)
S ACR16(5)=$P(X,U,4)
S ACR16(6)=$P(X,U,5)
S ACR16(7)=$P(X,U,6)
S ACR16(5)=$P($G(^DIC(5,+ACR16(5),0)),U,2)
VENDOR ;
S X=$G(^AUTTVNDR(+ACR17,11))
S ACR17(1)=$P($G(^AUTTVNDR(+ACR17,0)),U)
S ACR17(7)=$P(X,U,13)
S X=$G(^AUTTVNDR(+ACR17,13))
S ACR17(2)=$P(X,U)
S ACR17(3)=$P(X,U,10)
S ACR17(4)=$P(X,U,2)
S ACR17(5)=$P(X,U,3)
S ACR17(6)=$P(X,U,4)
S ACR17(5)=$P($G(^DIC(5,+ACR17(5),0)),U,2)
PAY S X=$G(^AUTTPRG(+ACR18,"DT"))
S ACR18(1)=$P($G(^AUTTPRG(+ACR18,0)),U)
S ACR18(2)=$P(X,U)
S ACR18(3)=$P(X,U,2)
S ACR18(4)=$P(X,U,3)
S ACR18(5)=$P(X,U,4)
S ACR18(6)=$P(X,U,5)
S ACR18(7)=$P(X,U,6)
S ACR18(5)=$P($G(^DIC(5,+ACR18(5),0)),U,2)
S ACR1=$P(ACRDOC0,U)
S ACR2=$P(ACRDOC0,U,2)
S Y=$P(ACRPO,U)
X ^DD("DD")
S (ACR3,ACREFFD)=Y
S ACR4=$P(ACRPO,U,3)
S ACR7A=+$G(^ACRDOC(ACRDOCDA,"PA"))
S ACR7B=$P($G(^ACRPO(+$G(ACRPODA),0)),U,9)
;S X=$P($G(^VA(200,+ACR7A,0)),U) ;ACR*2.1*19.02 IM16848
S X=$$NAME2^ACRFUTL1(+ACR7A) ;ACR*2.1*19.02 IM16848
S X=$P($P(X,",",2)," ")_" "_$P(X,",")
S ACR7A=X
S ACR12=$P(ACRPO,U,13)
S ACR13A=$S($P(ACR26,0):"XX",1:"")
S ACR13B=$P(ACR26,U)
Q
DISP ;EP;
D DISP^ACRF1442
Q
33030(X) S X=$P(ACR33,U,3)
Q X
ACRF1449 ;IHS/OIRM/DSD/THL,AEF - SOLICITATION FOR COMMERCIAL ITEMS; [ 09/22/2005 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**19**;NOV 05, 2001
EN DO ^ACRFSSPO
DO EN1
EXIT KILL ACRX,ACR7A,ACR7B,ACR13A,ACR13B,ACR17B,ACR18B,ACR27A,ACR27A1,ACR27B,ACR27B1,ACREFFD
+1 FOR X=1:1:18
KILL @("ACR"_X)
+2 QUIT
EN1 DO GATHER
+1 IF '$DATA(ACRORIGF)
DO ^ACRF1441
+2 IF $DATA(ACRORIGF)
DO ^ACRF1442
+3 QUIT
GATHER ;GATHER ALL INFO REQUIRED TO PRINT THE DOCUMENT
+1 DO SETDOC^ACRFEA1
+2 SET ACRPO=$GET(^ACRDOC(ACRDOCDA,"PO"))
+3 SET ACR9=$GET(^ACRDOC(ACRDOCDA,"POIO"))
+4 SET ACR15=$GET(^ACRDOC(ACRDOCDA,"POST"))
+5 SET ACR18=$GET(^ACRDOC(ACRDOCDA,"POMI"))
+6 SET ACR26=$GET(^ACRDOC(ACRDOCDA,26))
+7 SET ACR33=$GET(^ACRDOC(ACRDOCDA,33))
+8 SET ACR21=$GET(^ACRDOC(ACRDOCDA,21))
+9 SET ACR17=$PIECE(ACRPO,U,5)
+10 SET ACR5=$PIECE(ACR33,U,3)
+11 SET X=$PIECE(ACR33,U,2)
+12 SET ACR6=$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)
+13 SET X=$PIECE(ACR33,U,11)
+14 SET ACR8=$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)
+15 SET X=$GET(^AUTTPRG(+ACR9,"DT"))
+16 SET ACR9(1)=$PIECE($GET(^AUTTPRG(+ACR9,0)),U)
+17 SET ACR9(2)=$PIECE(X,U)
+18 SET ACR9(3)=$PIECE(X,U,2)
+19 SET ACR9(4)=$PIECE(X,U,3)
+20 SET ACR9(5)=$PIECE(X,U,4)
+21 SET ACR9(6)=$PIECE(X,U,5)
+22 SET ACR9(7)=$PIECE(X,U,6)
+23 SET ACR9(5)=$PIECE($GET(^DIC(5,+ACR9(5),0)),U,2)
DELIVER SET X=$GET(^AUTTPRG(+ACR15,"DT"))
+1 SET ACR15(1)=$PIECE($GET(^AUTTPRG(+ACR15,0)),U)
+2 SET ACR15(2)=$PIECE(X,U)
+3 SET ACR15(3)=$PIECE(X,U,2)
+4 SET ACR15(4)=$PIECE(X,U,3)
+5 SET ACR15(5)=$PIECE(X,U,4)
+6 SET ACR15(6)=$PIECE(X,U,5)
+7 SET ACR15(7)=$PIECE(X,U,6)
+8 SET ACR15(5)=$PIECE($GET(^DIC(5,+ACR15(5),0)),U,2)
ADMIN SET X=$GET(^AUTTPRG(+$PIECE(ACR26,U,6),"DT"))
+1 SET ACR16(1)=$PIECE($GET(^AUTTPRG(+$PIECE(ACR26,U,6),0)),U)
+2 SET ACR16(2)=$PIECE(X,U)
+3 SET ACR16(3)=$PIECE(X,U,2)
+4 SET ACR16(4)=$PIECE(X,U,3)
+5 SET ACR16(5)=$PIECE(X,U,4)
+6 SET ACR16(6)=$PIECE(X,U,5)
+7 SET ACR16(7)=$PIECE(X,U,6)
+8 SET ACR16(5)=$PIECE($GET(^DIC(5,+ACR16(5),0)),U,2)
VENDOR ;
+1 SET X=$GET(^AUTTVNDR(+ACR17,11))
+2 SET ACR17(1)=$PIECE($GET(^AUTTVNDR(+ACR17,0)),U)
+3 SET ACR17(7)=$PIECE(X,U,13)
+4 SET X=$GET(^AUTTVNDR(+ACR17,13))
+5 SET ACR17(2)=$PIECE(X,U)
+6 SET ACR17(3)=$PIECE(X,U,10)
+7 SET ACR17(4)=$PIECE(X,U,2)
+8 SET ACR17(5)=$PIECE(X,U,3)
+9 SET ACR17(6)=$PIECE(X,U,4)
+10 SET ACR17(5)=$PIECE($GET(^DIC(5,+ACR17(5),0)),U,2)
PAY SET X=$GET(^AUTTPRG(+ACR18,"DT"))
+1 SET ACR18(1)=$PIECE($GET(^AUTTPRG(+ACR18,0)),U)
+2 SET ACR18(2)=$PIECE(X,U)
+3 SET ACR18(3)=$PIECE(X,U,2)
+4 SET ACR18(4)=$PIECE(X,U,3)
+5 SET ACR18(5)=$PIECE(X,U,4)
+6 SET ACR18(6)=$PIECE(X,U,5)
+7 SET ACR18(7)=$PIECE(X,U,6)
+8 SET ACR18(5)=$PIECE($GET(^DIC(5,+ACR18(5),0)),U,2)
+9 SET ACR1=$PIECE(ACRDOC0,U)
+10 SET ACR2=$PIECE(ACRDOC0,U,2)
+11 SET Y=$PIECE(ACRPO,U)
+12 XECUTE ^DD("DD")
+13 SET (ACR3,ACREFFD)=Y
+14 SET ACR4=$PIECE(ACRPO,U,3)
+15 SET ACR7A=+$GET(^ACRDOC(ACRDOCDA,"PA"))
+16 SET ACR7B=$PIECE($GET(^ACRPO(+$GET(ACRPODA),0)),U,9)
+17 ;S X=$P($G(^VA(200,+ACR7A,0)),U) ;ACR*2.1*19.02 IM16848
+18 ;ACR*2.1*19.02 IM16848
SET X=$$NAME2^ACRFUTL1(+ACR7A)
+19 SET X=$PIECE($PIECE(X,",",2)," ")_" "_$PIECE(X,",")
+20 SET ACR7A=X
+21 SET ACR12=$PIECE(ACRPO,U,13)
+22 SET ACR13A=$SELECT($PIECE(ACR26,0):"XX",1:"")
+23 SET ACR13B=$PIECE(ACR26,U)
+24 QUIT
DISP ;EP;
+1 DO DISP^ACRF1442
+2 QUIT
33030(X) SET X=$PIECE(ACR33,U,3)
+1 QUIT X
