ACRF347 ;IHS/OIRM/DSD/THL,AEF - SOLICITATION FOR COMMERCIAL ITEMS; [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
EN D ^ACRFSSPO,EN1
EXIT K ACRX,ACREFFD
F X=1:1:21,211 K @("ACR"_X)
K ACR211
Q
EN1 S:IOSL<62 IOSL=62
I '$D(ACRORIGF) D ^ACRPSS Q
D GATHER
D ^ACRF3472:$D(ACRORIGF)
Q
GATHER ;GATHER ALL INFO REQUIRED TO PRINT THE DOCUMENT
D SETDOC^ACRFEA1
N ACRPO
S ACRPO=$G(^ACRDOC(ACRDOCDA,"PO"))
S ACR5=$G(^ACRDOC(ACRDOCDA,"POIO"))
S ACR6=$G(^ACRDOC(ACRDOCDA,"POST"))
S ACR21=$G(^ACRDOC(ACRDOCDA,"POMI"))
S ACR26=$G(^ACRDOC(ACRDOCDA,26))
S ACR33=$G(^ACRDOC(ACRDOCDA,33))
S ACR211=$G(^ACRDOC(ACRDOCDA,21))
S ACR7=$P(ACRPO,U,5)
S ACR11=$P(ACRPO,U,8)
S X=$G(^AUTTPRG(+ACR5,"DT"))
ISSUE S ACR5(1)=$P($G(^AUTTPRG(+ACR5,0)),U)
S ACR5(2)=$P(X,U)
S ACR5(3)=$P(X,U,2)
S ACR5(4)=$P(X,U,3)
S ACR5(5)=$P(X,U,4)
S ACR5(6)=$P(X,U,5)
S ACR5(7)=$P(X,U,6)
S ACR5(5)=$P($G(^DIC(5,+ACR5(5),0)),U,2)
SHIPTO S X=$G(^AUTTPRG(+ACR6,"DT"))
S ACR6(1)=$P($G(^AUTTPRG(+ACR6,0)),U)
S ACR6(2)=$P(X,U)
S ACR6(3)=$P(X,U,2)
S ACR6(4)=$P(X,U,3)
S ACR6(5)=$P(X,U,4)
S ACR6(6)=$P(X,U,5)
S ACR6(7)=$P(X,U,6)
S ACR6(5)=$P($G(^DIC(5,+ACR6(5),0)),U,2)
VENDOR S X=$G(^AUTTVNDR(+ACR7,11))
S ACR7(1)=$P($G(^AUTTVNDR(+ACR7,0)),U)
S ACR7(7)=$P(X,U,13)
S X=$G(^AUTTVNDR(+ACR7,13))
S ACR7(2)=$P(X,U)
S ACR7(3)=$P(X,U,10)
S ACR7(4)=$P(X,U,2)
S ACR7(5)=$P(X,U,3)
S ACR7(6)=$P(X,U,4)
S ACR7(5)=$P($G(^DIC(5,+ACR7(5),0)),U,2)
PAY S X=$G(^AUTTPRG(+ACR21,"DT"))
S ACR21(1)=$P($G(^AUTTPRG(+ACR21,0)),U)
S ACR21(2)=$P(X,U)
S ACR21(3)=$P(X,U,2)
S ACR21(4)=$P(X,U,3)
S ACR21(5)=$P(X,U,4)
S ACR21(6)=$P(X,U,5)
S ACR21(7)=$P(X,U,6)
S ACR21(5)=$P($G(^DIC(5,+ACR21(5),0)),U,2)
S ACR1=$P(ACRDOC0,U)
S ACR2=$P(ACRDOC0,U,2)
S Y=$P(ACRPO,U)
X ^DD("DD")
N ACREFFD
S ACREFFD=Y
S ACR3=$P(ACRPO,U,3)
S X=+$G(^ACRDOC(ACRDOCDA,"PA"))
S ACR7B=$P($G(^ACRPO(+$G(ACRPODA),0)),U,9)
S ACR12=$P(ACRPO,U,9)
S X=$P(^DD(9002196,103120,0),U,3)
S:ACR12 ACR12=$P($P(X,((ACR12)_":"),2),";")
S ACR13=$P(ACRPO,U,11)
S:ACR13 ACR13=$P(^AUTTPRG(ACR13,0),U)
S ACR14=$P(ACRPO,U,10)
S Y=$P(ACRPO,U,12)
X ^DD("DD")
S ACR15=Y
S X=$P(ACRPO,U,13)
S ACR16(1)=$E(X,1,15)
S ACR16(2)=$E(X,16,30)
S ACR18=$P(ACRPO,U,14)
S ACR19=$P(ACRPO,U,15)
S ACR20=$P(ACRPO,U,16)
Q
DISP ;EP;
D DISP^ACRF3472
Q
ACRF347 ;IHS/OIRM/DSD/THL,AEF - SOLICITATION FOR COMMERCIAL ITEMS; [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
EN DO ^ACRFSSPO
DO EN1
EXIT KILL ACRX,ACREFFD
+1 FOR X=1:1:21,211
KILL @("ACR"_X)
+2 KILL ACR211
+3 QUIT
EN1 IF IOSL<62
SET IOSL=62
+1 IF '$DATA(ACRORIGF)
DO ^ACRPSS
QUIT
+2 DO GATHER
+3 IF $DATA(ACRORIGF)
DO ^ACRF3472
+4 QUIT
GATHER ;GATHER ALL INFO REQUIRED TO PRINT THE DOCUMENT
+1 DO SETDOC^ACRFEA1
+2 NEW ACRPO
+3 SET ACRPO=$GET(^ACRDOC(ACRDOCDA,"PO"))
+4 SET ACR5=$GET(^ACRDOC(ACRDOCDA,"POIO"))
+5 SET ACR6=$GET(^ACRDOC(ACRDOCDA,"POST"))
+6 SET ACR21=$GET(^ACRDOC(ACRDOCDA,"POMI"))
+7 SET ACR26=$GET(^ACRDOC(ACRDOCDA,26))
+8 SET ACR33=$GET(^ACRDOC(ACRDOCDA,33))
+9 SET ACR211=$GET(^ACRDOC(ACRDOCDA,21))
+10 SET ACR7=$PIECE(ACRPO,U,5)
+11 SET ACR11=$PIECE(ACRPO,U,8)
+12 SET X=$GET(^AUTTPRG(+ACR5,"DT"))
ISSUE SET ACR5(1)=$PIECE($GET(^AUTTPRG(+ACR5,0)),U)
+1 SET ACR5(2)=$PIECE(X,U)
+2 SET ACR5(3)=$PIECE(X,U,2)
+3 SET ACR5(4)=$PIECE(X,U,3)
+4 SET ACR5(5)=$PIECE(X,U,4)
+5 SET ACR5(6)=$PIECE(X,U,5)
+6 SET ACR5(7)=$PIECE(X,U,6)
+7 SET ACR5(5)=$PIECE($GET(^DIC(5,+ACR5(5),0)),U,2)
SHIPTO SET X=$GET(^AUTTPRG(+ACR6,"DT"))
+1 SET ACR6(1)=$PIECE($GET(^AUTTPRG(+ACR6,0)),U)
+2 SET ACR6(2)=$PIECE(X,U)
+3 SET ACR6(3)=$PIECE(X,U,2)
+4 SET ACR6(4)=$PIECE(X,U,3)
+5 SET ACR6(5)=$PIECE(X,U,4)
+6 SET ACR6(6)=$PIECE(X,U,5)
+7 SET ACR6(7)=$PIECE(X,U,6)
+8 SET ACR6(5)=$PIECE($GET(^DIC(5,+ACR6(5),0)),U,2)
VENDOR SET X=$GET(^AUTTVNDR(+ACR7,11))
+1 SET ACR7(1)=$PIECE($GET(^AUTTVNDR(+ACR7,0)),U)
+2 SET ACR7(7)=$PIECE(X,U,13)
+3 SET X=$GET(^AUTTVNDR(+ACR7,13))
+4 SET ACR7(2)=$PIECE(X,U)
+5 SET ACR7(3)=$PIECE(X,U,10)
+6 SET ACR7(4)=$PIECE(X,U,2)
+7 SET ACR7(5)=$PIECE(X,U,3)
+8 SET ACR7(6)=$PIECE(X,U,4)
+9 SET ACR7(5)=$PIECE($GET(^DIC(5,+ACR7(5),0)),U,2)
PAY SET X=$GET(^AUTTPRG(+ACR21,"DT"))
+1 SET ACR21(1)=$PIECE($GET(^AUTTPRG(+ACR21,0)),U)
+2 SET ACR21(2)=$PIECE(X,U)
+3 SET ACR21(3)=$PIECE(X,U,2)
+4 SET ACR21(4)=$PIECE(X,U,3)
+5 SET ACR21(5)=$PIECE(X,U,4)
+6 SET ACR21(6)=$PIECE(X,U,5)
+7 SET ACR21(7)=$PIECE(X,U,6)
+8 SET ACR21(5)=$PIECE($GET(^DIC(5,+ACR21(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 NEW ACREFFD
+14 SET ACREFFD=Y
+15 SET ACR3=$PIECE(ACRPO,U,3)
+16 SET X=+$GET(^ACRDOC(ACRDOCDA,"PA"))
+17 SET ACR7B=$PIECE($GET(^ACRPO(+$GET(ACRPODA),0)),U,9)
+18 SET ACR12=$PIECE(ACRPO,U,9)
+19 SET X=$PIECE(^DD(9002196,103120,0),U,3)
+20 IF ACR12
SET ACR12=$PIECE($PIECE(X,((ACR12)_":"),2),";")
+21 SET ACR13=$PIECE(ACRPO,U,11)
+22 IF ACR13
SET ACR13=$PIECE(^AUTTPRG(ACR13,0),U)
+23 SET ACR14=$PIECE(ACRPO,U,10)
+24 SET Y=$PIECE(ACRPO,U,12)
+25 XECUTE ^DD("DD")
+26 SET ACR15=Y
+27 SET X=$PIECE(ACRPO,U,13)
+28 SET ACR16(1)=$EXTRACT(X,1,15)
+29 SET ACR16(2)=$EXTRACT(X,16,30)
+30 SET ACR18=$PIECE(ACRPO,U,14)
+31 SET ACR19=$PIECE(ACRPO,U,15)
+32 SET ACR20=$PIECE(ACRPO,U,16)
+33 QUIT
DISP ;EP;
+1 DO DISP^ACRF3472
+2 QUIT
