ACRFRRP1 ;IHS/OIRM/DSD/THL,AEF - CALCULATE ACCOUNTING DATA FOR RECEIVING REPORT; [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
;;UTILITY TO CALCULATE ACCOUNTING DATA FOR RECEIVING REPORT
EN ;EP;TO CALCULATE ACCOUNTING DATA FOR RECEIVING REPORT
S ACR=^ACRSS(ACRSSDA,0)
S ACRLBDA=$P(ACR,U,6)
D SETACT^ACRFPSS
S ACR1=$P(ACR,U,4)
S ACR2=$P(ACR,U,5)
S ACR=$P(ACR,U)
I ACR1=""!(ACR2="") S ACRSSRQD="" Q
S ACR3=$P(ACRRRDT,U,3)*$P($G(^ACRSS(ACRSSDA,"DT")),U,3)
SETS I '$D(ACROBJ(ACRACT,ACR2,ACR1)) D
.S ACROBJ(ACRACT,ACR2,ACR1)=0
.S ACROBJ(ACRACT,ACR2,ACR1,"I")=""
S ACROBJ(ACRACT,ACR2,ACR1)=ACROBJ(ACRACT,ACR2,ACR1)+ACR3
S ACROBJ(ACRACT,ACR2,ACR1,"I")=ACROBJ(ACRACT,ACR2,ACR1,"I")_$S(ACROBJ(ACRACT,ACR2,ACR1,"I")]"":",",1:"")_I
S:'$D(ACRCAN(ACRACT,ACR2)) ACRCAN(ACRACT,ACR2)=0
S ACRCAN(ACRACT,ACR2)=ACRCAN(ACRACT,ACR2)+ACR3
S ACRTOT=ACRTOT+ACR3
Q
IR ;EP;TO PRINT INITIATOR RECEIVING INFORMATION
D IRHEAD
N D0,DXS,DIP,DC,ACRAPDA,DN
S ACRAPDA=0
F S ACRAPDA=$O(^ACRRR(ACRRRDA,10,ACRAPDA)) Q:'ACRAPDA D
.S D0=+$G(^ACRRR(ACRRRDA,10,ACRAPDA,0))
.D ^ACRPRI:D0
Q
IRHEAD ;
W !!,"Certification by Request Initiator(s) of Receipt of Supplies/Servcies."
W $$DASH^ACRFMENU
W !!,"Request Initiator/Alternate"
W ?32,"Status"
W ?45,"Date Signed"
W !,"================================================================================"
Q
NECOP ;EP;TO PRINT NEW EQUIPMENT INFORMATION
I $E($G(ACROC),1,2)=31,'$D(^ACRSS(ACRSSDA,11)) S ACRNE0="" D N1 Q
Q:'$D(^ACRSS(ACRSSDA,11))
N ACRNEDA,ACRNE0
S ACRNEDA=0
F S ACRNEDA=$O(^ACRSS(ACRSSDA,11,ACRNEDA)) Q:'ACRNEDA I $D(^ACRSS(ACRSSDA,11,ACRNEDA,0)) S ACRNE0=^(0) D N1
Q
N1 ;EP;
N X
W !
F X=1,2,3,8,7,4,5,6 D
.W:X=1 !?10,"SERIAL NUMBER: "
.W:X=2 !?10,"MAKE.........: "
.W:X=3 !?10,"MODEL........: "
.W:X=8 !?10,"NOMENCLATURE.: "
.W:X=7 !?10,"DEPT. CODE...: "
.W:X=4 !?10,"BAR CODE NO..: "
.W:X=5 !?10,"INDEX NO.....: "
.W:X=6 !?10,"VOUCHER NO...: "
.W $P(ACRNE0,U,X)
.D W1^ACRFRRPT
Q
HEAD ;EP;PRINT RR HEADER
W !?34,"OBJ."
W ?39,"OR-"
W ?52,"UNIT"
W ?63,"TOTAL"
W ?73,"AC-"
W !,"NO"
W ?10,"DESCRIPTION"
W ?34,"CODE"
W ?39,"DERED"
W ?46,"UI"
W ?52,"COST"
W ?63,"AMOUNT"
W ?73,"CEPTED"
W !,"--"
W ?3,"------------------------------"
W ?34,"----"
W ?39,"------"
W ?46,"--"
W ?49,"----------"
W ?60,"------------"
W ?73,"------"
Q
ACRFRRP1 ;IHS/OIRM/DSD/THL,AEF - CALCULATE ACCOUNTING DATA FOR RECEIVING REPORT; [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
+2 ;;UTILITY TO CALCULATE ACCOUNTING DATA FOR RECEIVING REPORT
EN ;EP;TO CALCULATE ACCOUNTING DATA FOR RECEIVING REPORT
+1 SET ACR=^ACRSS(ACRSSDA,0)
+2 SET ACRLBDA=$PIECE(ACR,U,6)
+3 DO SETACT^ACRFPSS
+4 SET ACR1=$PIECE(ACR,U,4)
+5 SET ACR2=$PIECE(ACR,U,5)
+6 SET ACR=$PIECE(ACR,U)
+7 IF ACR1=""!(ACR2="")
SET ACRSSRQD=""
QUIT
+8 SET ACR3=$PIECE(ACRRRDT,U,3)*$PIECE($GET(^ACRSS(ACRSSDA,"DT")),U,3)
SETS IF '$DATA(ACROBJ(ACRACT,ACR2,ACR1))
Begin DoDot:1
+1 SET ACROBJ(ACRACT,ACR2,ACR1)=0
+2 SET ACROBJ(ACRACT,ACR2,ACR1,"I")=""
End DoDot:1
+3 SET ACROBJ(ACRACT,ACR2,ACR1)=ACROBJ(ACRACT,ACR2,ACR1)+ACR3
+4 SET ACROBJ(ACRACT,ACR2,ACR1,"I")=ACROBJ(ACRACT,ACR2,ACR1,"I")_$SELECT(ACROBJ(ACRACT,ACR2,ACR1,"I")]"":",",1:"")_I
+5 IF '$DATA(ACRCAN(ACRACT,ACR2))
SET ACRCAN(ACRACT,ACR2)=0
+6 SET ACRCAN(ACRACT,ACR2)=ACRCAN(ACRACT,ACR2)+ACR3
+7 SET ACRTOT=ACRTOT+ACR3
+8 QUIT
IR ;EP;TO PRINT INITIATOR RECEIVING INFORMATION
+1 DO IRHEAD
+2 NEW D0,DXS,DIP,DC,ACRAPDA,DN
+3 SET ACRAPDA=0
+4 FOR
SET ACRAPDA=$ORDER(^ACRRR(ACRRRDA,10,ACRAPDA))
IF 'ACRAPDA
QUIT
Begin DoDot:1
+5 SET D0=+$GET(^ACRRR(ACRRRDA,10,ACRAPDA,0))
+6 IF D0
DO ^ACRPRI
End DoDot:1
+7 QUIT
IRHEAD ;
+1 WRITE !!,"Certification by Request Initiator(s) of Receipt of Supplies/Servcies."
+2 WRITE $$DASH^ACRFMENU
+3 WRITE !!,"Request Initiator/Alternate"
+4 WRITE ?32,"Status"
+5 WRITE ?45,"Date Signed"
+6 WRITE !,"================================================================================"
+7 QUIT
NECOP ;EP;TO PRINT NEW EQUIPMENT INFORMATION
+1 IF $EXTRACT($GET(ACROC),1,2)=31
IF '$DATA(^ACRSS(ACRSSDA,11))
SET ACRNE0=""
DO N1
QUIT
+2 IF '$DATA(^ACRSS(ACRSSDA,11))
QUIT
+3 NEW ACRNEDA,ACRNE0
+4 SET ACRNEDA=0
+5 FOR
SET ACRNEDA=$ORDER(^ACRSS(ACRSSDA,11,ACRNEDA))
IF 'ACRNEDA
QUIT
IF $DATA(^ACRSS(ACRSSDA,11,ACRNEDA,0))
SET ACRNE0=^(0)
DO N1
+6 QUIT
N1 ;EP;
+1 NEW X
+2 WRITE !
+3 FOR X=1,2,3,8,7,4,5,6
Begin DoDot:1
+4 IF X=1
WRITE !?10,"SERIAL NUMBER: "
+5 IF X=2
WRITE !?10,"MAKE.........: "
+6 IF X=3
WRITE !?10,"MODEL........: "
+7 IF X=8
WRITE !?10,"NOMENCLATURE.: "
+8 IF X=7
WRITE !?10,"DEPT. CODE...: "
+9 IF X=4
WRITE !?10,"BAR CODE NO..: "
+10 IF X=5
WRITE !?10,"INDEX NO.....: "
+11 IF X=6
WRITE !?10,"VOUCHER NO...: "
+12 WRITE $PIECE(ACRNE0,U,X)
+13 DO W1^ACRFRRPT
End DoDot:1
+14 QUIT
HEAD ;EP;PRINT RR HEADER
+1 WRITE !?34,"OBJ."
+2 WRITE ?39,"OR-"
+3 WRITE ?52,"UNIT"
+4 WRITE ?63,"TOTAL"
+5 WRITE ?73,"AC-"
+6 WRITE !,"NO"
+7 WRITE ?10,"DESCRIPTION"
+8 WRITE ?34,"CODE"
+9 WRITE ?39,"DERED"
+10 WRITE ?46,"UI"
+11 WRITE ?52,"COST"
+12 WRITE ?63,"AMOUNT"
+13 WRITE ?73,"CEPTED"
+14 WRITE !,"--"
+15 WRITE ?3,"------------------------------"
+16 WRITE ?34,"----"
+17 WRITE ?39,"------"
+18 WRITE ?46,"--"
+19 WRITE ?49,"----------"
+20 WRITE ?60,"------------"
+21 WRITE ?73,"------"
+22 QUIT
