ACRFPSC ;IHS/OIRM/DSD/THL,AEF - SOLICITATION FOR COMMERCIAL ITEMS; [ 09/23/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
F X=1:1:18 K @("ACR"_X)
Q
EN1 D GATHER,^ACRFPSC1
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 ACR17=$P(ACRPO,U,5)
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)
VENDOR ;
S X=$G(^AUTTVNDR(+ACR17,11))
S ACR17(1)=$P($G(^AUTTVNDR(+ACR17,0)),U)
S ACR17(7)=$P(X,U,6)
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 ACR3=$P(ACRPO,U)
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="XX"
S ACR13B="RATING"
Q
ACRFPSC ;IHS/OIRM/DSD/THL,AEF - SOLICITATION FOR COMMERCIAL ITEMS; [ 09/23/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
+1 FOR X=1:1:18
KILL @("ACR"_X)
+2 QUIT
EN1 DO GATHER
DO ^ACRFPSC1
+1 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 ACR17=$PIECE(ACRPO,U,5)
+7 SET X=$GET(^AUTTPRG(+ACR9,"DT"))
+8 SET ACR9(1)=$PIECE($GET(^AUTTPRG(+ACR9,0)),U)
+9 SET ACR9(2)=$PIECE(X,U)
+10 SET ACR9(3)=$PIECE(X,U,2)
+11 SET ACR9(4)=$PIECE(X,U,3)
+12 SET ACR9(5)=$PIECE(X,U,4)
+13 SET ACR9(6)=$PIECE(X,U,5)
+14 SET ACR9(7)=$PIECE(X,U,6)
+15 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)
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,6)
+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 ACR3=$PIECE(ACRPO,U)
+12 SET ACR4=$PIECE(ACRPO,U,3)
+13 SET ACR7A=+$GET(^ACRDOC(ACRDOCDA,"PA"))
+14 SET ACR7B=$PIECE($GET(^ACRPO(+$GET(ACRPODA),0)),U,9)
+15 ;S X=$P($G(^VA(200,+ACR7A,0)),U) ;ACR*2.1*19.02 IM16848
+16 ;ACR*2.1*19.02 IM16848
SET X=$$NAME2^ACRFUTL1(+ACR7A)
+17 SET X=$PIECE($PIECE(X,",",2)," ")_" "_$PIECE(X,",")
+18 SET ACR7A=X
+19 SET ACR12=$PIECE(ACRPO,U,13)
+20 SET ACR13A="XX"
+21 SET ACR13B="RATING"
+22 QUIT
