- 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
