- 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
