ACRFPO3 ;IHS/OIRM/DSD/THL,AEF - PURCHASE ORDER PROCESSING - CONT; [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
;;CONTINUATION OF ACRFPO
LOOKUP ;EP;LOOKUP UTILITY FOR REQUISITION/PURCHASE ORDERS
W @IOF
W !?21,$S($D(ACRCANCL):"DOCUMENT",'$D(ACRREQST):"PURCHASE ORDER",$D(ACRCALL):"CALL AGAINST A BPA",1:"REQUISITION")," LOOKUP UTILITY"
S DIC="^ACRDOC("
S DIC(0)="AEMQZ"
S DIC("A")=$S('$D(ACRCANCL):"Requisition/PO NO.: ",1:"Document NO.: "),ZTRTN="^ACRFQ"
S D="B^C^G^J^FS^O^PVEN"
S:'$D(ACRREQST) D="C^B^G^J^FS^O^PVEN"
I '$D(DIC("S")) D
.S:'$D(ACRREQST) DIC("S")="S ACRREF=$P(^ACRDOC(+Y,0),U,13),ACRREF=$P(^AUTTDOCR(ACRREF,0),U) I ""^103^349^326^210^""[(U_ACRREF_U)!(ACRREF=116&($P(^ACRDOC(+Y,0),U,4)=35)),$P($G(^ACROBL(+Y,""APV"")),U,8)="""""
.S:$D(ACRREQST) DIC("S")="S ACRREFDA=$P(^ACRDOC(+Y,0),U,13),ACRREF=$P($G(^AUTTDOCR(+ACRREFDA,0)),U) I ""^103^116^204^349^326^210^""[(U_ACRREF_U)"
.S:$D(ACRCALL) DIC("S")="I $P(^ACRDOC(+Y,0),U,19)"
I $D(ACRCANCL) D
.S DIC("S")="I $$OBL^ACRFEA(+Y),$D(^ACRDOC(+Y,0)) K ACRQUIT N ACRX S ACRX=^(0),ACRREF=$P(ACRX,U,13),ACROBLAP=$G(^ACROBL(+Y,""APV"")) S ACRREF=$P($G(^AUTTDOCR(+ACRREF,0)),U)"
.S DIC("S")=DIC("S")_" I $E(ACROBLAP)=""A"",'$P(ACROBLAP,U,11),""^103^349^326^204^210^130^600^148^""[(U_ACRREF_U)!(ACRREF=116&($P(ACRX,U,4)=35)!($P(ACRX,U,12)))"
I $D(ACRCNCYO) D
.S DIC("S")="K ACR S ACR($P($G(^ACRDOC(+Y,""REQ2"")),U,8))="""",ACR($P($G(^(""TO"")),U,9))="""",ACRAPV=$E($G(^ACROBL(+Y,""APV""))),ACR($P(^(0),U,5))="""" I ACRAPV="""",$D(ACR(DUZ))#2"
K ACRCNCYO
S:$D(ACRRR)#2 DIC("S")=DIC("S")_" I $P($G(^ACROBL(+Y,""APV"")),U,6),$D(^ACRRR(""AC"",+Y))"
S:$D(ACRFEDS) DIC("S")=DIC("S")_" I $D(^ACRDOC(+Y,3)),$P(^(3),U,13)"
W !!
D MIX^ACRFDIC
I +Y<1!$D(ACRQUIT)!$D(ACROUT) S ACRQUIT="" Q
S ACRDOCDA=+Y
D SETDOC^ACRFEA1
I $P(^ACRDOC(ACRDOCDA,0),U,19) D
.S ACRREQST=""
.S ACRREF=116
.S ACRRTN="^ACROBL"
S ACRREFX=$S('$D(ACRREQST):103,1:116)
I '$D(ACRREQST) S ACRREFX=$P(^ACRDOC(ACRDOCDA,0),U,13),ACRREFX=$P(^AUTTDOCR(ACRREFX,0),U) S:ACRREFX=210 ACRREFX=103
;I ACRREF=116,$P(ACRDOC0,U,4)=35!$P(ACRDOC0,U,12)!$P(ACRDOC0,U,19) S ACRREFX=116,ACRREQST=""
;I $P(ACRDOC0,U,4)=35!$P(ACRDOC0,U,12)!$P(ACRDOC0,U,19) S ACRREFX=116,ACRREQST=""
I $P(ACRDOC0,U,4)=35!$P(ACRDOC0,U,19) S ACRREFX=116,ACRREQST=""
S:ACRREFX=210 ACRREFX=103
Q
CHKLIST ;EP;EDIT SMALL PURCHASE CHECK LIST
D PCLIST
I '$D(^ACRSPCL("B",ACRDOCDA)) D I 1
.S X=ACRDOCDA
.S DIC="^ACRSPCL("
.S DIC(0)="L"
.D FILE^ACRFDIC
.S DA=+Y
E S DA=$O(^ACRSPCL("B",ACRDOCDA,0))
Q:'DA
S DR="[ACR SP CHECKLIST]"
S DIE="^ACRSPCL("
W !
D DDS^ACRFDIC
Q:'$D(ACRSCREN)
K ACRSCREN
D DIE^ACRFDIC
Q
PCLIST ;EP;TO PRINT SMALL PURCHASE CHECK LIST
S D0=ACRDOCDA
S D0=$O(^ACRSPCL("B",D0,0))
Q:'D0
S (ACRRTN,ZTRTN)="PCL^ACRFPO3"
S ZTDESC="SMALL PURCHASE CHECKLIST"
D ^ACRFZIS
Q
PCL ;EP;
K DXS,DIP
D ^ACRSPCL
Q
ACRFPO3 ;IHS/OIRM/DSD/THL,AEF - PURCHASE ORDER PROCESSING - CONT; [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
+2 ;;CONTINUATION OF ACRFPO
LOOKUP ;EP;LOOKUP UTILITY FOR REQUISITION/PURCHASE ORDERS
+1 WRITE @IOF
+2 WRITE !?21,$SELECT($DATA(ACRCANCL):"DOCUMENT",'$DATA(ACRREQST):"PURCHASE ORDER",$DATA(ACRCALL):"CALL AGAINST A BPA",1:"REQUISITION")," LOOKUP UTILITY"
+3 SET DIC="^ACRDOC("
+4 SET DIC(0)="AEMQZ"
+5 SET DIC("A")=$SELECT('$DATA(ACRCANCL):"Requisition/PO NO.: ",1:"Document NO.: ")
SET ZTRTN="^ACRFQ"
+6 SET D="B^C^G^J^FS^O^PVEN"
+7 IF '$DATA(ACRREQST)
SET D="C^B^G^J^FS^O^PVEN"
+8 IF '$DATA(DIC("S"))
Begin DoDot:1
+9 IF '$DATA(ACRREQST)
SET DIC("S")="S ACRREF=$P(^ACRDOC(+Y,0),U,13),ACRREF=$P(^AUTTDOCR(ACRREF,0),U) I ""^103^349^326^210^""[(U_ACRREF_U)!(ACRREF=116&($P(^ACRDOC(+Y,0),U,4)=35)),$P($G(^ACROBL(+Y,""APV"")),U,8)="""""
+10 IF $DATA(ACRREQST)
SET DIC("S")="S ACRREFDA=$P(^ACRDOC(+Y,0),U,13),ACRREF=$P($G(^AUTTDOCR(+ACRREFDA,0)),U) I ""^103^116^204^349^326^210^""[(U_ACRREF_U)"
+11 IF $DATA(ACRCALL)
SET DIC("S")="I $P(^ACRDOC(+Y,0),U,19)"
End DoDot:1
+12 IF $DATA(ACRCANCL)
Begin DoDot:1
+13 SET DIC("S")="I $$OBL^ACRFEA(+Y),$D(^ACRDOC(+Y,0)) K ACRQUIT N ACRX S ACRX=^(0),ACRREF=$P(ACRX,U,13),ACROBLAP=$G(^ACROBL(+Y,""APV"")) S ACRREF=$P($G(^AUTTDOCR(+ACRREF,0)),U)"
+14 SET DIC("S")=DIC("S")_" I $E(ACROBLAP)=""A"",'$P(ACROBLAP,U,11),""^103^349^326^204^210^130^600^148^""[(U_ACRREF_U)!(ACRREF=116&($P(ACRX,U,4)=35)!($P(ACRX,U,12)))"
End DoDot:1
+15 IF $DATA(ACRCNCYO)
Begin DoDot:1
+16 SET DIC("S")="K ACR S ACR($P($G(^ACRDOC(+Y,""REQ2"")),U,8))="""",ACR($P($G(^(""TO"")),U,9))="""",ACRAPV=$E($G(^ACROBL(+Y,""APV""))),ACR($P(^(0),U,5))="""" I ACRAPV="""",$D(ACR(DUZ))#2"
End DoDot:1
+17 KILL ACRCNCYO
+18 IF $DATA(ACRRR)#2
SET DIC("S")=DIC("S")_" I $P($G(^ACROBL(+Y,""APV"")),U,6),$D(^ACRRR(""AC"",+Y))"
+19 IF $DATA(ACRFEDS)
SET DIC("S")=DIC("S")_" I $D(^ACRDOC(+Y,3)),$P(^(3),U,13)"
+20 WRITE !!
+21 DO MIX^ACRFDIC
+22 IF +Y<1!$DATA(ACRQUIT)!$DATA(ACROUT)
SET ACRQUIT=""
QUIT
+23 SET ACRDOCDA=+Y
+24 DO SETDOC^ACRFEA1
+25 IF $PIECE(^ACRDOC(ACRDOCDA,0),U,19)
Begin DoDot:1
+26 SET ACRREQST=""
+27 SET ACRREF=116
+28 SET ACRRTN="^ACROBL"
End DoDot:1
+29 SET ACRREFX=$SELECT('$DATA(ACRREQST):103,1:116)
+30 IF '$DATA(ACRREQST)
SET ACRREFX=$PIECE(^ACRDOC(ACRDOCDA,0),U,13)
SET ACRREFX=$PIECE(^AUTTDOCR(ACRREFX,0),U)
IF ACRREFX=210
SET ACRREFX=103
+31 ;I ACRREF=116,$P(ACRDOC0,U,4)=35!$P(ACRDOC0,U,12)!$P(ACRDOC0,U,19) S ACRREFX=116,ACRREQST=""
+32 ;I $P(ACRDOC0,U,4)=35!$P(ACRDOC0,U,12)!$P(ACRDOC0,U,19) S ACRREFX=116,ACRREQST=""
+33 IF $PIECE(ACRDOC0,U,4)=35!$PIECE(ACRDOC0,U,19)
SET ACRREFX=116
SET ACRREQST=""
+34 IF ACRREFX=210
SET ACRREFX=103
+35 QUIT
CHKLIST ;EP;EDIT SMALL PURCHASE CHECK LIST
+1 DO PCLIST
+2 IF '$DATA(^ACRSPCL("B",ACRDOCDA))
Begin DoDot:1
+3 SET X=ACRDOCDA
+4 SET DIC="^ACRSPCL("
+5 SET DIC(0)="L"
+6 DO FILE^ACRFDIC
+7 SET DA=+Y
End DoDot:1
IF 1
+8 IF '$TEST
SET DA=$ORDER(^ACRSPCL("B",ACRDOCDA,0))
+9 IF 'DA
QUIT
+10 SET DR="[ACR SP CHECKLIST]"
+11 SET DIE="^ACRSPCL("
+12 WRITE !
+13 DO DDS^ACRFDIC
+14 IF '$DATA(ACRSCREN)
QUIT
+15 KILL ACRSCREN
+16 DO DIE^ACRFDIC
+17 QUIT
PCLIST ;EP;TO PRINT SMALL PURCHASE CHECK LIST
+1 SET D0=ACRDOCDA
+2 SET D0=$ORDER(^ACRSPCL("B",D0,0))
+3 IF 'D0
QUIT
+4 SET (ACRRTN,ZTRTN)="PCL^ACRFPO3"
+5 SET ZTDESC="SMALL PURCHASE CHECKLIST"
+6 DO ^ACRFZIS
+7 QUIT
PCL ;EP;
+1 KILL DXS,DIP
+2 DO ^ACRSPCL
+3 QUIT
