ACRFPAP1 ;IHS/OIRM/DSD/THL,AEF - PRINT APPROVALS ON REQUESTS; [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
;;ACRFPAPV CON'T
EN ;EP;
I ACRCT=40 D
.W !,"| Telephone calls were made in the interest of the Government. Traveler"
.W ?79,"|"
.W !,"| certifies that use of Government phone system was not practical."
.W ?79,"|"
.W !,"| I certify that this Voucher is true and correct to the best of my knowledge"
.W ?79,"|"
.W !,"| belief, and that payment or credit has not been received by me."
.W ?79,"|"
.W !,"| Per diem claimed is based on the average cost of lodging incurred during"
.W ?79,"|"
.W !,"| the period covered by this voucher."
.W ?79,"|"
.I $P($G(^ACRDOC(ACRDOCDA,"TOSA")),U,3)="Y" D
..W !,"| I certify that the Rental vehicle was used for official business only."
..W ?79,"|"
I ACRCT=45 D
.W !,"| Travel completed as authorized & directed by supervisor recommending travel. |"
I ACRCT=37 D
.W !,"| This voucher is approved. Long distance calls are certified as necessary |"
.W !,"| in the interest of the Government."
.W ?79,"|"
Q
CONSOL ;EP;TO DETERMINE IF ITEM FROM REQUISITION CONSOLIDATED ON ANOTHER PO
N X,Y,Z,ACRX,I
S X=0
F S X=$O(^ACRSS("C",ACRDOCDA,X)) Q:'X I $D(^ACRSS(X,"PO")),+^("PO")'=ACRDOCDA S (Y,I)=+^("PO") D
.S Y=$S($P(^ACRDOC(Y,0),U,2)]"":$P(^(0),U,2),1:$P(^(0),U)),Z=$P($G(^AUTTPRG(+$P(^ACRDOC(I,"PO"),U,7)),0),U)
.S:Z="" Z="NOT STATED"
.S ACRX(Y,Z)=$G(ACRX(Y,Z))_+^ACRSS(X,0)_","
.S $P(ACRX(Y,Z),U,2)=I
.S $P(ACRX(Y,Z),U,3)=$P(^ACRDOC(I,0),U,6)
Q:'$D(ACRX)
S ACRDOCXX=ACRDOCDA
S X=""
F S X=$O(ACRX(X)) Q:X="" D
.S Y=""
.F S Y=$O(ACRX(X,Y)) Q:Y="" D
..S Z=$P(ACRX(X,Y),U)
..S Z=$E(Z,1,$L(Z)-1)
..W !!,"ITEM",$S($L(Z,",")>1:"(S): ",1:": "),Z," FROM THIS REQUEST"
..W !,$S($L(Z,",")>1:"HAVE",1:"HAS")," BEEN CONSOLIDATED TO THE FOLLOWING PURCHASE ORDER:"
..W !,"--------------------------------------------------------------------------------"
..W !,"DEPT ID: ",$P(ACRX(X,Y),U,3)
..W ?15,"DOC: (",$P(ACRX(X,Y),U,2),")"
..W ?30,X
..W ?50,Y
..N ACRDOCDA,ACRREFDA,ACRREF,ACRREFX
..S ACRDOCDA=$P(ACRX(X,Y),U,2)
..S ACRREFDA=$P(^ACRDOC(ACRDOCDA,0),U,13)
..S (ACRREF,ACRREFX)=$P(^AUTTDOCR(ACRREFDA,0),U)
..N X,Y,Z
..D EN^ACRFPAPV
S ACRDOCDA=ACRDOCXX
K ACRDOCXX
Q
TAIL ;EP;TO PRINT FORM TRAILER
I ACRREFX'=600,ACRREFX'=148 D
.W !
.D B1
.W "------------------------------------------------------------------------------"
.D B1
I ACRREFX=103,'$P($G(^ACRDOC(ACRDOCDA,3)),U,13),$E(IOST,1,2)="P-" D
.W !,"IHS 532 (6/94) Computerized Mod of Optional Form 347 (10/83) (OMB NO. 0990-0115)"
.W !,"--------------------------------------------------------------------------------"
I ACRREFX=103,$P($G(^ACRDOC(ACRDOCDA,3)),U,13),$E(IOST,1,2)="P-" D
.W !,"--------------------------------------------------------------------------------"
I ACRREFX=116,$E(IOST,1,2)="P-" D
.W !,"IHS 534 (10/94) Computerized Mod of Purchase/Service/Stock Requisition HHS 393)"
Q
B1 W $S(ACRREFX'=103:"|",1:"-")
Q
ACRFPAP1 ;IHS/OIRM/DSD/THL,AEF - PRINT APPROVALS ON REQUESTS; [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
+2 ;;ACRFPAPV CON'T
EN ;EP;
+1 IF ACRCT=40
Begin DoDot:1
+2 WRITE !,"| Telephone calls were made in the interest of the Government. Traveler"
+3 WRITE ?79,"|"
+4 WRITE !,"| certifies that use of Government phone system was not practical."
+5 WRITE ?79,"|"
+6 WRITE !,"| I certify that this Voucher is true and correct to the best of my knowledge"
+7 WRITE ?79,"|"
+8 WRITE !,"| belief, and that payment or credit has not been received by me."
+9 WRITE ?79,"|"
+10 WRITE !,"| Per diem claimed is based on the average cost of lodging incurred during"
+11 WRITE ?79,"|"
+12 WRITE !,"| the period covered by this voucher."
+13 WRITE ?79,"|"
+14 IF $PIECE($GET(^ACRDOC(ACRDOCDA,"TOSA")),U,3)="Y"
Begin DoDot:2
+15 WRITE !,"| I certify that the Rental vehicle was used for official business only."
+16 WRITE ?79,"|"
End DoDot:2
End DoDot:1
+17 IF ACRCT=45
Begin DoDot:1
+18 WRITE !,"| Travel completed as authorized & directed by supervisor recommending travel. |"
End DoDot:1
+19 IF ACRCT=37
Begin DoDot:1
+20 WRITE !,"| This voucher is approved. Long distance calls are certified as necessary |"
+21 WRITE !,"| in the interest of the Government."
+22 WRITE ?79,"|"
End DoDot:1
+23 QUIT
CONSOL ;EP;TO DETERMINE IF ITEM FROM REQUISITION CONSOLIDATED ON ANOTHER PO
+1 NEW X,Y,Z,ACRX,I
+2 SET X=0
+3 FOR
SET X=$ORDER(^ACRSS("C",ACRDOCDA,X))
IF 'X
QUIT
IF $DATA(^ACRSS(X,"PO"))
IF +^("PO")'=ACRDOCDA
SET (Y,I)=+^("PO")
Begin DoDot:1
+4 SET Y=$SELECT($PIECE(^ACRDOC(Y,0),U,2)]"":$PIECE(^(0),U,2),1:$PIECE(^(0),U))
SET Z=$PIECE($GET(^AUTTPRG(+$PIECE(^ACRDOC(I,"PO"),U,7)),0),U)
+5 IF Z=""
SET Z="NOT STATED"
+6 SET ACRX(Y,Z)=$GET(ACRX(Y,Z))_+^ACRSS(X,0)_","
+7 SET $PIECE(ACRX(Y,Z),U,2)=I
+8 SET $PIECE(ACRX(Y,Z),U,3)=$PIECE(^ACRDOC(I,0),U,6)
End DoDot:1
+9 IF '$DATA(ACRX)
QUIT
+10 SET ACRDOCXX=ACRDOCDA
+11 SET X=""
+12 FOR
SET X=$ORDER(ACRX(X))
IF X=""
QUIT
Begin DoDot:1
+13 SET Y=""
+14 FOR
SET Y=$ORDER(ACRX(X,Y))
IF Y=""
QUIT
Begin DoDot:2
+15 SET Z=$PIECE(ACRX(X,Y),U)
+16 SET Z=$EXTRACT(Z,1,$LENGTH(Z)-1)
+17 WRITE !!,"ITEM",$SELECT($LENGTH(Z,",")>1:"(S): ",1:": "),Z," FROM THIS REQUEST"
+18 WRITE !,$SELECT($LENGTH(Z,",")>1:"HAVE",1:"HAS")," BEEN CONSOLIDATED TO THE FOLLOWING PURCHASE ORDER:"
+19 WRITE !,"--------------------------------------------------------------------------------"
+20 WRITE !,"DEPT ID: ",$PIECE(ACRX(X,Y),U,3)
+21 WRITE ?15,"DOC: (",$PIECE(ACRX(X,Y),U,2),")"
+22 WRITE ?30,X
+23 WRITE ?50,Y
+24 NEW ACRDOCDA,ACRREFDA,ACRREF,ACRREFX
+25 SET ACRDOCDA=$PIECE(ACRX(X,Y),U,2)
+26 SET ACRREFDA=$PIECE(^ACRDOC(ACRDOCDA,0),U,13)
+27 SET (ACRREF,ACRREFX)=$PIECE(^AUTTDOCR(ACRREFDA,0),U)
+28 NEW X,Y,Z
+29 DO EN^ACRFPAPV
End DoDot:2
End DoDot:1
+30 SET ACRDOCDA=ACRDOCXX
+31 KILL ACRDOCXX
+32 QUIT
TAIL ;EP;TO PRINT FORM TRAILER
+1 IF ACRREFX'=600
IF ACRREFX'=148
Begin DoDot:1
+2 WRITE !
+3 DO B1
+4 WRITE "------------------------------------------------------------------------------"
+5 DO B1
End DoDot:1
+6 IF ACRREFX=103
IF '$PIECE($GET(^ACRDOC(ACRDOCDA,3)),U,13)
IF $EXTRACT(IOST,1,2)="P-"
Begin DoDot:1
+7 WRITE !,"IHS 532 (6/94) Computerized Mod of Optional Form 347 (10/83) (OMB NO. 0990-0115)"
+8 WRITE !,"--------------------------------------------------------------------------------"
End DoDot:1
+9 IF ACRREFX=103
IF $PIECE($GET(^ACRDOC(ACRDOCDA,3)),U,13)
IF $EXTRACT(IOST,1,2)="P-"
Begin DoDot:1
+10 WRITE !,"--------------------------------------------------------------------------------"
End DoDot:1
+11 IF ACRREFX=116
IF $EXTRACT(IOST,1,2)="P-"
Begin DoDot:1
+12 WRITE !,"IHS 534 (10/94) Computerized Mod of Purchase/Service/Stock Requisition HHS 393)"
End DoDot:1
+13 QUIT
B1 WRITE $SELECT(ACRREFX'=103:"|",1:"-")
+1 QUIT
