- 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
